/[eiffelstudio]/FreeELKS/trunk/library/kernel/tuple.e
ViewVC logotype

Annotation of /FreeELKS/trunk/library/kernel/tuple.e

Parent Directory Parent Directory | Revision Log Revision Log


Revision 91438 - (hide annotations)
Thu Oct 28 22:23:37 2004 UTC (15 years, 3 months ago) by manus_eiffel
File size: 30326 byte(s)
Removed comments after `end' keyword.

1 manus_eiffel 91424 indexing
2     description: "Implementation of TUPLE"
3 manus_eiffel 91434 library: "Free implementation of ELKS library"
4     copyright: "Copyright (c) 1986-2004, Eiffel Software and others"
5     license: "Eiffel Forum License v2 (see forum.txt)"
6 manus_eiffel 91424 date: "$Date$"
7     revision: "$Revision$"
8    
9     class
10     TUPLE
11    
12     inherit
13     HASHABLE
14    
15     MISMATCH_CORRECTOR
16     redefine
17     correct_mismatch
18     end
19    
20     create
21     default_create, make
22    
23     feature -- Creation
24    
25     make is
26     obsolete
27     "Use no creation procedure to create a TUPLE instance"
28     do
29     end
30    
31     feature -- Access
32    
33     item, infix "@" (index: INTEGER): ANY is
34     -- Entry of key `index'.
35     require
36     valid_index: valid_index (index)
37     do
38     inspect eif_item_type ($Current, index)
39     when boolean_code then Result := eif_boolean_item ($Current, index)
40     when character_code then Result := eif_character_item ($Current, index)
41     when wide_character_code then Result := eif_wide_character_item ($Current, index)
42     when double_code then Result := eif_double_item ($Current, index)
43     when real_code then Result := eif_real_item ($Current, index)
44     when pointer_code then Result := eif_pointer_item ($Current, index)
45     when integer_8_code then Result := eif_integer_8_item ($Current, index)
46     when integer_16_code then Result := eif_integer_16_item ($Current, index)
47     when integer_32_code then Result := eif_integer_32_item ($Current, index)
48     when integer_64_code then Result := eif_integer_64_item ($Current, index)
49     when Reference_code then Result := eif_reference_item ($Current, index)
50     end
51     end
52    
53     reference_item (index: INTEGER): ANY is
54     -- Reference item at `index'.
55     require
56     valid_index: valid_index (index)
57     is_reference: is_reference_item (index)
58     do
59     Result := eif_reference_item ($current, index)
60     end
61    
62     boolean_item (index: INTEGER): BOOLEAN is
63     -- Boolean item at `index'.
64     require
65     valid_index: valid_index (index)
66     is_boolean: is_boolean_item (index)
67     do
68     Result := eif_boolean_item ($Current, index)
69     end
70    
71     character_item (index: INTEGER): CHARACTER is
72     -- Character item at `index'.
73     require
74     valid_index: valid_index (index)
75     is_character: is_character_item (index)
76     do
77     Result := eif_character_item ($Current, index)
78     end
79    
80     wide_character_item (index: INTEGER): WIDE_CHARACTER is
81     -- Character item at `index'.
82     require
83     valid_index: valid_index (index)
84     is_wide_character: is_wide_character_item (index)
85     do
86     Result := eif_wide_character_item ($Current, index)
87     end
88    
89     double_item (index: INTEGER): DOUBLE is
90     -- Double item at `index'.
91     require
92     valid_index: valid_index (index)
93     is_numeric: is_numeric_item (index)
94     do
95     inspect eif_item_type ($Current, index)
96     when integer_8_code then Result := eif_integer_8_item ($Current, index)
97     when integer_16_code then Result := eif_integer_16_item ($Current, index)
98     when integer_32_code then Result := eif_integer_32_item ($Current, index)
99     when integer_64_code then Result := eif_integer_64_item ($Current, index)
100     when real_code then Result := eif_real_item ($Current, index)
101     else
102     check
103     is_double: eif_item_type ($Current, index) = double_code
104     end
105     Result := eif_double_item ($Current, index)
106     end
107     end
108    
109     integer_8_item (index: INTEGER): INTEGER_8 is
110     -- Integer item at `index'.
111     require
112     valid_index: valid_index (index)
113     is_integer: is_integer_8_item (index)
114     do
115     Result := eif_integer_8_item ($Current, index)
116     end
117    
118     integer_16_item (index: INTEGER): INTEGER_16 is
119     -- Integer item at `index'.
120     require
121     valid_index: valid_index (index)
122     is_integer: is_integer_16_item (index)
123     do
124     Result := eif_integer_16_item ($Current, index)
125     end
126    
127     integer_item, integer_32_item (index: INTEGER): INTEGER is
128     -- Integer item at `index'.
129     require
130     valid_index: valid_index (index)
131     is_integer: is_integer_item (index)
132     do
133     Result := eif_integer_32_item ($Current, index)
134     end
135    
136     integer_64_item (index: INTEGER): INTEGER_64 is
137     -- Integer item at `index'.
138     require
139     valid_index: valid_index (index)
140     is_integer: is_integer_64_item (index)
141     do
142     Result := eif_integer_64_item ($Current, index)
143     end
144    
145     pointer_item (index: INTEGER): POINTER is
146     -- Pointer item at `index'.
147     require
148     valid_index: valid_index (index)
149     is_pointer: is_pointer_item (index)
150     do
151     Result := eif_pointer_item ($Current, index)
152     end
153    
154     real_item (index: INTEGER): REAL is
155     -- real item at `index'.
156     require
157     valid_index: valid_index (index)
158     is_real_or_integer: is_real_item (index) or else is_integer_item (index)
159     do
160     inspect eif_item_type ($Current, index)
161     when integer_8_code then Result := eif_integer_8_item ($Current, index)
162     when integer_16_code then Result := eif_integer_16_item ($Current, index)
163     when integer_32_code then Result := eif_integer_32_item ($Current, index)
164     when integer_64_code then Result := eif_integer_64_item ($Current, index)
165     when double_code then
166     -- Special case of manifest tuple.
167     Result := eif_double_item ($Current, index).truncated_to_real
168     else
169     check
170     is_real: eif_item_type ($Current, index) = real_code
171     end
172     Result := eif_real_item ($Current, index)
173     end
174     end
175    
176    
177     feature -- Status report
178    
179     hash_code: INTEGER is
180     -- Hash code value
181     local
182     i, nb, l_hash: INTEGER
183     l_key: HASHABLE
184     do
185     from
186     i := 1
187     nb := count
188     until
189     i > nb
190     loop
191     inspect eif_item_type($Current, i)
192     when boolean_code then l_hash := eif_boolean_item ($Current, i).hash_code
193     when character_code then l_hash := eif_character_item ($Current, i).hash_code
194     when wide_character_code then l_hash := eif_wide_character_item ($Current, i).hash_code
195     when double_code then l_hash := eif_double_item ($Current, i).hash_code
196     when real_code then l_hash := eif_real_item ($Current, i).hash_code
197     when pointer_code then l_hash := eif_pointer_item ($Current, i).hash_code
198     when integer_8_code then l_hash := eif_integer_8_item ($Current, i).hash_code
199     when integer_16_code then l_hash := eif_integer_16_item ($Current, i).hash_code
200     when integer_32_code then l_hash := eif_integer_32_item ($Current, i).hash_code
201     when integer_64_code then l_hash := eif_integer_64_item ($Current, i).hash_code
202     when reference_code then
203     l_key ?= eif_reference_item ($Current, i)
204     if l_key /= Void then
205     l_hash := l_key.hash_code
206     else
207     l_hash := 0
208     end
209     end
210     Result := Result + l_hash * internal_primes.i_th (i)
211     i := i + 1
212     end
213     -- Ensure it is a positive value.
214     Result := Result.hash_code
215     end
216    
217     valid_index (k: INTEGER): BOOLEAN is
218     -- Is `k' a valid key?
219     do
220     Result := k >= 1 and then k <= count
221     end
222    
223     valid_type_for_index (v: ANY; index: INTEGER): BOOLEAN is
224     -- Is object `v' a valid target for element at position `index'?
225     require
226     valid_index: valid_index (index)
227     local
228     l_b: BOOLEAN_REF
229     l_c: CHARACTER_REF
230     l_wc: WIDE_CHARACTER_REF
231     l_d: DOUBLE_REF
232     l_r: REAL_REF
233     l_p: POINTER_REF
234     l_i: INTEGER_REF
235     l_i8: INTEGER_8_REF
236     l_i16: INTEGER_16_REF
237     l_i64: INTEGER_64_REF
238     l_int: INTERNAL
239     do
240     if v = Void then
241     -- A Void entry is always valid.
242     Result := True
243     else
244     inspect eif_item_type ($Current, index)
245     when boolean_code then l_b ?= v; Result := l_b /= Void
246     when character_code then l_c ?= v; Result := l_c /= Void
247     when wide_character_code then l_wc ?= v; Result := l_wc /= Void
248     when double_code then l_d ?= v; Result := l_d /= Void
249     when real_code then l_r ?= v; Result := l_r /= Void
250     when pointer_code then l_p ?= v; Result := l_p /= Void
251     when integer_8_code then l_i8 ?= v; Result := l_i8 /= Void
252     when integer_16_code then l_i16 ?= v; Result := l_i16 /= Void
253     when integer_32_code then l_i ?= v; Result := l_i /= Void
254     when integer_64_code then l_i64 ?= v; Result := l_i64 /= Void
255     when Reference_code then
256     -- Let's check that type of `v' conforms to specified type of `index'-th
257     -- arguments of current TUPLE.
258     create l_int
259     Result := l_int.type_conforms_to
260     (l_int.dynamic_type (v), l_int.generic_dynamic_type (Current, index))
261     end
262     end
263     end
264    
265     count: INTEGER is
266     -- Number of element in Current.
267     do
268     -- `-1' because we always allocate one item more to avoid
269     -- to do `-1' each time we want to access or store an item
270     -- of current.
271     Result := feature {ISE_RUNTIME}.sp_count ($Current) - 1
272     end
273    
274     lower: INTEGER is 1
275     -- Lower bound of TUPLE.
276    
277     upper: INTEGER is
278     -- Upper bound of TUPLE.
279     do
280     Result := count
281     end
282    
283     is_empty: BOOLEAN is
284     -- Is Current empty?
285     do
286     Result := count = 0
287     end
288    
289     feature -- Element change
290    
291     put (v: ANY; index: INTEGER) is
292     -- Insert `v' at position `index'.
293     require
294     valid_index: valid_index (index)
295     valid_type_for_index: valid_type_for_index (v, index)
296     do
297     inspect eif_item_type ($Current, index)
298     when boolean_code then eif_put_boolean_item_with_object ($Current, index, $v)
299     when character_code then eif_put_character_item_with_object ($Current, index, $v)
300     when wide_character_code then eif_put_wide_character_item_with_object ($Current, index, $v)
301     when double_code then eif_put_double_item_with_object ($Current, index, $v)
302     when real_code then eif_put_real_item_with_object ($Current, index, $v)
303     when pointer_code then eif_put_pointer_item_with_object ($Current, index, $v)
304     when integer_8_code then eif_put_integer_8_item_with_object ($Current, index, $v)
305     when integer_16_code then eif_put_integer_16_item_with_object ($Current, index, $v)
306     when integer_32_code then eif_put_integer_32_item_with_object ($Current, index, $v)
307     when integer_64_code then eif_put_integer_64_item_with_object ($Current, index, $v)
308     when Reference_code then eif_put_reference_item_with_object ($Current, index, $v)
309     end
310     end
311    
312     put_reference (v: ANY; index: INTEGER) is
313     -- Put `v' at position `index' in Current.
314     require
315     valid_index: valid_index (index)
316     valid_type: is_reference_item (index)
317     do
318     eif_put_reference_item_with_object ($Current, index, $v)
319     end
320    
321     put_boolean (v: BOOLEAN; index: INTEGER) is
322     -- Put `v' at position `index' in Current.
323     require
324     valid_index: valid_index (index)
325     valid_type: is_boolean_item (index)
326     do
327     eif_put_boolean_item ($Current, index, v)
328     end
329    
330     put_character (v: CHARACTER; index: INTEGER) is
331     -- Put `v' at position `index' in Current.
332     require
333     valid_index: valid_index (index)
334     valid_type: is_character_item (index)
335     do
336     eif_put_character_item ($Current, index, v)
337     end
338    
339     put_wide_character (v: WIDE_CHARACTER; index: INTEGER) is
340     -- Put `v' at position `index' in Current.
341     require
342     valid_index: valid_index (index)
343     valid_type: is_wide_character_item (index)
344     do
345     eif_put_wide_character_item ($Current, index, v)
346     end
347    
348     put_double (v: DOUBLE; index: INTEGER) is
349     -- Put `v' at position `index' in Current.
350     require
351     valid_index: valid_index (index)
352     valid_type: is_double_item (index)
353     do
354     eif_put_double_item ($Current, index, v)
355     end
356    
357     put_real (v: REAL; index: INTEGER) is
358     -- Put `v' at position `index' in Current.
359     require
360     valid_index: valid_index (index)
361     valid_type: is_real_item (index)
362     do
363     eif_put_real_item ($Current, index, v)
364     end
365    
366     put_pointer (v: POINTER; index: INTEGER) is
367     -- Put `v' at position `index' in Current.
368     require
369     valid_index: valid_index (index)
370     valid_type: is_pointer_item (index)
371     do
372     eif_put_pointer_item ($Current, index, v)
373     end
374    
375     put_integer, put_integer_32 (v: INTEGER; index: INTEGER) is
376     -- Put `v' at position `index' in Current.
377     require
378     valid_index: valid_index (index)
379     valid_type: is_integer_item (index)
380     do
381     eif_put_integer_32_item ($Current, index, v)
382     end
383    
384     put_integer_8 (v: INTEGER_8; index: INTEGER) is
385     -- Put `v' at position `index' in Current.
386     require
387     valid_index: valid_index (index)
388     valid_type: is_integer_8_item (index)
389     do
390     eif_put_integer_8_item ($Current, index, v)
391     end
392    
393     put_integer_16 (v: INTEGER_16; index: INTEGER) is
394     -- Put `v' at position `index' in Current.
395     require
396     valid_index: valid_index (index)
397     valid_type: is_integer_16_item (index)
398     do
399     eif_put_integer_16_item ($Current, index, v)
400     end
401    
402     put_integer_64 (v: INTEGER_64; index: INTEGER) is
403     -- Put `v' at position `index' in Current.
404     require
405     valid_index: valid_index (index)
406     valid_type: is_integer_64_item (index)
407     do
408     eif_put_integer_64_item ($Current, index, v)
409     end
410    
411     feature -- Type queries
412    
413     is_boolean_item (index: INTEGER): BOOLEAN is
414     -- Is item at `index' a BOOLEAN?
415     require
416     valid_index: valid_index (index)
417     do
418     Result := (eif_item_type ($Current, index) = boolean_code)
419     end
420    
421     is_character_item (index: INTEGER): BOOLEAN is
422     -- Is item at `index' a CHARACTER?
423     require
424     valid_index: valid_index (index)
425     do
426     Result := (eif_item_type ($Current, index) = character_code)
427     end
428    
429     is_wide_character_item (index: INTEGER): BOOLEAN is
430     -- Is item at `index' a WIDE_CHARACTER?
431     require
432     valid_index: valid_index (index)
433     do
434     Result := (eif_item_type ($Current, index) = wide_character_code)
435     end
436    
437     is_double_item (index: INTEGER): BOOLEAN is
438     -- Is item at `index' a DOUBLE?
439     require
440     valid_index: valid_index (index)
441     do
442     Result := (eif_item_type ($Current, index) = double_code)
443     end
444    
445     is_integer_8_item (index: INTEGER): BOOLEAN is
446     -- Is item at `index' an INTEGER_8?
447     require
448     valid_index: valid_index (index)
449     do
450     Result := (eif_item_type ($Current, index) = integer_8_code)
451     end
452    
453     is_integer_16_item (index: INTEGER): BOOLEAN is
454     -- Is item at `index' an INTEGER_16?
455     require
456     valid_index: valid_index (index)
457     do
458     Result := (eif_item_type ($Current, index) = integer_16_code)
459     end
460    
461     is_integer_item, is_integer_32_item (index: INTEGER): BOOLEAN is
462     -- Is item at `index' an INTEGER?
463     require
464     valid_index: valid_index (index)
465     do
466     Result := (eif_item_type ($Current, index) = integer_32_code)
467     end
468    
469     is_integer_64_item (index: INTEGER): BOOLEAN is
470     -- Is item at `index' an INTEGER_64?
471     require
472     valid_index: valid_index (index)
473     do
474     Result := (eif_item_type ($Current, index) = integer_64_code)
475     end
476    
477     is_pointer_item (index: INTEGER): BOOLEAN is
478     -- Is item at `index' a POINTER?
479     require
480     valid_index: valid_index (index)
481     do
482     Result := (eif_item_type ($Current, index) = pointer_code)
483     end
484    
485     is_real_item (index: INTEGER): BOOLEAN is
486     -- Is item at `index' a REAL?
487     require
488     valid_index: valid_index (index)
489     do
490     Result := (eif_item_type ($Current, index) = real_code)
491     end
492    
493     is_reference_item (index: INTEGER): BOOLEAN is
494     -- Is item at `index' a REFERENCE?
495     require
496     valid_index: valid_index (index)
497     do
498     Result := (eif_item_type ($Current, index) = reference_code)
499     end
500    
501     is_numeric_item (index: INTEGER): BOOLEAN is
502     -- Is item at `index' a number?
503     require
504     valid_index: valid_index (index)
505     local
506     tcode: INTEGER_8
507     do
508     tcode := eif_item_type ($Current, index)
509     Result := (tcode = integer_32_code) or else
510     (tcode = real_code) or else
511     (tcode = double_code)
512     end
513    
514     is_uniform: BOOLEAN is
515     -- Are all items of the same basic type or all of reference type?
516     do
517     Result := is_tuple_uniform (any_code)
518     ensure
519     yes_if_empty: (count = 0) implies Result
520     end
521    
522     is_uniform_boolean: BOOLEAN is
523     -- Are all items of type BOOLEAN?
524     do
525     Result := is_tuple_uniform (boolean_code)
526     ensure
527     yes_if_empty: (count = 0) implies Result
528     end
529    
530     is_uniform_character: BOOLEAN is
531     -- Are all items of type CHARACTER?
532     do
533     Result := is_tuple_uniform (character_code)
534     ensure
535     yes_if_empty: (count = 0) implies Result
536     end
537    
538     is_uniform_wide_character: BOOLEAN is
539     -- Are all items of type WIDE_CHARACTER?
540     do
541     Result := is_tuple_uniform (wide_character_code)
542     ensure
543     yes_if_empty: (count = 0) implies Result
544     end
545    
546     is_uniform_double: BOOLEAN is
547     -- Are all items of type DOUBLE?
548     do
549     Result := is_tuple_uniform (double_code)
550     ensure
551     yes_if_empty: (count = 0) implies Result
552     end
553    
554     is_uniform_integer_8: BOOLEAN is
555     -- Are all items of type INTEGER_8?
556     do
557     Result := is_tuple_uniform (integer_8_code)
558     ensure
559     yes_if_empty: (count = 0) implies Result
560     end
561    
562     is_uniform_integer_16: BOOLEAN is
563     -- Are all items of type INTEGER_16?
564     do
565     Result := is_tuple_uniform (integer_16_code)
566     ensure
567     yes_if_empty: (count = 0) implies Result
568     end
569    
570     is_uniform_integer, is_uniform_integer_32: BOOLEAN is
571     -- Are all items of type INTEGER?
572     do
573     Result := is_tuple_uniform (integer_32_code)
574     ensure
575     yes_if_empty: (count = 0) implies Result
576     end
577    
578     is_uniform_integer_64: BOOLEAN is
579     -- Are all items of type INTEGER_64?
580     do
581     Result := is_tuple_uniform (integer_64_code)
582     ensure
583     yes_if_empty: (count = 0) implies Result
584     end
585    
586     is_uniform_pointer: BOOLEAN is
587     -- Are all items of type POINTER?
588     do
589     Result := is_tuple_uniform (pointer_code)
590     ensure
591     yes_if_empty: (count = 0) implies Result
592     end
593    
594     is_uniform_real: BOOLEAN is
595     -- Are all items of type REAL?
596     do
597     Result := is_tuple_uniform (real_code)
598     ensure
599     yes_if_empty: (count = 0) implies Result
600     end
601    
602     is_uniform_reference: BOOLEAN is
603     -- Are all items of reference type?
604     do
605     Result := is_tuple_uniform (reference_code)
606     ensure
607     yes_if_empty: (count = 0) implies Result
608     end
609    
610     feature -- Type conversion queries
611    
612     convertible_to_double: BOOLEAN is
613     -- Is current convertible to an array of doubles?
614     local
615     i, cnt: INTEGER
616     tcode: INTEGER_8
617     do
618     Result := True
619     from
620     i := 1
621     cnt := count
622     until
623     i > cnt or else not Result
624     loop
625     tcode := eif_item_type ($Current, i)
626     Result := (tcode = integer_32_code) or else
627     (tcode = real_code) or else
628     (tcode = double_code)
629     i := i + 1
630     end
631     ensure
632     yes_if_empty: (count = 0) implies Result
633     end
634    
635     convertible_to_real: BOOLEAN is
636     -- Is current convertible to an array of reals?
637     local
638     i, cnt: INTEGER
639     tcode: INTEGER_8
640     do
641     Result := True
642     from
643     i := 1
644     cnt := count
645     until
646     i > cnt or else not Result
647     loop
648     tcode := eif_item_type ($Current, i)
649     Result := (tcode = integer_32_code) or else (tcode = real_code)
650     i := i + 1
651     end
652     ensure
653     yes_if_empty: (count = 0) implies Result
654     end
655    
656     feature -- Conversion
657    
658     arrayed: ARRAY [ANY] is
659     -- Items of Current as array
660     local
661     i, cnt: INTEGER
662     do
663     from
664     i := 1
665     cnt := count
666     create Result.make (1, cnt)
667     until
668     i > cnt
669     loop
670     Result.put (item (i), i)
671     i := i + 1
672     end
673     ensure
674     exists: Result /= Void
675     same_count: Result.count = count
676     same_items: -- Items are the same in same order
677     end
678    
679     boolean_arrayed: ARRAY [BOOLEAN] is
680     -- Items of Current as array
681     require
682     is_uniform_boolean: is_uniform_boolean
683     local
684     i, cnt: INTEGER
685     do
686     from
687     i := 1
688     cnt := count
689     create Result.make (1, cnt)
690     until
691     i > cnt
692     loop
693     Result.put (boolean_item (i), i)
694     i := i + 1
695     end
696     ensure
697     exists: Result /= Void
698     same_count: Result.count = count
699     same_items: -- Items are the same in same order
700     end
701    
702     character_arrayed: ARRAY [CHARACTER] is
703     -- Items of Current as array
704     require
705     is_uniform_character: is_uniform_character
706     local
707     i, cnt: INTEGER
708     do
709     from
710     i := 1
711     cnt := count
712     create Result.make (1, cnt)
713     until
714     i > cnt
715     loop
716     Result.put (character_item (i), i)
717     i := i + 1
718     end
719     ensure
720     exists: Result /= Void
721     same_count: Result.count = count
722     same_items: -- Items are the same in same order
723     end
724    
725     double_arrayed: ARRAY [DOUBLE] is
726     -- Items of Current as array
727     require
728     convertible: convertible_to_double
729     local
730     i, cnt: INTEGER
731     do
732     from
733     i := 1
734     cnt := count
735     create Result.make (1, cnt)
736     until
737     i > cnt
738     loop
739     Result.put (double_item (i), i)
740     i := i + 1
741     end
742     ensure
743     exists: Result /= Void
744     same_count: Result.count = count
745     same_items: -- Items are the same in same order
746     end
747    
748     integer_arrayed: ARRAY [INTEGER] is
749     -- Items of Current as array
750     require
751     is_uniform_integer: is_uniform_integer
752     local
753     i, cnt: INTEGER
754     do
755     from
756     i := 1
757     cnt := count
758     create Result.make (1, cnt)
759     until
760     i > cnt
761     loop
762     Result.put (integer_item (i), i)
763     i := i + 1
764     end
765     ensure
766     exists: Result /= Void
767     same_count: Result.count = count
768     same_items: -- Items are the same in same order
769     end
770    
771     pointer_arrayed: ARRAY [POINTER] is
772     -- Items of Current as array
773     require
774     is_uniform_pointer: is_uniform_pointer
775     local
776     i, cnt: INTEGER
777     do
778     from
779     i := 1
780     cnt := count
781     create Result.make (1, cnt)
782     until
783     i > cnt
784     loop
785     Result.put (pointer_item (i), i)
786     i := i + 1
787     end
788     ensure
789     exists: Result /= Void
790     same_count: Result.count = count
791     same_items: -- Items are the same in same order
792     end
793    
794     real_arrayed: ARRAY [REAL] is
795     -- Items of Current as array
796     require
797     convertible: convertible_to_real
798     local
799     i, cnt: INTEGER
800     do
801     from
802     i := 1
803     cnt := count
804     create Result.make (1, cnt)
805     until
806     i > cnt
807     loop
808     Result.put (real_item (i), i)
809     i := i + 1
810     end
811     ensure
812     exists: Result /= Void
813     same_count: Result.count = count
814     same_items: -- Items are the same in same order
815     end
816    
817     string_arrayed: ARRAY [STRING] is
818     -- Items of Current as array
819     -- NOTE: Items with a type not cconforming to
820     -- type STRING are set to Void.
821     local
822     i, cnt: INTEGER
823     s: STRING
824     do
825     from
826     i := 1
827     cnt := count
828     create Result.make (1, cnt)
829     until
830     i > cnt
831     loop
832     s ?= item (i)
833     Result.put (s, i)
834     i := i + 1
835     end
836     ensure
837     exists: Result /= Void
838     same_count: Result.count = count
839     end
840    
841     feature -- Retrieval
842    
843     correct_mismatch is
844     -- Attempt to correct object mismatch using `mismatch_information'.
845     local
846     l_area: SPECIAL [ANY]
847     i, nb: INTEGER
848     l_any: ANY
849     do
850     -- Old version of TUPLE had a SPECIAL [ANY] to store all values.
851     -- If we can get access to it, then most likely we can recover this
852     -- old TUPLE implementation.
853     l_area ?= Mismatch_information.item (area_name)
854     if l_area /= Void then
855     from
856     i := 1
857     nb := l_area.count
858     until
859     i > nb
860     loop
861     l_any := l_area.item (i - 1)
862     if valid_type_for_index (l_any, i) then
863     put (l_any, i)
864     else
865     -- We found an unexpected type in old special. We cannot go on.
866     Precursor {MISMATCH_CORRECTOR}
867     end
868     i := i + 1
869     end
870     else
871     Precursor {MISMATCH_CORRECTOR}
872     end
873     end
874    
875     feature {ROUTINE}
876    
877     arg_item_code (index: INTEGER): INTEGER_8 is
878     -- Type code of item at `index'. Used for
879     -- argument processing in ROUTINE
880     require
881     valid_index: valid_index (index)
882     do
883     Result := eif_item_type ($Current, index)
884     end
885    
886     feature {ROUTINE} -- Internal constant code
887    
888     reference_code: INTEGER_8 is 0x00
889     boolean_code: INTEGER_8 is 0x01
890     character_code: INTEGER_8 is 0x02
891     double_code: INTEGER_8 is 0x03
892     real_code: INTEGER_8 is 0x04
893     pointer_code: INTEGER_8 is 0x05
894     integer_8_code: INTEGER_8 is 0x06
895     integer_16_code: INTEGER_8 is 0x07
896     integer_32_code: INTEGER_8 is 0x08
897     integer_64_code: INTEGER_8 is 0x09
898     wide_character_code: INTEGER_8 is 0x0E
899     any_code: INTEGER_8 is 0xFF
900     -- Code used to identify type in TUPLE.
901    
902     feature {NONE} -- Implementation
903    
904     area_name: STRING is "area"
905     -- Name of attributes where TUPLE elements were stored.
906    
907     is_tuple_uniform (code: INTEGER_8): BOOLEAN is
908     -- Are all items of type `code'?
909     local
910     i, nb: INTEGER
911     l_code: INTEGER_8
912     do
913     Result := True
914     if count > 0 then
915     from
916     nb := count
917     if code = any_code then
918     -- We take first type code and compare all the remaining ones
919     -- against it.
920     i := 2
921     l_code := eif_item_type ($Current, 1)
922     else
923     i := 1
924     l_code := code
925     end
926     until
927     i > nb or not Result
928     loop
929     Result := l_code = eif_item_type ($Current, i)
930     i := i + 1
931     end
932     end
933     end
934    
935     internal_primes: PRIMES is
936     -- For quick access to prime numbers.
937     once
938     create Result
939     end
940    
941     feature {NONE} -- Externals: Access
942    
943     eif_item_type (obj: POINTER; pos: INTEGER): INTEGER_8 is
944     -- Code for generic parameter `pos' in `obj'.
945     external
946     "C macro use %"eif_rout_obj.h%""
947     alias
948     "eif_item_type"
949     end
950    
951     eif_boolean_item (obj: POINTER; pos: INTEGER): BOOLEAN is
952     -- Boolean item at position `pos' in tuple `obj'.
953     external
954     "C macro use %"eif_rout_obj.h%""
955     end
956    
957     eif_character_item (obj: POINTER; pos: INTEGER): CHARACTER is
958     -- Character item at position `pos' in tuple `obj'.
959     external
960     "C macro use %"eif_rout_obj.h%""
961     end
962    
963     eif_wide_character_item (obj: POINTER; pos: INTEGER): WIDE_CHARACTER is
964     -- Wide character item at position `pos' in tuple `obj'.
965     external
966     "C macro use %"eif_rout_obj.h%""
967     end
968    
969     eif_double_item (obj: POINTER; pos: INTEGER): DOUBLE is
970     -- Double item at position `pos' in tuple `obj'.
971     external
972     "C macro use %"eif_rout_obj.h%""
973     end
974    
975     eif_real_item (obj: POINTER; pos: INTEGER): REAL is
976     -- Real item at position `pos' in tuple `obj'.
977     external
978     "C macro use %"eif_rout_obj.h%""
979     end
980    
981     eif_pointer_item (obj: POINTER; pos: INTEGER): POINTER is
982     -- Pointer item at position `pos' in tuple `obj'.
983     external
984     "C macro use %"eif_rout_obj.h%""
985     end
986    
987     eif_integer_8_item (obj: POINTER; pos: INTEGER): INTEGER_8 is
988     -- Integer_8 item at position `pos' in tuple `obj'.
989     external
990     "C macro use %"eif_rout_obj.h%""
991     end
992    
993     eif_integer_16_item (obj: POINTER; pos: INTEGER): INTEGER_16 is
994     -- Integer_16 item at position `pos' in tuple `obj'.
995     external
996     "C macro use %"eif_rout_obj.h%""
997     end
998    
999     eif_integer_32_item (obj: POINTER; pos: INTEGER): INTEGER is
1000     -- Integer_32 item at position `pos' in tuple `obj'.
1001     external
1002     "C macro use %"eif_rout_obj.h%""
1003     end
1004    
1005     eif_integer_64_item (obj: POINTER; pos: INTEGER): INTEGER_64 is
1006     -- Integer_64 item at position `pos' in tuple `obj'.
1007     external
1008     "C macro use %"eif_rout_obj.h%""
1009     end
1010    
1011     eif_reference_item (obj: POINTER; pos: INTEGER): ANY is
1012     -- Reference item at position `pos' in tuple `obj'.
1013     external
1014     "C macro use %"eif_rout_obj.h%""
1015     end
1016    
1017     feature {NONE} -- Externals: Setting
1018    
1019     eif_put_boolean_item_with_object (obj: POINTER; pos: INTEGER; v: POINTER) is
1020     -- Set boolean item at position `pos' in tuple `obj' with `v'.
1021     external
1022     "C macro use %"eif_rout_obj.h%""
1023     end
1024    
1025     eif_put_character_item_with_object (obj: POINTER; pos: INTEGER; v: POINTER) is
1026     -- Set character item at position `pos' in tuple `obj' with `v'.
1027     external
1028     "C macro use %"eif_rout_obj.h%""
1029     end
1030    
1031     eif_put_wide_character_item_with_object (obj: POINTER; pos: INTEGER; v: POINTER) is
1032     -- Set wide character item at position `pos' in tuple `obj' with `v'.
1033     external
1034     "C macro use %"eif_rout_obj.h%""
1035     end
1036    
1037     eif_put_double_item_with_object (obj: POINTER; pos: INTEGER; v: POINTER) is
1038     -- Set double item at position `pos' in tuple `obj' with `v'.
1039     external
1040     "C macro use %"eif_rout_obj.h%""
1041     end
1042    
1043     eif_put_real_item_with_object (obj: POINTER; pos: INTEGER; v: POINTER) is
1044     -- Set real item at position `pos' in tuple `obj' with `v'.
1045     external
1046     "C macro use %"eif_rout_obj.h%""
1047     end
1048    
1049     eif_put_pointer_item_with_object (obj: POINTER; pos: INTEGER; v: POINTER) is
1050     -- Set pointer item at position `pos' in tuple `obj' with `v'.
1051     external
1052     "C macro use %"eif_rout_obj.h%""
1053     end
1054    
1055     eif_put_integer_8_item_with_object (obj: POINTER; pos: INTEGER; v: POINTER) is
1056     -- Set integer_8 item at position `pos' in tuple `obj' with `v'.
1057     external
1058     "C macro use %"eif_rout_obj.h%""
1059     end
1060    
1061     eif_put_integer_16_item_with_object (obj: POINTER; pos: INTEGER; v: POINTER) is
1062     -- Set integer_16 item at position `pos' in tuple `obj' with `v'.
1063     external
1064     "C macro use %"eif_rout_obj.h%""
1065     end
1066    
1067     eif_put_integer_32_item_with_object (obj: POINTER; pos: INTEGER; v: POINTER) is
1068     -- Set integer_32 item at position `pos' in tuple `obj' with `v'.
1069     external
1070     "C macro use %"eif_rout_obj.h%""
1071     end
1072    
1073     eif_put_integer_64_item_with_object (obj: POINTER; pos: INTEGER; v: POINTER) is
1074     -- Set integer_64 item at position `pos' in tuple `obj' with `v'.
1075     external
1076     "C macro use %"eif_rout_obj.h%""
1077     end
1078    
1079     eif_put_reference_item_with_object (obj: POINTER; pos: INTEGER; v: POINTER) is
1080     -- Set reference item at position `pos' in tuple `obj' with `v'.
1081     external
1082     "C macro use %"eif_rout_obj.h%""
1083     end
1084    
1085     eif_put_boolean_item (obj: POINTER; pos: INTEGER; v: BOOLEAN) is
1086     -- Set boolean item at position `pos' in tuple `obj' with `v'.
1087     external
1088     "C macro use %"eif_rout_obj.h%""
1089     end
1090    
1091     eif_put_character_item (obj: POINTER; pos: INTEGER; v: CHARACTER) is
1092     -- Set character item at position `pos' in tuple `obj' with `v'.
1093     external
1094     "C macro use %"eif_rout_obj.h%""
1095     end
1096    
1097     eif_put_wide_character_item (obj: POINTER; pos: INTEGER; v: WIDE_CHARACTER) is
1098     -- Set wide character item at position `pos' in tuple `obj' with `v'.
1099     external
1100     "C macro use %"eif_rout_obj.h%""
1101     end
1102    
1103     eif_put_double_item (obj: POINTER; pos: INTEGER; v: DOUBLE) is
1104     -- Set double item at position `pos' in tuple `obj' with `v'.
1105     external
1106     "C macro use %"eif_rout_obj.h%""
1107     end
1108    
1109     eif_put_real_item (obj: POINTER; pos: INTEGER; v: REAL) is
1110     -- Set real item at position `pos' in tuple `obj' with `v'.
1111     external
1112     "C macro use %"eif_rout_obj.h%""
1113     end
1114    
1115     eif_put_pointer_item (obj: POINTER; pos: INTEGER; v: POINTER) is
1116     -- Set pointer item at position `pos' in tuple `obj' with `v'.
1117     external
1118     "C macro use %"eif_rout_obj.h%""
1119     end
1120    
1121     eif_put_integer_8_item (obj: POINTER; pos: INTEGER; v: INTEGER_8) is
1122     -- Set integer_8 item at position `pos' in tuple `obj' with `v'.
1123     external
1124     "C macro use %"eif_rout_obj.h%""
1125     end
1126    
1127     eif_put_integer_16_item (obj: POINTER; pos: INTEGER; v: INTEGER_16) is
1128     -- Set integer_16 item at position `pos' in tuple `obj' with `v'.
1129     external
1130     "C macro use %"eif_rout_obj.h%""
1131     end
1132    
1133     eif_put_integer_32_item (obj: POINTER; pos: INTEGER; v: INTEGER) is
1134     -- Set integer_32 item at position `pos' in tuple `obj' with `v'.
1135     external
1136     "C macro use %"eif_rout_obj.h%""
1137     end
1138    
1139     eif_put_integer_64_item (obj: POINTER; pos: INTEGER; v: INTEGER_64) is
1140     -- Set integer_64 item at position `pos' in tuple `obj' with `v'.
1141     external
1142     "C macro use %"eif_rout_obj.h%""
1143     end
1144    
1145 manus_eiffel 91438 end

Properties

Name Value
svn:eol-style native
svn:keywords Author Date Id Revision

  ViewVC Help
Powered by ViewVC 1.1.23