/[eiffelstudio]/branches/eth/eve/Src/Eiffel/API/evaluated_type/cl_type_a.e
ViewVC logotype

Contents of /branches/eth/eve/Src/Eiffel/API/evaluated_type/cl_type_a.e

Parent Directory Parent Directory | Revision Log Revision Log


Revision 92723 - (show annotations)
Fri Jun 21 07:47:04 2013 UTC (6 years, 7 months ago) by jasonw
File size: 32197 byte(s)
<<Merged from trunk#92722.>>
1 note
2 description: "Description of an actual class type."
3 legal: "See notice at end of class."
4 status: "See notice at end of class."
5 date: "$Date$"
6 revision: "$Revision$"
7
8 class CL_TYPE_A
9
10 inherit
11 DEANCHORED_TYPE_A
12 redefine
13 is_expanded, is_reference, valid_generic, is_ephemeral,
14 duplicate, meta_type, same_as, good_generics, error_generics,
15 has_expanded, internal_is_valid_for_class, convert_to,
16 description, description_with_detachable_type,
17 is_full_named_type, is_external, is_enum, is_conformant_to,
18 hash_code, sk_value, is_optimized_as_frozen, generated_id,
19 generate_cecil_value, element_type, adapted_in,
20 il_type_name, generate_gen_type_il, is_generated_as_single_type,
21 generic_derivation, associated_class_type, has_associated_class_type,
22 internal_same_generic_derivation_as, internal_generic_derivation,
23 has_associated_class, is_class_valid, instantiated_in, deep_actual_type,
24 is_processor_attachable_to
25 end
26
27 SHARED_IL_CASING
28 export
29 {NONE} all
30 end
31
32 DEBUG_OUTPUT
33
34 create
35 make
36
37 feature {NONE} -- Initialization
38
39 make (a_class_id: INTEGER)
40 require
41 valid_class_id: a_class_id > 0
42 local
43 l_class: like base_class
44 do
45 class_id := a_class_id
46 l_class := system.class_of_id (a_class_id)
47 if l_class /= Void and then l_class.is_expanded then
48 set_expanded_class_mark
49 end
50 ensure
51 class_id_set: class_id = a_class_id
52 end
53
54 feature -- Visitor
55
56 process (v: TYPE_A_VISITOR)
57 -- Process current element.
58 do
59 v.process_cl_type_a (Current)
60 end
61
62 feature -- Properties
63
64 has_no_mark: BOOLEAN
65 -- Has class type no explicit mark?
66 do
67 Result := declaration_mark = no_mark
68 ensure
69 definition: Result = (declaration_mark = no_mark)
70 end
71
72 has_expanded_mark: BOOLEAN
73 -- Is class type explicitly marked as expanded?
74 do
75 Result := declaration_mark = expanded_mark
76 ensure
77 definition: Result = (declaration_mark = expanded_mark)
78 end
79
80 has_reference_mark: BOOLEAN
81 -- Is class type explicitly marked as reference?
82 do
83 Result := declaration_mark = reference_mark
84 ensure
85 definition: Result = (declaration_mark = reference_mark)
86 end
87
88 has_actual (a_type: TYPE_A): BOOLEAN
89 -- Is `a_type' an actual parameter of Current?
90 require
91 a_type_not_void: a_type /= Void
92 do
93 -- Ideally should be in GEN_TYPE_I
94 end
95
96 has_associated_class, is_class_valid: BOOLEAN
97 do
98 Result := base_class /= Void
99 end
100
101 has_associated_class_type (a_context_type: TYPE_A): BOOLEAN
102 do
103 if base_class /= Void then
104 Result := base_class.types.has_type (a_context_type, Current)
105 end
106 end
107
108 is_expanded: BOOLEAN
109 -- Is the type expanded?
110 do
111 Result := has_expanded_mark or else (has_no_mark and then base_class.is_expanded)
112 end
113
114 is_ephemeral: BOOLEAN
115 -- <Precursor>
116 do
117 Result := base_class.is_ephemeral
118 end
119
120 is_reference: BOOLEAN
121 -- Is the type a reference type?
122 do
123 Result := has_reference_mark or else (has_no_mark and then not base_class.is_expanded)
124 end
125
126 is_full_named_type: BOOLEAN
127 -- Current is a full named type.
128 do
129 Result := True
130 end
131
132 is_external: BOOLEAN
133 -- Is current type based on an external calss?
134 local
135 l_base_class: like base_class
136 do
137 l_base_class := base_class
138 Result := is_basic or (not l_base_class.is_basic and l_base_class.is_external)
139 end
140
141 is_enum: BOOLEAN
142 -- Is the current actual type an external enum one?
143 local
144 l_base_class: like base_class
145 do
146 l_base_class := base_class
147 Result := is_expanded and l_base_class.is_external and l_base_class.is_enum
148 end
149
150 is_system_object_or_any: BOOLEAN
151 -- Does current type represent SYSTEM_OBJECT or ANY?
152 require
153 il_generation: System.il_generation
154 local
155 l_class_id: like class_id
156 l_system: like system
157 do
158 l_class_id := class_id
159 l_system := system
160 Result := l_class_id = l_system.system_object_class.compiled_class.class_id or
161 l_class_id = l_system.any_class.compiled_class.class_id
162 end
163
164 feature -- Comparison
165
166 is_equivalent (other: like Current): BOOLEAN
167 -- Is `other' equivalent to the current object ?
168 do
169 Result := declaration_mark = other.declaration_mark and then
170 class_declaration_mark = other.class_declaration_mark and then
171 is_attached = other.is_attached and then
172 class_id = other.class_id
173 end
174
175 same_as (other: TYPE_A): BOOLEAN
176 -- Is the current type the same as `other' ?
177 local
178 other_class_type: CL_TYPE_A
179 do
180 other_class_type ?= other
181 Result := other_class_type /= Void and then class_id = other_class_type.class_id
182 and then is_expanded = other_class_type.is_expanded
183 and then has_same_marks (other_class_type)
184 end
185
186 is_processor_attachable_to (other: TYPE_A): BOOLEAN
187 -- <Precursor>
188 do
189 if Precursor (other) then
190 -- If `other' is not separate, the checks done by `Precursor' are sufficient.
191 Result := True
192 if other.is_separate and then is_expanded and then attached base_class.skeleton as s then
193 -- `other' is separate and current type is expanded,
194 -- all attributes of the current type must be runnable in the context of `other' processor.
195 across
196 s as t
197 until
198 not Result
199 loop
200 Result := t.item.type_i.instantiation_in (Current, class_id).is_runnable_on_processor (other)
201 end
202 end
203 end
204 end
205
206 feature -- Access
207
208 hash_code: INTEGER
209 -- Hash code value.
210 do
211 Result := class_id
212 end
213
214 class_id: INTEGER
215 -- Class id of the associated class
216
217 base_class: CLASS_C
218 -- Associated class to the type
219 do
220 Result := System.class_of_id (class_id)
221 end
222
223 associated_class_type (context_type: TYPE_A): CLASS_TYPE
224 do
225 Result := base_class.types.search_item (context_type, Current)
226 end
227
228 deep_actual_type: like Current
229 -- <Precursor>
230 --| Redefined for getting a more precise type.
231 do
232 Result := Current
233 end
234
235 sk_value (a_context_type: TYPE_A): NATURAL_32
236 do
237 if is_expanded then
238 Result := {SK_CONST}.sk_exp | (type_id (a_context_type) - 1).to_natural_32
239 else
240 Result := {SK_CONST}.sk_ref | (type_id (a_context_type) - 1).to_natural_32
241 end
242 end
243
244 description: ATTR_DESC
245 local
246 exp: EXPANDED_DESC
247 do
248 if is_expanded then
249 create exp
250 exp.set_type_i (Current)
251 Result := exp
252 else
253 Result := Precursor
254 end
255 end
256
257 description_with_detachable_type: ATTR_DESC
258 local
259 exp: EXPANDED_DESC
260 do
261 if is_expanded then
262 create exp
263 exp.set_type_i (as_detachable_type)
264 Result := exp
265 else
266 Result := Precursor
267 end
268 end
269
270 generic_derivation: like Current
271 -- Precise generic derivation of current type.
272 -- That is to say given a type, it gives the associated TYPE_A
273 -- which can be used to search its associated CLASS_TYPE.
274 do
275 Result := internal_generic_derivation (0)
276 end
277
278 instantiated_in (class_type: TYPE_A): CL_TYPE_A
279 -- <Precursor>
280 --| Redefined for refining the return type.
281 do
282 Result := Current
283 end
284
285 meta_type: TYPE_A
286 -- Meta type of the type
287 do
288 Result := system.any_type
289 end
290
291 good_generics: BOOLEAN
292 -- Has the base class exactly the same number of generic
293 -- parameters in its formal generic declarations ?
294 do
295 Result := base_class.generics = Void
296 end
297
298 error_generics: VTUG
299 do
300 -- We could avoid having this check but the precondition does not tell us
301 -- we can.
302 if base_class /= Void then
303 create {VTUG2} Result
304 Result.set_type (Current)
305 Result.set_base_class (base_class)
306 end
307 end
308
309 has_expanded: BOOLEAN
310 -- Has the current type some expanded types in its declration ?
311 do
312 Result := is_expanded
313 end
314
315 feature -- Output
316
317 ext_append_to (a_text_formatter: TEXT_FORMATTER; a_context_class: CLASS_C)
318 -- <Precursor>
319 do
320 ext_append_marks (a_text_formatter)
321 if has_expanded_mark then
322 a_text_formatter.process_keyword_text ({SHARED_TEXT_ITEMS}.ti_expanded_keyword, Void)
323 a_text_formatter.add_space
324 elseif has_reference_mark then
325 a_text_formatter.process_keyword_text ({SHARED_TEXT_ITEMS}.ti_reference_keyword, Void)
326 a_text_formatter.add_space
327 end
328 base_class.append_name (a_text_formatter)
329 end
330
331 dump: STRING
332 -- Dumped trace
333 local
334 class_name: STRING
335 n: INTEGER
336 do
337 class_name := base_class.name_in_upper
338 n := class_name.count
339 if has_attached_mark or else has_detachable_mark then
340 n := n + 2
341 end
342 if not has_no_mark then
343 n := n + 10
344 end
345 create Result.make (n)
346 dump_marks (Result)
347 if has_expanded_mark then
348 Result.append ({SHARED_TEXT_ITEMS}.ti_expanded_keyword)
349 Result.append_character (' ')
350 elseif has_reference_mark then
351 Result.append ({SHARED_TEXT_ITEMS}.ti_reference_keyword)
352 Result.append_character (' ')
353 end
354 Result.append (class_name)
355 end
356
357 feature -- Generic conformance
358
359 generated_id (final_mode: BOOLEAN; a_context_type: TYPE_A): NATURAL_16
360 local
361 l_id: INTEGER
362 do
363 if final_mode then
364 l_id := type_id (a_context_type) - 1
365 else
366 l_id := static_type_id (a_context_type) - 1
367 end
368 Result := l_id.to_natural_16
369 end
370
371 generate_gen_type_il (il_generator: IL_CODE_GENERATOR; use_info: BOOLEAN)
372 -- `use_info' is true iff we generate code for a
373 -- creation instruction.
374 do
375 il_generator.generate_class_type_instance (Current)
376 end
377
378 feature -- IL code generation
379
380 implemented_type (implemented_in: INTEGER_32): CL_TYPE_A
381 -- Parent type that corresponds to the current one.
382 require
383 valid_implemented_in: implemented_in > 0
384 do
385 if class_id = implemented_in then
386 Result := Current
387 else
388 Result := find_class_type (system.class_of_id (implemented_in))
389 end
390 end
391
392 element_type: INTEGER_8
393 -- Void element type
394 do
395 if is_expanded then
396 Result := {MD_SIGNATURE_CONSTANTS}.Element_type_valuetype
397 else
398 if class_id = System.system_string_class.compiled_class.class_id then
399 Result := {MD_SIGNATURE_CONSTANTS}.Element_type_string
400 elseif class_id = System.system_object_id or class_id = system.any_id then
401 -- For ANY or SYSTEM_OBJECT, we always generate a System.Object
402 -- signature since we can now assign SYSTEM_OBJECTs into ANYs.
403 Result := {MD_SIGNATURE_CONSTANTS}.Element_type_object
404 else
405 Result := {MD_SIGNATURE_CONSTANTS}.Element_type_class
406 end
407 end
408 end
409
410 il_type_name (a_prefix: STRING; a_context_type: TYPE_A): STRING
411 -- Class name of current type.
412 local
413 l_class_c: like base_class
414 l_cl_type: like associated_class_type
415 l_alias_name: STRING
416 l_dot_pos: INTEGER
417 do
418 l_class_c := base_class
419 if l_class_c.is_external and not l_class_c.is_basic then
420 Result := l_class_c.external_class_name.twin
421 else
422 if l_class_c.is_precompiled then
423 -- Reuse the name that was computed at precompilation time.
424 l_cl_type := associated_class_type (a_context_type)
425 if l_cl_type.is_precompiled then
426 Result := l_cl_type.il_type_name (a_prefix)
427 end
428 end
429 if Result = Void then
430 if not has_no_mark or else is_basic or else l_class_c.external_class_name.is_equal (l_class_c.name) then
431 Result := internal_il_type_name (l_class_c.name.twin, a_prefix)
432 else
433 -- Special case when an external name has been specified.
434 Result := l_class_c.external_class_name.twin
435 Result.left_adjust
436 Result.right_adjust
437 -- Remove leading `.' since it is not a valid .NET name.
438 from
439 until
440 Result.is_empty or else Result.item (1) /= '.'
441 loop
442 Result.remove_head (1)
443 end
444 -- Remove trailing `.' since it is not a valid .NET name.
445 from
446 until
447 Result.is_empty or else Result.item (Result.count) /= '.'
448 loop
449 Result.remove_tail (1)
450 end
451 if Result.is_empty then
452 -- External name is invalid since empty, we use the normal
453 -- way of generating the .Net name
454 Result := internal_il_type_name (l_class_c.name.twin, a_prefix)
455 else
456 if a_prefix /= Void then
457 l_dot_pos := Result.last_index_of ('.', Result.count)
458 if l_dot_pos = 0 then
459 Result.prepend_character ('.')
460 Result.prepend (a_prefix)
461 else
462 check
463 -- Because there are no more leading or trailing `.'.
464 valid_l_dot_pos: l_dot_pos > 1 and l_dot_pos < Result.count
465 end
466 l_alias_name := Result.substring (l_dot_pos + 1, Result.count)
467 check
468 l_alias_name_not_empty: not l_alias_name.is_empty
469 end
470 Result.keep_head (l_dot_pos)
471 l_alias_name := internal_il_base_type_name (l_alias_name)
472 Result.append (a_prefix)
473 Result.append_character ('.')
474 Result.append (l_alias_name)
475 end
476 end
477 end
478 end
479 end
480 end
481 end
482
483 is_optimized_as_frozen: BOOLEAN
484 do
485 Result := base_class.is_optimized_as_frozen
486 end
487
488 is_generated_as_single_type: BOOLEAN
489 -- Is associated type generated as a single type or as an interface type and
490 -- an implementation type.
491 do
492 -- External classes have only one type.
493 -- Classes that inherits from external classes
494 -- have only one generated type as well as expanded types.
495 Result := is_true_external or base_class.is_single or is_expanded
496 end
497
498 feature {NONE} -- IL code generation
499
500 frozen internal_il_type_name (a_base_name, a_prefix: STRING): STRING
501 -- Full type name of `a_base_name' using `a_prefix' in IL code generation
502 -- with namespace specification
503 require
504 a_base_name_not_void: a_base_name /= Void
505 a_base_name_not_empty: not a_base_name.is_empty
506 do
507 Result := internal_il_base_type_name (a_base_name)
508 -- Result needs to be in lower case because that's
509 -- what our casing conversion routines require to perform
510 -- a good job.
511 Result.to_lower
512 Result := il_casing.type_name (base_class.original_class.actual_namespace, a_prefix, is_separate, Result, System.dotnet_naming_convention)
513 ensure
514 internal_il_type_name_not_void: Result /= Void
515 internal_il_type_name_not_empty: not Result.is_empty
516 end
517
518 frozen internal_il_base_type_name (a_base_name: STRING): STRING
519 -- Given `a_base_name' provides its updated name depending on its usage.
520 require
521 a_base_name_not_void: a_base_name /= Void
522 a_base_name_not_empty: not a_base_name.is_empty
523 local
524 l_base_class: like base_class
525 do
526 l_base_class := base_class
527 if is_expanded and then not l_base_class.is_expanded then
528 create Result.make (6 + a_base_name.count)
529 Result.append ("value_")
530 elseif not is_expanded and then l_base_class.is_expanded then
531 create Result.make (10 + a_base_name.count)
532 Result.append ("reference_")
533 else
534 create Result.make (a_base_name.count)
535 end
536 Result.append (a_base_name)
537 ensure
538 internal_il_base_type_name_not_void: Result /= Void
539 internal_il_base_type_name_not_empty: not Result.is_empty
540 end
541
542 feature -- C code generation
543
544 generate_cecil_value (buffer: GENERATION_BUFFER; a_context_type: TYPE_A)
545 -- Generate type value for cecil.
546 do
547 if not is_expanded then
548 buffer.put_string ({SK_CONST}.sk_ref_string)
549 else
550 buffer.put_string ({SK_CONST}.sk_exp_string)
551 end
552 buffer.put_three_character (' ', '+', ' ')
553 buffer.put_type_id (type_id (a_context_type))
554 end
555
556 feature {TYPE_A} -- Helpers
557
558 internal_conform_to (a_context_class: CLASS_C; other: TYPE_A; a_in_generic: BOOLEAN): BOOLEAN
559 -- <Precursor>
560 local
561 other_class_type: CL_TYPE_A
562 do
563 other_class_type ?= other.conformance_type
564 if other_class_type /= Void then
565 if other_class_type.is_expanded then
566 -- It should be the exact same base class for expanded.
567 if is_expanded and then class_id = other_class_type.class_id then
568 Result := other_class_type.valid_generic (a_context_class, Current, a_in_generic)
569 if Result and then is_typed_pointer then
570 -- TYPED_POINTER should be exactly the same type.
571 Result := valid_generic (a_context_class, other_class_type, a_in_generic)
572 end
573 end
574 else
575 if a_in_generic then
576 if other.is_frozen then
577 Result := is_frozen and then base_class = other_class_type.base_class
578 elseif not other.is_variant then
579 Result := not is_variant and then base_class = other_class_type.base_class
580 else
581 check is_variant: other.is_variant end
582 Result := base_class.conform_to (other_class_type.base_class)
583 end
584 else
585 if other.is_frozen then
586 Result := is_frozen and then base_class = other_class_type.base_class
587 else
588 Result := base_class.conform_to (other_class_type.base_class)
589 end
590 end
591 Result := Result and then other_class_type.valid_generic (a_context_class, Current, a_in_generic)
592 if not Result and then system.il_generation and then system.system_object_class /= Void then
593 -- Any type in .NET conforms to System.Object
594 check
595 system.system_object_class.is_compiled
596 end
597 Result := other_class_type.class_id = system.system_object_id
598 end
599 if Result and then a_context_class.lace_class.is_void_safe_conformance then
600 -- We should still verify that the attachment marks are taken into account.
601 Result := is_attachable_to (other_class_type)
602 end
603 if Result then
604 Result := is_processor_attachable_to (other)
605 end
606 end
607 end
608 end
609
610 valid_generic (a_context_class: CLASS_C; type: CL_TYPE_A; a_in_generic: BOOLEAN): BOOLEAN
611 -- Do the generic parameter of `type' conform to those
612 -- of Current (none).
613 do
614 Result := True
615 end
616
617 internal_is_valid_for_class (a_class: CLASS_C): BOOLEAN
618 -- Is Current still valid?
619 -- I.e. its `associated_class' is still in system.
620 local
621 l_class: like base_class
622 do
623 l_class := base_class
624 -- Check that current class still exists and that there are no
625 -- generics.
626 --| Ideally we could also check that if Current base class is expanded
627 --| then it has the class_declaration_mark properly set, but it does not
628 --| currently work when processing TYPED_POINTER which is currently interpreted
629 Result := l_class /= Void and then l_class.is_valid and then l_class.generics = Void and then
630 (l_class.is_expanded = (class_declaration_mark = expanded_mark))
631 end
632
633 internal_generic_derivation (a_level: INTEGER): CL_TYPE_A
634 local
635 l_attachment: like attachment_bits
636 l_variant_bits: like variant_bits
637 s: like has_separate_mark
638 do
639 if attachment_bits = 0 and variant_bits = 0 and not has_separate_mark then
640 Result := Current
641 else
642 -- Clear the attachment and separate mark.
643 l_attachment := attachment_bits
644 l_variant_bits := variant_bits
645 attachment_bits := 0
646 variant_bits := 0
647 s := has_separate_mark
648 has_separate_mark := False
649 Result := twin
650 has_separate_mark := s
651 attachment_bits := l_attachment
652 variant_bits := l_variant_bits
653 end
654 end
655
656 internal_same_generic_derivation_as (current_type, other: TYPE_A; a_level: INTEGER): BOOLEAN
657 do
658 Result := same_type (other) and then attached {like Current} other as l_cl_type and then
659 l_cl_type.class_id = class_id and then
660 -- 'class_id' is the same therefore we can compare 'declaration_mark'.
661 -- If 'declaration_mark' is not the same for both then we have to make sure
662 -- that both expanded and separate states are identical.
663 (l_cl_type.declaration_mark /= declaration_mark implies
664 (l_cl_type.is_expanded = is_expanded))
665 end
666
667 feature {COMPILER_EXPORTER} -- Settings
668
669 set_expanded_class_mark
670 -- Mark class declaration as expanded.
671 do
672 class_declaration_mark := expanded_mark
673 ensure
674 has_expanded_class_mark: class_declaration_mark = expanded_mark
675 end
676
677 set_expanded_mark
678 -- Set class type declaration as expanded.
679 do
680 declaration_mark := expanded_mark
681 ensure
682 has_expanded_mark: has_expanded_mark
683 end
684
685 set_reference_mark
686 -- Set class type declaration as reference.
687 do
688 declaration_mark := reference_mark
689 ensure
690 has_reference_mark: has_reference_mark
691 end
692
693 feature {COMPILER_EXPORTER} -- Conformance
694
695 convert_to (a_context_class: CLASS_C; a_target_type: TYPE_A): BOOLEAN
696 -- Does current convert to `a_target_type' in `a_context_class'?
697 -- Update `last_conversion_info' of AST_CONTEXT.
698 local
699 l_checker: CONVERTIBILITY_CHECKER
700 do
701 create l_checker
702 l_checker.check_conversion (a_context_class, Current, a_target_type)
703 Result := l_checker.last_conversion_check_successful
704 if Result then
705 context.set_last_conversion_info (l_checker.last_conversion_info)
706 else
707 context.set_last_conversion_info (Void)
708 end
709 end
710
711 is_conformant_to (a_context_class: CLASS_C; other: TYPE_A): BOOLEAN
712 -- Does Current conform to other?
713 -- Most of the time, it is equivalent to `conform_to' except
714 -- when current is an expanded type.
715 local
716 l_is_exp, l_other_is_exp: BOOLEAN
717 l_other_class_type: CL_TYPE_A
718 current_mark: like declaration_mark
719 other_mark: like declaration_mark
720 do
721 Result := Current = other
722 if not Result then
723 l_other_class_type ?= other.actual_type
724 if l_other_class_type /= Void then
725 -- We perform conformance as if the two types were not
726 -- expanded. So, if they are expanded, we remove their
727 -- expanded flag to do the conformance check.
728 l_is_exp := is_expanded
729 l_other_is_exp := l_other_class_type.is_expanded
730 if l_is_exp then
731 current_mark := declaration_mark
732 set_reference_mark
733 end
734 if l_other_is_exp then
735 other_mark := l_other_class_type.declaration_mark
736 l_other_class_type.set_reference_mark
737 end
738
739 Result := conform_to (a_context_class, other)
740
741 if l_is_exp then
742 set_mark (current_mark)
743 end
744 if l_other_is_exp then
745 l_other_class_type.set_mark (other_mark)
746 end
747 end
748 end
749 end
750
751 generic_conform_to (a_context_class: CLASS_C; gen_type: GEN_TYPE_A; a_in_generic: BOOLEAN): BOOLEAN
752 -- Does Current conform to `gen_type' ?
753 require
754 a_context_class_not_void: a_context_class /= Void
755 a_context_class_valid: a_context_class.is_valid
756 a_context_valid_for_current: is_valid_for_class (a_context_class)
757 good_argument: gen_type /= Void
758 valid_type: base_class.conform_to (gen_type.base_class)
759 local
760 i, count: INTEGER
761 parent_actual_type: TYPE_A
762 l_conforming_parents: FIXED_LIST [CL_TYPE_A]
763 l_is_attached: like is_attached
764 l_is_implicitly_attached: like is_implicitly_attached
765 do
766 from
767 l_is_attached := is_attached
768 l_is_implicitly_attached := is_implicitly_attached
769 l_conforming_parents := base_class.conforming_parents
770 i := 1
771 count := l_conforming_parents.count
772 until
773 i > count or else Result
774 loop
775 parent_actual_type := parent_type (l_conforming_parents.i_th (i))
776 if l_is_attached and then not parent_actual_type.is_attached then
777 parent_actual_type := parent_actual_type.as_attached_type
778 elseif l_is_implicitly_attached and then not parent_actual_type.is_implicitly_attached then
779 parent_actual_type := parent_actual_type.as_implicitly_attached
780 end
781 Result := parent_actual_type.internal_conform_to (a_context_class, gen_type, a_in_generic)
782 i := i + 1
783 end
784 end
785
786 parent_type (parent: CL_TYPE_A): TYPE_A
787 -- Parent actual type.
788 require
789 parent_not_void: parent /= Void
790 do
791 Result := parent
792 ensure
793 result_not_void: Result /= Void
794 end
795
796 feature {COMPILER_EXPORTER} -- Instantitation of a feature type
797
798 adapted_in (class_type: CLASS_TYPE): CL_TYPE_A
799 -- Redefined for covariant redefinition of result type.
800 do
801 Result := Current
802 end
803
804 feature {COMPILER_EXPORTER} -- Instantiation of a type in the context of a descendant one
805
806 instantiation_of (type: TYPE_A; a_class_id: INTEGER): TYPE_A
807 -- Instantiation of type `type' written in class of id `a_class_id'
808 -- in the context of Current
809 local
810 instantiation: TYPE_A
811 gen_type: GEN_TYPE_A
812 do
813 if a_class_id = class_id then
814 -- Feature is written in the class associated to the
815 -- current actual class type
816 instantiation := Current
817 else
818 instantiation := find_class_type (System.class_of_id (a_class_id))
819 end
820 Result := type.actual_type
821 if instantiation.generics /= Void and instantiation.generics.count > 0 then
822 -- Does not make sense to instantiate if `instantation' is
823 -- a TUPLE with no arguments.
824 gen_type ?= instantiation
825 Result := gen_type.instantiate (Result)
826 end
827 end
828
829 find_descendant_type (c: CLASS_C): CL_TYPE_A
830 -- Find the type of Current would have in descendant `c'. If no such type
831 -- can be found, return Void (this happens when `c' introduces a new formal
832 -- generic parameter that does not exist in `Current').
833 require
834 good_argument: c /= Void
835 conformance: c.inherits_from (base_class)
836 local
837 l_class: like base_class
838 i, nb, l_pos: INTEGER
839 l_type_feat: TYPE_FEATURE_I
840 l_result_generics: like generics
841 l_generic_features: HASH_TABLE [TYPE_FEATURE_I, INTEGER]
842 l_quick_positions: NATURAL_64
843 l_slow_positions: PACKED_BOOLEANS
844 do
845 l_class := base_class
846 if l_class = c then
847 -- Same class, nothing to do.
848 Result := Current
849 else
850 Result := c.actual_type
851 l_result_generics := Result.generics
852 if l_result_generics /= Void then
853 nb := l_result_generics.count
854 -- To verify that all the positions have been processed we use a bit flag if there is less
855 -- than 64 formal generics, otherwise we use a PACKED_BOOLEAN structure.
856 if nb >= 64 then
857 create l_slow_positions.make (nb + 1)
858 end
859 if not attached generics as l_parent_generics then
860 -- Descendant is generic but not parent, clearly we have to exclude it.
861 Result := Void
862 else
863 from
864 -- We reset `l_result_generics' to Void since we are using Void as a signaling
865 -- value to duplicate `Result.generics' in case we perform a substitution.
866 l_result_generics := Void
867 l_generic_features := c.generic_features
868 l_generic_features.start
869 until
870 l_generic_features.after
871 loop
872 l_type_feat := l_generic_features.item_for_iteration
873 -- When we encounter a formal generic parameter in the descendant,
874 -- we search for it in the ancestor, if none is found, we continue,
875 -- otherwise we replace the descendant formal generic with the parent one.
876 if attached {FORMAL_A} l_type_feat.type as l_formal then
877 if
878 attached l_class.generic_features.item (l_generic_features.key_for_iteration) as l_feat and then
879 attached {FORMAL_A} l_feat.type as l_parent_formal
880 then
881 -- We cannot override `Result' because it is coming from {CLASS_C}.actual_type
882 -- and this is an attribute that is set only once.
883 if l_result_generics = Void then
884 Result := Result.duplicate_for_instantiation
885 l_result_generics := Result.generics
886 end
887 l_pos := l_formal.position
888 l_result_generics.put_i_th (l_parent_generics.i_th (l_parent_formal.position), l_pos)
889 -- Mark that we have done `l_pos'.
890 if nb < 64 then
891 l_quick_positions := l_quick_positions | ({NATURAL_64} 1 |<< l_pos)
892 else
893 l_slow_positions.put (True, l_pos)
894 end
895 end
896 end
897 l_generic_features.forth
898 end
899 -- Check now that all the bits are set.
900 if nb < 64 then
901 if (l_quick_positions |>> 1) /= ({NATURAL_64} 1 |<< nb) - {NATURAL_64} 1 then
902 -- Some formal generics of `Result' were not found in Current, we have to exclude it.
903 Result := Void
904 end
905 else
906 from
907 i := 1
908 nb := l_slow_positions.count
909 until
910 i > nb
911 loop
912 if not l_slow_positions.item (i) then
913 Result := Void
914 i := nb
915 end
916 i := i + 1
917 end
918 end
919 end
920 end
921 end
922 ensure
923 -- Ideally this should be that way, but often we manipulate formals and when you have
924 -- the ancestor A [G#1] and a descendant A2 (which inherits from A [DOUBLE]) the conformance
925 -- query would fail because nothing can conform to a formal apart itself.
926 conform_to: -- Result /= Void implies Result.conform_to (Current)
927 end
928
929 find_class_type (c: CLASS_C): CL_TYPE_A
930 -- Actual type of class of id `class_id' in current
931 -- context. If `c' does not inherit from `associated_class',
932 -- we simply return Void.
933 require
934 good_argument: c /= Void
935 local
936 parents: FIXED_LIST [CL_TYPE_A]
937 parent: CL_TYPE_A
938 i, count: INTEGER
939 parent_class_type: CL_TYPE_A
940 do
941 from
942 parents := base_class.parents
943 i := 1
944 count := parents.count
945 until
946 i > count or else Result /= Void
947 loop
948 parent := parents [i]
949 if parent.base_class = c then
950 -- Class `c' is found
951 Result ?= parent_type (parent)
952 else
953 parent_class_type ?= parent_type (parent)
954 Result := parent_class_type.find_class_type (c)
955 end
956 i := i + 1
957 end
958 end
959
960 duplicate: like Current
961 -- Duplication
962 do
963 Result := twin
964 end
965
966 duplicate_for_instantiation: like Current
967 -- Duplication for instantiation routines.
968 do
969 Result := twin
970 end
971
972 reference_type: CL_TYPE_A
973 -- Reference counterpart of an expanded type
974 do
975 Result := duplicate
976 Result.set_reference_mark
977 end
978
979 create_info: CREATE_TYPE
980 -- Byte code information for entity type creation
981 do
982 create Result.make (as_attachment_mark_free)
983 end
984
985 feature -- Debugging
986
987 debug_output: STRING
988 -- Display name of associated class.
989 do
990 if is_class_valid then
991 Result := dump
992 else
993 Result := "Class not in system anymore"
994 end
995 end
996
997 feature {CL_TYPE_A, TUPLE_CLASS_B, CIL_CODE_GENERATOR} --Class type declaration marks
998
999 declaration_mark: NATURAL_8
1000 -- Declaration mark associated with a class type (if any)
1001
1002 class_declaration_mark: NATURAL_8
1003 -- Declaration mark associated with class. Meaning that when this instance was
1004 -- created the base class had the same mark (currently only works for expanded).
1005 -- If Current has still the mark and not the base class, it simply means that
1006 -- Current is not valid.
1007
1008 set_mark (mark: like declaration_mark)
1009 -- Set `declaration_mark' to the given value `mark'.
1010 require
1011 valid_declaration_mark:
1012 mark = no_mark or mark = expanded_mark or
1013 mark = reference_mark
1014 do
1015 declaration_mark := mark
1016 ensure
1017 declaration_mark_set: declaration_mark = mark
1018 end
1019
1020 no_mark: NATURAL_8 = 0
1021 -- Empty declaration mark
1022
1023 expanded_mark: NATURAL_8 = 1
1024 -- Expanded declaration mark
1025
1026 reference_mark: NATURAL_8 = 2
1027 -- Reference declaration mark
1028
1029 invariant
1030 class_id_positive: class_id > 0
1031 valid_declaration_mark:
1032 declaration_mark = no_mark or declaration_mark = expanded_mark or
1033 declaration_mark = reference_mark
1034 valid_class_declaration_mark:
1035 class_declaration_mark = no_mark or class_declaration_mark = expanded_mark
1036
1037 note
1038 copyright: "Copyright (c) 1984-2013, Eiffel Software"
1039 license: "GPL version 2 (see http://www.eiffel.com/licensing/gpl.txt)"
1040 licensing_options: "http://www.eiffel.com/licensing"
1041 copying: "[
1042 This file is part of Eiffel Software's Eiffel Development Environment.
1043
1044 Eiffel Software's Eiffel Development Environment is free
1045 software; you can redistribute it and/or modify it under
1046 the terms of the GNU General Public License as published
1047 by the Free Software Foundation, version 2 of the License
1048 (available at the URL listed under "license" above).
1049
1050 Eiffel Software's Eiffel Development Environment is
1051 distributed in the hope that it will be useful, but
1052 WITHOUT ANY WARRANTY; without even the implied warranty
1053 of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
1054 See the GNU General Public License for more details.
1055
1056 You should have received a copy of the GNU General Public
1057 License along with Eiffel Software's Eiffel Development
1058 Environment; if not, write to the Free Software Foundation,
1059 Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
1060 ]"
1061 source: "[
1062 Eiffel Software
1063 5949 Hollister Ave., Goleta, CA 93117 USA
1064 Telephone 805-685-1006, Fax 805-685-6869
1065 Website http://www.eiffel.com
1066 Customer support http://support.eiffel.com
1067 ]"
1068
1069 end

Properties

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

  ViewVC Help
Powered by ViewVC 1.1.23