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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 91424 - (show annotations)
Tue Oct 26 18:39:32 2004 UTC (15 years, 3 months ago) by manus_eiffel
File size: 31105 byte(s)
Initial revision

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

Properties

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

  ViewVC Help
Powered by ViewVC 1.1.23