/[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 91477 - (show annotations)
Sun Jan 14 09:47:13 2007 UTC (13 years ago) by ericb
File size: 39090 byte(s)
Synchronized with ISE 6.0.65740
1 indexing
2 description: "Implementation of TUPLE"
3 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 date: "$Date$"
7 revision: "$Revision$"
8
9 class
10 TUPLE
11
12 inherit
13 HASHABLE
14 redefine
15 is_equal
16 end
17
18 MISMATCH_CORRECTOR
19 redefine
20 correct_mismatch, is_equal
21 end
22
23 create
24 default_create, make
25
26 feature -- Creation
27
28 make is
29 obsolete
30 "Use no creation procedure to create a TUPLE instance"
31 do
32 end
33
34 feature -- Access
35
36 item alias "[]", infix "@" (index: INTEGER): ANY assign put is
37 -- Entry of key `index'.
38 require
39 valid_index: valid_index (index)
40 do
41 inspect eif_item_type ($Current, index)
42 when boolean_code then Result := eif_boolean_item ($Current, index)
43 when character_8_code then Result := eif_character_8_item ($Current, index)
44 when character_32_code then Result := eif_character_32_item ($Current, index)
45 when real_64_code then Result := eif_real_64_item ($Current, index)
46 when real_32_code then Result := eif_real_32_item ($Current, index)
47 when pointer_code then Result := eif_pointer_item ($Current, index)
48 when natural_8_code then Result := eif_natural_8_item ($Current, index)
49 when natural_16_code then Result := eif_natural_16_item ($Current, index)
50 when natural_32_code then Result := eif_natural_32_item ($Current, index)
51 when natural_64_code then Result := eif_natural_64_item ($Current, index)
52 when integer_8_code then Result := eif_integer_8_item ($Current, index)
53 when integer_16_code then Result := eif_integer_16_item ($Current, index)
54 when integer_32_code then Result := eif_integer_32_item ($Current, index)
55 when integer_64_code then Result := eif_integer_64_item ($Current, index)
56 when Reference_code then Result := eif_reference_item ($Current, index)
57 end
58 end
59
60 reference_item (index: INTEGER): ANY is
61 -- Reference item at `index'.
62 require
63 valid_index: valid_index (index)
64 is_reference: is_reference_item (index)
65 do
66 Result := eif_reference_item ($Current, index)
67 end
68
69 boolean_item (index: INTEGER): BOOLEAN is
70 -- Boolean item at `index'.
71 require
72 valid_index: valid_index (index)
73 is_boolean: is_boolean_item (index)
74 do
75 Result := eif_boolean_item ($Current, index)
76 end
77
78 character_8_item, character_item (index: INTEGER): CHARACTER_8 is
79 -- Character item at `index'.
80 require
81 valid_index: valid_index (index)
82 is_character_8: is_character_8_item (index)
83 do
84 Result := eif_character_8_item ($Current, index)
85 end
86
87 character_32_item, wide_character_item (index: INTEGER): CHARACTER_32 is
88 -- Character item at `index'.
89 require
90 valid_index: valid_index (index)
91 is_character_32: is_character_32_item (index)
92 do
93 Result := eif_character_32_item ($Current, index)
94 end
95
96 real_64_item, double_item (index: INTEGER): DOUBLE is
97 -- Double item at `index'.
98 require
99 valid_index: valid_index (index)
100 is_numeric: is_double_item (index)
101 do
102 Result := eif_real_64_item ($Current, index)
103 end
104
105 natural_8_item (index: INTEGER): NATURAL_8 is
106 -- NATURAL_8 item at `index'.
107 require
108 valid_index: valid_index (index)
109 is_integer: is_natural_8_item (index)
110 do
111 Result := eif_natural_8_item ($Current, index)
112 end
113
114 natural_16_item (index: INTEGER): NATURAL_16 is
115 -- NATURAL_16 item at `index'.
116 require
117 valid_index: valid_index (index)
118 is_integer: is_natural_16_item (index)
119 do
120 Result := eif_natural_16_item ($Current, index)
121 end
122
123 natural_32_item (index: INTEGER): NATURAL_32 is
124 -- NATURAL_32 item at `index'.
125 require
126 valid_index: valid_index (index)
127 is_integer: is_natural_32_item (index)
128 do
129 Result := eif_natural_32_item ($Current, index)
130 end
131
132 natural_64_item (index: INTEGER): NATURAL_64 is
133 -- NATURAL_64 item at `index'.
134 require
135 valid_index: valid_index (index)
136 is_integer: is_natural_64_item (index)
137 do
138 Result := eif_natural_64_item ($Current, index)
139 end
140
141 integer_8_item (index: INTEGER): INTEGER_8 is
142 -- INTEGER_8 item at `index'.
143 require
144 valid_index: valid_index (index)
145 is_integer: is_integer_8_item (index)
146 do
147 Result := eif_integer_8_item ($Current, index)
148 end
149
150 integer_16_item (index: INTEGER): INTEGER_16 is
151 -- INTEGER_16 item at `index'.
152 require
153 valid_index: valid_index (index)
154 is_integer: is_integer_16_item (index)
155 do
156 Result := eif_integer_16_item ($Current, index)
157 end
158
159 integer_item, integer_32_item (index: INTEGER): INTEGER is
160 -- INTEGER_32 item at `index'.
161 require
162 valid_index: valid_index (index)
163 is_integer: is_integer_32_item (index)
164 do
165 Result := eif_integer_32_item ($Current, index)
166 end
167
168 integer_64_item (index: INTEGER): INTEGER_64 is
169 -- INTEGER_64 item at `index'.
170 require
171 valid_index: valid_index (index)
172 is_integer: is_integer_64_item (index)
173 do
174 Result := eif_integer_64_item ($Current, index)
175 end
176
177 pointer_item (index: INTEGER): POINTER is
178 -- Pointer item at `index'.
179 require
180 valid_index: valid_index (index)
181 is_pointer: is_pointer_item (index)
182 do
183 Result := eif_pointer_item ($Current, index)
184 end
185
186 real_32_item, real_item (index: INTEGER): REAL is
187 -- real item at `index'.
188 require
189 valid_index: valid_index (index)
190 is_real_or_integer: is_real_item (index)
191 do
192 Result := eif_real_32_item ($Current, index)
193 end
194
195 feature -- Comparison
196
197 object_comparison: BOOLEAN is
198 -- Must search operations use `equal' rather than `='
199 -- for comparing references? (Default: no, use `='.)
200 do
201 Result := eif_boolean_item ($Current, 0)
202 end
203
204 is_equal (other: like Current): BOOLEAN is
205 -- Is `other' attached to an object considered
206 -- equal to current object?
207 local
208 i, nb: INTEGER
209 l_object_compare: BOOLEAN
210 do
211 l_object_compare := object_comparison
212 if l_object_compare = other.object_comparison then
213 if l_object_compare then
214 nb := count
215 if nb = other.count then
216 from
217 Result := True
218 i := 1
219 until
220 i = nb or not Result
221 loop
222 Result := equal (item (i), other.item (i))
223 i := i + 1
224 end
225 end
226 else
227 Result := Precursor {HASHABLE} (other)
228 end
229 end
230 end
231
232 feature -- Status setting
233
234 compare_objects is
235 -- Ensure that future search operations will use `equal'
236 -- rather than `=' for comparing references.
237 do
238 eif_put_boolean_item ($Current, 0, True)
239 ensure
240 object_comparison: object_comparison
241 end
242
243 compare_references is
244 -- Ensure that future search operations will use `='
245 -- rather than `equal' for comparing references.
246 do
247 eif_put_boolean_item ($Current, 0, False)
248 ensure
249 reference_comparison: not object_comparison
250 end
251
252 feature -- Status report
253
254 hash_code: INTEGER is
255 -- Hash code value
256 local
257 i, nb, l_hash: INTEGER
258 l_key: HASHABLE
259 do
260 from
261 i := 1
262 nb := count
263 until
264 i > nb
265 loop
266 inspect eif_item_type($Current, i)
267 when boolean_code then l_hash := eif_boolean_item ($Current, i).hash_code
268 when character_8_code then l_hash := eif_character_8_item ($Current, i).hash_code
269 when character_32_code then l_hash := eif_character_32_item ($Current, i).hash_code
270 when real_64_code then l_hash := eif_real_64_item ($Current, i).hash_code
271 when real_32_code then l_hash := eif_real_32_item ($Current, i).hash_code
272 when pointer_code then l_hash := eif_pointer_item ($Current, i).hash_code
273 when natural_8_code then l_hash := eif_natural_8_item ($Current, i).hash_code
274 when natural_16_code then l_hash := eif_natural_16_item ($Current, i).hash_code
275 when natural_32_code then l_hash := eif_natural_32_item ($Current, i).hash_code
276 when natural_64_code then l_hash := eif_natural_64_item ($Current, i).hash_code
277 when integer_8_code then l_hash := eif_integer_8_item ($Current, i).hash_code
278 when integer_16_code then l_hash := eif_integer_16_item ($Current, i).hash_code
279 when integer_32_code then l_hash := eif_integer_32_item ($Current, i).hash_code
280 when integer_64_code then l_hash := eif_integer_64_item ($Current, i).hash_code
281 when reference_code then
282 l_key ?= eif_reference_item ($Current, i)
283 if l_key /= Void then
284 l_hash := l_key.hash_code
285 else
286 l_hash := 0
287 end
288 end
289 Result := Result + l_hash * internal_primes.i_th (i)
290 i := i + 1
291 end
292 -- Ensure it is a positive value.
293 Result := Result.hash_code
294 end
295
296 valid_index (k: INTEGER): BOOLEAN is
297 -- Is `k' a valid key?
298 do
299 Result := k >= 1 and then k <= count
300 end
301
302 valid_type_for_index (v: ANY; index: INTEGER): BOOLEAN is
303 -- Is object `v' a valid target for element at position `index'?
304 require
305 valid_index: valid_index (index)
306 local
307 l_b: BOOLEAN_REF
308 l_c: CHARACTER_REF
309 l_wc: CHARACTER_32_REF
310 l_d: DOUBLE_REF
311 l_r: REAL_REF
312 l_p: POINTER_REF
313 l_ui8: NATURAL_8_REF
314 l_ui16: NATURAL_16_REF
315 l_ui32: NATURAL_32_REF
316 l_ui64: NATURAL_64_REF
317 l_i8: INTEGER_8_REF
318 l_i16: INTEGER_16_REF
319 l_i32: INTEGER_REF
320 l_i64: INTEGER_64_REF
321 l_int: INTERNAL
322 do
323 if v = Void then
324 -- A Void entry is always valid.
325 Result := True
326 else
327 inspect eif_item_type ($Current, index)
328 when boolean_code then l_b ?= v; Result := l_b /= Void
329 when character_8_code then l_c ?= v; Result := l_c /= Void
330 when character_32_code then l_wc ?= v; Result := l_wc /= Void
331 when real_64_code then l_d ?= v; Result := l_d /= Void
332 when real_32_code then l_r ?= v; Result := l_r /= Void
333 when pointer_code then l_p ?= v; Result := l_p /= Void
334 when natural_8_code then l_ui8 ?= v; Result := l_ui8 /= Void
335 when natural_16_code then l_ui16 ?= v; Result := l_ui16 /= Void
336 when natural_32_code then l_ui32 ?= v; Result := l_ui32 /= Void
337 when natural_64_code then l_ui64 ?= v; Result := l_ui64 /= Void
338 when integer_8_code then l_i8 ?= v; Result := l_i8 /= Void
339 when integer_16_code then l_i16 ?= v; Result := l_i16 /= Void
340 when integer_32_code then l_i32 ?= v; Result := l_i32 /= Void
341 when integer_64_code then l_i64 ?= v; Result := l_i64 /= Void
342 when Reference_code then
343 -- Let's check that type of `v' conforms to specified type of `index'-th
344 -- arguments of current TUPLE.
345 create l_int
346 Result := l_int.type_conforms_to
347 (l_int.dynamic_type (v), l_int.generic_dynamic_type (Current, index))
348 end
349 end
350 end
351
352 count: INTEGER is
353 -- Number of element in Current.
354 do
355 -- `-1' because we always allocate one item more to avoid
356 -- to do `-1' each time we want to access or store an item
357 -- of current.
358 Result := {ISE_RUNTIME}.sp_count ($Current) - 1
359 end
360
361 lower: INTEGER is 1
362 -- Lower bound of TUPLE.
363
364 upper: INTEGER is
365 -- Upper bound of TUPLE.
366 do
367 Result := count
368 end
369
370 is_empty: BOOLEAN is
371 -- Is Current empty?
372 do
373 Result := count = 0
374 end
375
376 feature -- Element change
377
378 put (v: ANY; index: INTEGER) is
379 -- Insert `v' at position `index'.
380 require
381 valid_index: valid_index (index)
382 valid_type_for_index: valid_type_for_index (v, index)
383 do
384 inspect eif_item_type ($Current, index)
385 when boolean_code then eif_put_boolean_item_with_object ($Current, index, $v)
386 when character_8_code then eif_put_character_8_item_with_object ($Current, index, $v)
387 when character_32_code then eif_put_character_32_item_with_object ($Current, index, $v)
388 when real_64_code then eif_put_real_64_item_with_object ($Current, index, $v)
389 when real_32_code then eif_put_real_32_item_with_object ($Current, index, $v)
390 when pointer_code then eif_put_pointer_item_with_object ($Current, index, $v)
391 when natural_8_code then eif_put_natural_8_item_with_object ($Current, index, $v)
392 when natural_16_code then eif_put_natural_16_item_with_object ($Current, index, $v)
393 when natural_32_code then eif_put_natural_32_item_with_object ($Current, index, $v)
394 when natural_64_code then eif_put_natural_64_item_with_object ($Current, index, $v)
395 when integer_8_code then eif_put_integer_8_item_with_object ($Current, index, $v)
396 when integer_16_code then eif_put_integer_16_item_with_object ($Current, index, $v)
397 when integer_32_code then eif_put_integer_32_item_with_object ($Current, index, $v)
398 when integer_64_code then eif_put_integer_64_item_with_object ($Current, index, $v)
399 when Reference_code then eif_put_reference_item_with_object ($Current, index, $v)
400 end
401 end
402
403 put_reference (v: ANY; index: INTEGER) is
404 -- Put `v' at position `index' in Current.
405 require
406 valid_index: valid_index (index)
407 valid_type: is_reference_item (index)
408 do
409 eif_put_reference_item_with_object ($Current, index, $v)
410 end
411
412 put_boolean (v: BOOLEAN; index: INTEGER) is
413 -- Put `v' at position `index' in Current.
414 require
415 valid_index: valid_index (index)
416 valid_type: is_boolean_item (index)
417 do
418 eif_put_boolean_item ($Current, index, v)
419 end
420
421 put_character_8, put_character (v: CHARACTER_8; index: INTEGER) is
422 -- Put `v' at position `index' in Current.
423 require
424 valid_index: valid_index (index)
425 valid_type: is_character_8_item (index)
426 do
427 eif_put_character_8_item ($Current, index, v)
428 end
429
430 put_character_32, put_wide_character (v: CHARACTER_32; index: INTEGER) is
431 -- Put `v' at position `index' in Current.
432 require
433 valid_index: valid_index (index)
434 valid_type: is_character_32_item (index)
435 do
436 eif_put_character_32_item ($Current, index, v)
437 end
438
439 put_real_64, put_double (v: DOUBLE; index: INTEGER) is
440 -- Put `v' at position `index' in Current.
441 require
442 valid_index: valid_index (index)
443 valid_type: is_double_item (index)
444 do
445 eif_put_real_64_item ($Current, index, v)
446 end
447
448 put_real_32, put_real (v: REAL; index: INTEGER) is
449 -- Put `v' at position `index' in Current.
450 require
451 valid_index: valid_index (index)
452 valid_type: is_real_item (index)
453 do
454 eif_put_real_32_item ($Current, index, v)
455 end
456
457 put_pointer (v: POINTER; index: INTEGER) is
458 -- Put `v' at position `index' in Current.
459 require
460 valid_index: valid_index (index)
461 valid_type: is_pointer_item (index)
462 do
463 eif_put_pointer_item ($Current, index, v)
464 end
465
466 put_natural_8 (v: NATURAL_8; index: INTEGER) is
467 -- Put `v' at position `index' in Current.
468 require
469 valid_index: valid_index (index)
470 valid_type: is_natural_8_item (index)
471 do
472 eif_put_natural_8_item ($Current, index, v)
473 end
474
475 put_natural_16 (v: NATURAL_16; index: INTEGER) is
476 -- Put `v' at position `index' in Current.
477 require
478 valid_index: valid_index (index)
479 valid_type: is_natural_16_item (index)
480 do
481 eif_put_natural_16_item ($Current, index, v)
482 end
483
484 put_natural_32 (v: NATURAL_32; index: INTEGER) is
485 -- Put `v' at position `index' in Current.
486 require
487 valid_index: valid_index (index)
488 valid_type: is_natural_32_item (index)
489 do
490 eif_put_natural_32_item ($Current, index, v)
491 end
492
493 put_natural_64 (v: NATURAL_64; index: INTEGER) is
494 -- Put `v' at position `index' in Current.
495 require
496 valid_index: valid_index (index)
497 valid_type: is_natural_64_item (index)
498 do
499 eif_put_natural_64_item ($Current, index, v)
500 end
501
502 put_integer, put_integer_32 (v: INTEGER; index: INTEGER) is
503 -- Put `v' at position `index' in Current.
504 require
505 valid_index: valid_index (index)
506 valid_type: is_integer_32_item (index)
507 do
508 eif_put_integer_32_item ($Current, index, v)
509 end
510
511 put_integer_8 (v: INTEGER_8; index: INTEGER) is
512 -- Put `v' at position `index' in Current.
513 require
514 valid_index: valid_index (index)
515 valid_type: is_integer_8_item (index)
516 do
517 eif_put_integer_8_item ($Current, index, v)
518 end
519
520 put_integer_16 (v: INTEGER_16; index: INTEGER) is
521 -- Put `v' at position `index' in Current.
522 require
523 valid_index: valid_index (index)
524 valid_type: is_integer_16_item (index)
525 do
526 eif_put_integer_16_item ($Current, index, v)
527 end
528
529 put_integer_64 (v: INTEGER_64; index: INTEGER) is
530 -- Put `v' at position `index' in Current.
531 require
532 valid_index: valid_index (index)
533 valid_type: is_integer_64_item (index)
534 do
535 eif_put_integer_64_item ($Current, index, v)
536 end
537
538 feature -- Type queries
539
540 is_boolean_item (index: INTEGER): BOOLEAN is
541 -- Is item at `index' a BOOLEAN?
542 require
543 valid_index: valid_index (index)
544 do
545 Result := (eif_item_type ($Current, index) = boolean_code)
546 end
547
548 is_character_8_item, is_character_item (index: INTEGER): BOOLEAN is
549 -- Is item at `index' a CHARACTER_8?
550 require
551 valid_index: valid_index (index)
552 do
553 Result := (eif_item_type ($Current, index) = character_8_code)
554 end
555
556 is_character_32_item, is_wide_character_item (index: INTEGER): BOOLEAN is
557 -- Is item at `index' a CHARACTER_32?
558 require
559 valid_index: valid_index (index)
560 do
561 Result := (eif_item_type ($Current, index) = character_32_code)
562 end
563
564 is_double_item (index: INTEGER): BOOLEAN is
565 -- Is item at `index' a DOUBLE?
566 require
567 valid_index: valid_index (index)
568 do
569 Result := (eif_item_type ($Current, index) = real_64_code)
570 end
571
572 is_natural_8_item (index: INTEGER): BOOLEAN is
573 -- Is item at `index' an NATURAL_8?
574 require
575 valid_index: valid_index (index)
576 do
577 Result := (eif_item_type ($Current, index) = natural_8_code)
578 end
579
580 is_natural_16_item (index: INTEGER): BOOLEAN is
581 -- Is item at `index' an NATURAL_16?
582 require
583 valid_index: valid_index (index)
584 do
585 Result := (eif_item_type ($Current, index) = natural_16_code)
586 end
587
588 is_natural_32_item (index: INTEGER): BOOLEAN is
589 -- Is item at `index' an NATURAL_32?
590 require
591 valid_index: valid_index (index)
592 do
593 Result := (eif_item_type ($Current, index) = natural_32_code)
594 end
595
596 is_natural_64_item (index: INTEGER): BOOLEAN is
597 -- Is item at `index' an NATURAL_64?
598 require
599 valid_index: valid_index (index)
600 do
601 Result := (eif_item_type ($Current, index) = natural_64_code)
602 end
603
604 is_integer_8_item (index: INTEGER): BOOLEAN is
605 -- Is item at `index' an INTEGER_8?
606 require
607 valid_index: valid_index (index)
608 do
609 Result := (eif_item_type ($Current, index) = integer_8_code)
610 end
611
612 is_integer_16_item (index: INTEGER): BOOLEAN is
613 -- Is item at `index' an INTEGER_16?
614 require
615 valid_index: valid_index (index)
616 do
617 Result := (eif_item_type ($Current, index) = integer_16_code)
618 end
619
620 is_integer_item, is_integer_32_item (index: INTEGER): BOOLEAN is
621 -- Is item at `index' an INTEGER_32?
622 require
623 valid_index: valid_index (index)
624 do
625 Result := (eif_item_type ($Current, index) = integer_32_code)
626 end
627
628 is_integer_64_item (index: INTEGER): BOOLEAN is
629 -- Is item at `index' an INTEGER_64?
630 require
631 valid_index: valid_index (index)
632 do
633 Result := (eif_item_type ($Current, index) = integer_64_code)
634 end
635
636 is_pointer_item (index: INTEGER): BOOLEAN is
637 -- Is item at `index' a POINTER?
638 require
639 valid_index: valid_index (index)
640 do
641 Result := (eif_item_type ($Current, index) = pointer_code)
642 end
643
644 is_real_item (index: INTEGER): BOOLEAN is
645 -- Is item at `index' a REAL?
646 require
647 valid_index: valid_index (index)
648 do
649 Result := (eif_item_type ($Current, index) = real_32_code)
650 end
651
652 is_reference_item (index: INTEGER): BOOLEAN is
653 -- Is item at `index' a REFERENCE?
654 require
655 valid_index: valid_index (index)
656 do
657 Result := (eif_item_type ($Current, index) = reference_code)
658 end
659
660 is_numeric_item (index: INTEGER): BOOLEAN is
661 -- Is item at `index' a number?
662 obsolete
663 "Use the precise type query instead."
664 require
665 valid_index: valid_index (index)
666 local
667 tcode: like item_code
668 do
669 tcode := eif_item_type ($Current, index)
670 inspect tcode
671 when
672 integer_8_code, integer_16_code, integer_32_code,
673 integer_64_code, real_32_code, real_64_code
674 then
675 Result := True
676 else
677 -- Nothing to do here since Result already initialized to False.
678 end
679 end
680
681 is_uniform: BOOLEAN is
682 -- Are all items of the same basic type or all of reference type?
683 do
684 Result := is_tuple_uniform (any_code)
685 ensure
686 yes_if_empty: (count = 0) implies Result
687 end
688
689 is_uniform_boolean: BOOLEAN is
690 -- Are all items of type BOOLEAN?
691 do
692 Result := is_tuple_uniform (boolean_code)
693 ensure
694 yes_if_empty: (count = 0) implies Result
695 end
696
697 is_uniform_character_8, is_uniform_character: BOOLEAN is
698 -- Are all items of type CHARACTER_8?
699 do
700 Result := is_tuple_uniform (character_8_code)
701 ensure
702 yes_if_empty: (count = 0) implies Result
703 end
704
705 is_uniforme_character_32, is_uniform_wide_character: BOOLEAN is
706 -- Are all items of type CHARACTER_32?
707 do
708 Result := is_tuple_uniform (character_32_code)
709 ensure
710 yes_if_empty: (count = 0) implies Result
711 end
712
713 is_uniform_double: BOOLEAN is
714 -- Are all items of type DOUBLE?
715 do
716 Result := is_tuple_uniform (real_64_code)
717 ensure
718 yes_if_empty: (count = 0) implies Result
719 end
720
721 is_uniform_natural_8: BOOLEAN is
722 -- Are all items of type NATURAL_8?
723 do
724 Result := is_tuple_uniform (natural_8_code)
725 ensure
726 yes_if_empty: (count = 0) implies Result
727 end
728
729 is_uniform_natural_16: BOOLEAN is
730 -- Are all items of type NATURAL_16?
731 do
732 Result := is_tuple_uniform (natural_16_code)
733 ensure
734 yes_if_empty: (count = 0) implies Result
735 end
736
737 is_uniform_natural_32: BOOLEAN is
738 -- Are all items of type NATURAL_32?
739 do
740 Result := is_tuple_uniform (natural_32_code)
741 ensure
742 yes_if_empty: (count = 0) implies Result
743 end
744
745 is_uniform_natural_64: BOOLEAN is
746 -- Are all items of type NATURAL_64?
747 do
748 Result := is_tuple_uniform (natural_64_code)
749 ensure
750 yes_if_empty: (count = 0) implies Result
751 end
752
753 is_uniform_integer_8: BOOLEAN is
754 -- Are all items of type INTEGER_8?
755 do
756 Result := is_tuple_uniform (integer_8_code)
757 ensure
758 yes_if_empty: (count = 0) implies Result
759 end
760
761 is_uniform_integer_16: BOOLEAN is
762 -- Are all items of type INTEGER_16?
763 do
764 Result := is_tuple_uniform (integer_16_code)
765 ensure
766 yes_if_empty: (count = 0) implies Result
767 end
768
769 is_uniform_integer, is_uniform_integer_32: BOOLEAN is
770 -- Are all items of type INTEGER?
771 do
772 Result := is_tuple_uniform (integer_32_code)
773 ensure
774 yes_if_empty: (count = 0) implies Result
775 end
776
777 is_uniform_integer_64: BOOLEAN is
778 -- Are all items of type INTEGER_64?
779 do
780 Result := is_tuple_uniform (integer_64_code)
781 ensure
782 yes_if_empty: (count = 0) implies Result
783 end
784
785 is_uniform_pointer: BOOLEAN is
786 -- Are all items of type POINTER?
787 do
788 Result := is_tuple_uniform (pointer_code)
789 ensure
790 yes_if_empty: (count = 0) implies Result
791 end
792
793 is_uniform_real: BOOLEAN is
794 -- Are all items of type REAL?
795 do
796 Result := is_tuple_uniform (real_32_code)
797 ensure
798 yes_if_empty: (count = 0) implies Result
799 end
800
801 is_uniform_reference: BOOLEAN is
802 -- Are all items of reference type?
803 do
804 Result := is_tuple_uniform (reference_code)
805 ensure
806 yes_if_empty: (count = 0) implies Result
807 end
808
809 feature -- Type conversion queries
810
811 convertible_to_double: BOOLEAN is
812 -- Is current convertible to an array of doubles?
813 obsolete
814 "Will be removed in future releases"
815 local
816 i, cnt: INTEGER
817 tcode: like item_code
818 do
819 Result := True
820 from
821 i := 1
822 cnt := count
823 until
824 i > cnt or else not Result
825 loop
826 tcode := eif_item_type ($Current, i)
827 inspect tcode
828 when
829 integer_8_code, integer_16_code, integer_32_code,
830 integer_64_code, real_32_code, real_64_code
831 then
832 Result := True
833 else
834 Result := False
835 end
836 i := i + 1
837 end
838 ensure
839 yes_if_empty: (count = 0) implies Result
840 end
841
842 convertible_to_real: BOOLEAN is
843 -- Is current convertible to an array of reals?
844 obsolete
845 "Will be removed in future releases"
846 local
847 i, cnt: INTEGER
848 tcode: like item_code
849 do
850 Result := True
851 from
852 i := 1
853 cnt := count
854 until
855 i > cnt or else not Result
856 loop
857 tcode := eif_item_type ($Current, i)
858 inspect tcode
859 when
860 integer_8_code, integer_16_code, integer_32_code,
861 integer_64_code, real_32_code
862 then
863 Result := True
864 else
865 Result := False
866 end
867 i := i + 1
868 end
869 ensure
870 yes_if_empty: (count = 0) implies Result
871 end
872
873 feature -- Conversion
874
875 arrayed: ARRAY [ANY] is
876 -- Items of Current as array
877 obsolete
878 "Will be removed in future releases"
879 local
880 i, cnt: INTEGER
881 do
882 from
883 i := 1
884 cnt := count
885 create Result.make (1, cnt)
886 until
887 i > cnt
888 loop
889 Result.put (item (i), i)
890 i := i + 1
891 end
892 ensure
893 exists: Result /= Void
894 same_count: Result.count = count
895 same_items: -- Items are the same in same order
896 end
897
898 boolean_arrayed: ARRAY [BOOLEAN] is
899 -- Items of Current as array
900 obsolete
901 "Will be removed in future releases"
902 require
903 is_uniform_boolean: is_uniform_boolean
904 local
905 i, cnt: INTEGER
906 do
907 from
908 i := 1
909 cnt := count
910 create Result.make (1, cnt)
911 until
912 i > cnt
913 loop
914 Result.put (boolean_item (i), i)
915 i := i + 1
916 end
917 ensure
918 exists: Result /= Void
919 same_count: Result.count = count
920 same_items: -- Items are the same in same order
921 end
922
923 character_8_arrayed, character_arrayed: ARRAY [CHARACTER_8] is
924 -- Items of Current as array
925 obsolete
926 "Will be removed in future releases"
927 require
928 is_uniform_character: is_uniform_character
929 local
930 i, cnt: INTEGER
931 do
932 from
933 i := 1
934 cnt := count
935 create Result.make (1, cnt)
936 until
937 i > cnt
938 loop
939 Result.put (character_8_item (i), i)
940 i := i + 1
941 end
942 ensure
943 exists: Result /= Void
944 same_count: Result.count = count
945 same_items: -- Items are the same in same order
946 end
947
948 double_arrayed: ARRAY [DOUBLE] is
949 -- Items of Current as array
950 obsolete
951 "Will be removed in future releases"
952 require
953 convertible: convertible_to_double
954 local
955 i, cnt: INTEGER
956 do
957 from
958 i := 1
959 cnt := count
960 create Result.make (1, cnt)
961 until
962 i > cnt
963 loop
964 Result.put (double_item (i), i)
965 i := i + 1
966 end
967 ensure
968 exists: Result /= Void
969 same_count: Result.count = count
970 same_items: -- Items are the same in same order
971 end
972
973 integer_arrayed: ARRAY [INTEGER] is
974 -- Items of Current as array
975 obsolete
976 "Will be removed in future releases"
977 require
978 is_uniform_integer: is_uniform_integer
979 local
980 i, cnt: INTEGER
981 do
982 from
983 i := 1
984 cnt := count
985 create Result.make (1, cnt)
986 until
987 i > cnt
988 loop
989 Result.put (integer_32_item (i), i)
990 i := i + 1
991 end
992 ensure
993 exists: Result /= Void
994 same_count: Result.count = count
995 same_items: -- Items are the same in same order
996 end
997
998 pointer_arrayed: ARRAY [POINTER] is
999 -- Items of Current as array
1000 obsolete
1001 "Will be removed in future releases"
1002 require
1003 is_uniform_pointer: is_uniform_pointer
1004 local
1005 i, cnt: INTEGER
1006 do
1007 from
1008 i := 1
1009 cnt := count
1010 create Result.make (1, cnt)
1011 until
1012 i > cnt
1013 loop
1014 Result.put (pointer_item (i), i)
1015 i := i + 1
1016 end
1017 ensure
1018 exists: Result /= Void
1019 same_count: Result.count = count
1020 same_items: -- Items are the same in same order
1021 end
1022
1023 real_arrayed: ARRAY [REAL] is
1024 -- Items of Current as array
1025 obsolete
1026 "Will be removed in future releases"
1027 require
1028 convertible: convertible_to_real
1029 local
1030 i, cnt: INTEGER
1031 do
1032 from
1033 i := 1
1034 cnt := count
1035 create Result.make (1, cnt)
1036 until
1037 i > cnt
1038 loop
1039 Result.put (real_item (i), i)
1040 i := i + 1
1041 end
1042 ensure
1043 exists: Result /= Void
1044 same_count: Result.count = count
1045 same_items: -- Items are the same in same order
1046 end
1047
1048 string_arrayed: ARRAY [STRING] is
1049 -- Items of Current as array
1050 -- NOTE: Items with a type not cconforming to
1051 -- type STRING are set to Void.
1052 obsolete
1053 "Will be removed in future releases"
1054 local
1055 i, cnt: INTEGER
1056 s: STRING
1057 do
1058 from
1059 i := 1
1060 cnt := count
1061 create Result.make (1, cnt)
1062 until
1063 i > cnt
1064 loop
1065 s ?= item (i)
1066 Result.put (s, i)
1067 i := i + 1
1068 end
1069 ensure
1070 exists: Result /= Void
1071 same_count: Result.count = count
1072 end
1073
1074 feature -- Retrieval
1075
1076 correct_mismatch is
1077 -- Attempt to correct object mismatch using `mismatch_information'.
1078 local
1079 l_area: SPECIAL [ANY]
1080 i, nb: INTEGER
1081 l_any: ANY
1082 do
1083 -- Old version of TUPLE had a SPECIAL [ANY] to store all values.
1084 -- If we can get access to it, then most likely we can recover this
1085 -- old TUPLE implementation.
1086 l_area ?= Mismatch_information.item (area_name)
1087 if l_area /= Void then
1088 from
1089 i := 1
1090 nb := l_area.count
1091 until
1092 i > nb
1093 loop
1094 l_any := l_area.item (i - 1)
1095 if valid_type_for_index (l_any, i) then
1096 put (l_any, i)
1097 else
1098 -- We found an unexpected type in old special. We cannot go on.
1099 Precursor {MISMATCH_CORRECTOR}
1100 end
1101 i := i + 1
1102 end
1103 else
1104 Precursor {MISMATCH_CORRECTOR}
1105 end
1106 end
1107
1108 feature -- Access
1109
1110 item_code (index: INTEGER): NATURAL_8 is
1111 -- Type code of item at `index'. Used for
1112 -- argument processing in ROUTINE
1113 require
1114 valid_index: valid_index (index)
1115 do
1116 Result := eif_item_type ($Current, index)
1117 end
1118
1119 reference_code: NATURAL_8 is 0x00
1120 boolean_code: NATURAL_8 is 0x01
1121 character_8_code, character_code: NATURAL_8 is 0x02
1122 real_64_code: NATURAL_8 is 0x03
1123 real_32_code: NATURAL_8 is 0x04
1124 pointer_code: NATURAL_8 is 0x05
1125 integer_8_code: NATURAL_8 is 0x06
1126 integer_16_code: NATURAL_8 is 0x07
1127 integer_32_code: NATURAL_8 is 0x08
1128 integer_64_code: NATURAL_8 is 0x09
1129 natural_8_code: NATURAL_8 is 0x0A
1130 natural_16_code: NATURAL_8 is 0x0B
1131 natural_32_code: NATURAL_8 is 0x0C
1132 natural_64_code: NATURAL_8 is 0x0D
1133 character_32_code, wide_character_code: NATURAL_8 is 0x0E
1134 any_code: NATURAL_8 is 0xFF
1135 -- Code used to identify type in TUPLE.
1136
1137 feature {NONE} -- Implementation
1138
1139 area_name: STRING is "area"
1140 -- Name of attributes where TUPLE elements were stored.
1141
1142 is_tuple_uniform (code: like item_code): BOOLEAN is
1143 -- Are all items of type `code'?
1144 local
1145 i, nb: INTEGER
1146 l_code: like item_code
1147 do
1148 Result := True
1149 if count > 0 then
1150 from
1151 nb := count
1152 if code = any_code then
1153 -- We take first type code and compare all the remaining ones
1154 -- against it.
1155 i := 2
1156 l_code := eif_item_type ($Current, 1)
1157 else
1158 i := 1
1159 l_code := code
1160 end
1161 until
1162 i > nb or not Result
1163 loop
1164 Result := l_code = eif_item_type ($Current, i)
1165 i := i + 1
1166 end
1167 end
1168 end
1169
1170 internal_primes: PRIMES is
1171 -- For quick access to prime numbers.
1172 once
1173 create Result
1174 end
1175
1176 feature {NONE} -- Externals: Access
1177
1178 eif_item_type (obj: POINTER; pos: INTEGER): NATURAL_8 is
1179 -- Code for generic parameter `pos' in `obj'.
1180 external
1181 "C macro use %"eif_rout_obj.h%""
1182 alias
1183 "eif_item_type"
1184 end
1185
1186 eif_boolean_item (obj: POINTER; pos: INTEGER): BOOLEAN is
1187 -- Boolean item at position `pos' in tuple `obj'.
1188 external
1189 "C macro use %"eif_rout_obj.h%""
1190 end
1191
1192 eif_character_8_item (obj: POINTER; pos: INTEGER): CHARACTER_8 is
1193 -- Character item at position `pos' in tuple `obj'.
1194 external
1195 "C macro use %"eif_rout_obj.h%""
1196 end
1197
1198 eif_character_32_item (obj: POINTER; pos: INTEGER): CHARACTER_32 is
1199 -- Wide character item at position `pos' in tuple `obj'.
1200 external
1201 "C macro use %"eif_rout_obj.h%""
1202 end
1203
1204 eif_real_64_item (obj: POINTER; pos: INTEGER): DOUBLE is
1205 -- Double item at position `pos' in tuple `obj'.
1206 external
1207 "C macro use %"eif_rout_obj.h%""
1208 end
1209
1210 eif_real_32_item (obj: POINTER; pos: INTEGER): REAL is
1211 -- Real item at position `pos' in tuple `obj'.
1212 external
1213 "C macro use %"eif_rout_obj.h%""
1214 end
1215
1216 eif_pointer_item (obj: POINTER; pos: INTEGER): POINTER is
1217 -- Pointer item at position `pos' in tuple `obj'.
1218 external
1219 "C macro use %"eif_rout_obj.h%""
1220 end
1221
1222 eif_natural_8_item (obj: POINTER; pos: INTEGER): NATURAL_8 is
1223 -- NATURAL_8 item at position `pos' in tuple `obj'.
1224 external
1225 "C macro use %"eif_rout_obj.h%""
1226 end
1227
1228 eif_natural_16_item (obj: POINTER; pos: INTEGER): NATURAL_16 is
1229 -- NATURAL_16 item at position `pos' in tuple `obj'.
1230 external
1231 "C macro use %"eif_rout_obj.h%""
1232 end
1233
1234 eif_natural_32_item (obj: POINTER; pos: INTEGER): NATURAL_32 is
1235 -- NATURAL_32 item at position `pos' in tuple `obj'.
1236 external
1237 "C macro use %"eif_rout_obj.h%""
1238 end
1239
1240 eif_natural_64_item (obj: POINTER; pos: INTEGER): NATURAL_64 is
1241 -- NATURAL_64 item at position `pos' in tuple `obj'.
1242 external
1243 "C macro use %"eif_rout_obj.h%""
1244 end
1245
1246 eif_integer_8_item (obj: POINTER; pos: INTEGER): INTEGER_8 is
1247 -- INTEGER_8 item at position `pos' in tuple `obj'.
1248 external
1249 "C macro use %"eif_rout_obj.h%""
1250 end
1251
1252 eif_integer_16_item (obj: POINTER; pos: INTEGER): INTEGER_16 is
1253 -- INTEGER_16 item at position `pos' in tuple `obj'.
1254 external
1255 "C macro use %"eif_rout_obj.h%""
1256 end
1257
1258 eif_integer_32_item (obj: POINTER; pos: INTEGER): INTEGER is
1259 -- INTEGER_32 item at position `pos' in tuple `obj'.
1260 external
1261 "C macro use %"eif_rout_obj.h%""
1262 end
1263
1264 eif_integer_64_item (obj: POINTER; pos: INTEGER): INTEGER_64 is
1265 -- INTEGER_64 item at position `pos' in tuple `obj'.
1266 external
1267 "C macro use %"eif_rout_obj.h%""
1268 end
1269
1270 eif_reference_item (obj: POINTER; pos: INTEGER): ANY is
1271 -- Reference item at position `pos' in tuple `obj'.
1272 external
1273 "C macro use %"eif_rout_obj.h%""
1274 end
1275
1276 feature {NONE} -- Externals: Setting
1277
1278 eif_put_boolean_item_with_object (obj: POINTER; pos: INTEGER; v: POINTER) is
1279 -- Set boolean item at position `pos' in tuple `obj' with `v'.
1280 external
1281 "C macro use %"eif_rout_obj.h%""
1282 end
1283
1284 eif_put_character_8_item_with_object (obj: POINTER; pos: INTEGER; v: POINTER) is
1285 -- Set character item at position `pos' in tuple `obj' with `v'.
1286 external
1287 "C macro use %"eif_rout_obj.h%""
1288 end
1289
1290 eif_put_character_32_item_with_object (obj: POINTER; pos: INTEGER; v: POINTER) is
1291 -- Set wide character item at position `pos' in tuple `obj' with `v'.
1292 external
1293 "C macro use %"eif_rout_obj.h%""
1294 end
1295
1296 eif_put_real_64_item_with_object (obj: POINTER; pos: INTEGER; v: POINTER) is
1297 -- Set double item at position `pos' in tuple `obj' with `v'.
1298 external
1299 "C macro use %"eif_rout_obj.h%""
1300 end
1301
1302 eif_put_real_32_item_with_object (obj: POINTER; pos: INTEGER; v: POINTER) is
1303 -- Set real item at position `pos' in tuple `obj' with `v'.
1304 external
1305 "C macro use %"eif_rout_obj.h%""
1306 end
1307
1308 eif_put_pointer_item_with_object (obj: POINTER; pos: INTEGER; v: POINTER) is
1309 -- Set pointer item at position `pos' in tuple `obj' with `v'.
1310 external
1311 "C macro use %"eif_rout_obj.h%""
1312 end
1313
1314 eif_put_natural_8_item_with_object (obj: POINTER; pos: INTEGER; v: POINTER) is
1315 -- Set NATURAL_8 item at position `pos' in tuple `obj' with `v'.
1316 external
1317 "C macro use %"eif_rout_obj.h%""
1318 end
1319
1320 eif_put_natural_16_item_with_object (obj: POINTER; pos: INTEGER; v: POINTER) is
1321 -- Set NATURAL_16 item at position `pos' in tuple `obj' with `v'.
1322 external
1323 "C macro use %"eif_rout_obj.h%""
1324 end
1325
1326 eif_put_natural_32_item_with_object (obj: POINTER; pos: INTEGER; v: POINTER) is
1327 -- Set NATURAL_32 item at position `pos' in tuple `obj' with `v'.
1328 external
1329 "C macro use %"eif_rout_obj.h%""
1330 end
1331
1332 eif_put_natural_64_item_with_object (obj: POINTER; pos: INTEGER; v: POINTER) is
1333 -- Set NATURAL_64 item at position `pos' in tuple `obj' with `v'.
1334 external
1335 "C macro use %"eif_rout_obj.h%""
1336 end
1337
1338 eif_put_integer_8_item_with_object (obj: POINTER; pos: INTEGER; v: POINTER) is
1339 -- Set integer_8 item at position `pos' in tuple `obj' with `v'.
1340 external
1341 "C macro use %"eif_rout_obj.h%""
1342 end
1343
1344 eif_put_integer_16_item_with_object (obj: POINTER; pos: INTEGER; v: POINTER) is
1345 -- Set integer_16 item at position `pos' in tuple `obj' with `v'.
1346 external
1347 "C macro use %"eif_rout_obj.h%""
1348 end
1349
1350 eif_put_integer_32_item_with_object (obj: POINTER; pos: INTEGER; v: POINTER) is
1351 -- Set integer_32 item at position `pos' in tuple `obj' with `v'.
1352 external
1353 "C macro use %"eif_rout_obj.h%""
1354 end
1355
1356 eif_put_integer_64_item_with_object (obj: POINTER; pos: INTEGER; v: POINTER) is
1357 -- Set integer_64 item at position `pos' in tuple `obj' with `v'.
1358 external
1359 "C macro use %"eif_rout_obj.h%""
1360 end
1361
1362 eif_put_reference_item_with_object (obj: POINTER; pos: INTEGER; v: POINTER) is
1363 -- Set reference item at position `pos' in tuple `obj' with `v'.
1364 external
1365 "C macro use %"eif_rout_obj.h%""
1366 end
1367
1368 eif_put_boolean_item (obj: POINTER; pos: INTEGER; v: BOOLEAN) is
1369 -- Set boolean item at position `pos' in tuple `obj' with `v'.
1370 external
1371 "C macro use %"eif_rout_obj.h%""
1372 end
1373
1374 eif_put_character_8_item (obj: POINTER; pos: INTEGER; v: CHARACTER_8) is
1375 -- Set character_8 item at position `pos' in tuple `obj' with `v'.
1376 external
1377 "C macro use %"eif_rout_obj.h%""
1378 end
1379
1380 eif_put_character_32_item (obj: POINTER; pos: INTEGER; v: CHARACTER_32) is
1381 -- Set character_32 item at position `pos' in tuple `obj' with `v'.
1382 external
1383 "C macro use %"eif_rout_obj.h%""
1384 end
1385
1386 eif_put_real_64_item (obj: POINTER; pos: INTEGER; v: DOUBLE) is
1387 -- Set double item at position `pos' in tuple `obj' with `v'.
1388 external
1389 "C macro use %"eif_rout_obj.h%""
1390 end
1391
1392 eif_put_real_32_item (obj: POINTER; pos: INTEGER; v: REAL) is
1393 -- Set real item at position `pos' in tuple `obj' with `v'.
1394 external
1395 "C macro use %"eif_rout_obj.h%""
1396 end
1397
1398 eif_put_pointer_item (obj: POINTER; pos: INTEGER; v: POINTER) is
1399 -- Set pointer item at position `pos' in tuple `obj' with `v'.
1400 external
1401 "C macro use %"eif_rout_obj.h%""
1402 end
1403
1404 eif_put_natural_8_item (obj: POINTER; pos: INTEGER; v: NATURAL_8) is
1405 -- Set NATURAL_8 item at position `pos' in tuple `obj' with `v'.
1406 external
1407 "C macro use %"eif_rout_obj.h%""
1408 end
1409
1410 eif_put_natural_16_item (obj: POINTER; pos: INTEGER; v: NATURAL_16) is
1411 -- Set NATURAL_16 item at position `pos' in tuple `obj' with `v'.
1412 external
1413 "C macro use %"eif_rout_obj.h%""
1414 end
1415
1416 eif_put_natural_32_item (obj: POINTER; pos: INTEGER; v: NATURAL_32) is
1417 -- Set NATURAL_32 item at position `pos' in tuple `obj' with `v'.
1418 external
1419 "C macro use %"eif_rout_obj.h%""
1420 end
1421
1422 eif_put_natural_64_item (obj: POINTER; pos: INTEGER; v: NATURAL_64) is
1423 -- Set NATURAL_64 item at position `pos' in tuple `obj' with `v'.
1424 external
1425 "C macro use %"eif_rout_obj.h%""
1426 end
1427
1428 eif_put_integer_8_item (obj: POINTER; pos: INTEGER; v: INTEGER_8) is
1429 -- Set integer_8 item at position `pos' in tuple `obj' with `v'.
1430 external
1431 "C macro use %"eif_rout_obj.h%""
1432 end
1433
1434 eif_put_integer_16_item (obj: POINTER; pos: INTEGER; v: INTEGER_16) is
1435 -- Set integer_16 item at position `pos' in tuple `obj' with `v'.
1436 external
1437 "C macro use %"eif_rout_obj.h%""
1438 end
1439
1440 eif_put_integer_32_item (obj: POINTER; pos: INTEGER; v: INTEGER) is
1441 -- Set integer_32 item at position `pos' in tuple `obj' with `v'.
1442 external
1443 "C macro use %"eif_rout_obj.h%""
1444 end
1445
1446 eif_put_integer_64_item (obj: POINTER; pos: INTEGER; v: INTEGER_64) is
1447 -- Set integer_64 item at position `pos' in tuple `obj' with `v'.
1448 external
1449 "C macro use %"eif_rout_obj.h%""
1450 end
1451
1452 end

Properties

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

  ViewVC Help
Powered by ViewVC 1.1.23