/[eiffelstudio]/branches/CAT_mono/Src/Eiffel/eiffel/interface/class_c.e
ViewVC logotype

Contents of /branches/CAT_mono/Src/Eiffel/eiffel/interface/class_c.e

Parent Directory Parent Directory | Revision Log Revision Log


Revision 69650 - (show annotations)
Tue Jul 24 17:18:14 2007 UTC (12 years, 4 months ago) by juliant
File size: 112706 byte(s)
Added monomorph mark for class types, either "frozen" or "invariant".
First (simple) conformance check for monomorphic types.
1 indexing
2 description: "Representation of a compiled class."
3 legal: "See notice at end of class."
4 status: "See notice at end of class."
5 date: "$Date$"
6 revision: "$Revision$"
7
8 deferred class CLASS_C
9
10 inherit
11 SHARED_COUNTER
12
13 SHARED_AST_CONTEXT
14 rename
15 context as ast_context
16 end
17
18 SHARED_TYPES
19
20 SHARED_TYPEID_TABLE
21
22 SHARED_CODE_FILES
23
24 SHARED_BODY_ID
25
26 SHARED_EIFFEL_PARSER
27
28 HASHABLE
29
30 SK_CONST
31
32 COMPILER_EXPORTER
33
34 SHARED_GENERATION
35
36 COMPARABLE
37 undefine
38 is_equal
39 end
40
41 PROJECT_CONTEXT
42
43 SHARED_WORKBENCH
44
45 SHARED_DEGREES
46 export
47 {ANY} Degree_1
48 end
49
50 SHARED_EIFFEL_PROJECT
51
52 SHARED_SERVER
53 export
54 {ANY} all
55 end
56
57 SHARED_INSTANTIATOR
58
59 SHARED_INST_CONTEXT
60
61 SHARED_ERROR_HANDLER
62
63 SHARED_RESCUE_STATUS
64
65 SHARED_TEXT_ITEMS
66
67 IDABLE
68 rename
69 id as class_id,
70 set_id as set_class_id
71 end
72
73 SHARED_NAMES_HEAP
74 export
75 {NONE} all
76 end
77
78 DEBUG_OUTPUT
79 export
80 {NONE} all
81 end
82
83 SHARED_IL_CASING
84 export
85 {NONE} all
86 end
87
88 SHARED_TYPE_I
89 export
90 {NONE} all
91 end
92
93 SHARED_STATELESS_VISITOR
94 export
95 {NONE} all
96 end
97
98 CLASS_C_EXPORT
99
100 REFACTORING_HELPER
101 export
102 {NONE} all
103 end
104
105 feature {NONE} -- Initialization
106
107 make (l: CLASS_I) is
108 -- Creation of Current class
109 require
110 good_argument: l /= Void
111 do
112 initialize (l)
113 -- Creation of a conformance table
114 create conformance_table.make (0)
115 -- Creation of the syntactical supplier list
116 create syntactical_suppliers.make (5)
117 -- Creation of the syntactical client list
118 create syntactical_clients.make (10)
119 -- Filter list creation
120 create filters.make
121 -- Feature id counter creation
122 create feature_id_counter
123 -- Changed features list creation
124 create changed_features.make (20)
125 -- Propagator set creation
126 create propagators.make
127
128 internal_feature_table_file_id := -1
129 end
130
131 feature -- Access
132
133 is_eiffel_class_c: BOOLEAN is
134 -- Is `Current' an EIFFEL_CLASS_C?
135 do
136 end
137
138 is_external_class_c: BOOLEAN is
139 -- Is `Current' an EXTERNAL_CLASS_C?
140 do
141 end
142
143 is_valid_formal_position (a_formal_position: INTEGER): BOOLEAN
144 -- Is `a_formal_position' a valid formal position for this class?
145 --
146 -- `a_formal_position' is the position index which has to be checked.
147 require
148 is_generic: is_generic
149 do
150 Result := a_formal_position >= 1 and then a_formal_position <= generics.count
151 ensure
152 Result_set: Result = (a_formal_position >= 1 and then a_formal_position <= generics.count)
153 end
154
155 eiffel_class_c: EIFFEL_CLASS_C is
156 -- `Current' as `EIFFEL_CLASS_C'.
157 require
158 is_eiffel_class_c: is_eiffel_class_c
159 do
160 end
161
162 external_class_c: EXTERNAL_CLASS_C is
163 -- `Current' as `EXTERNAL_CLASS_C'.
164 require
165 is_external_class_c: is_external_class_c
166 do
167 end
168
169 syntactical_suppliers: ARRAYED_LIST [CLASS_C]
170 -- Syntactical suppliers of the class
171 --| Useful for time-stamp
172
173 syntactical_clients: ARRAYED_LIST [CLASS_C]
174 -- Syntactical clients of the class
175 --| Useful for class removal
176
177 changed2: BOOLEAN
178 -- Has the compiler to apply the second pass to this class
179 -- again, even if the class didn't textually changed
180 -- (i.e `changed' is set to False) ?
181
182 changed3: BOOLEAN is
183 -- Has the compiler to make a type check on the class ?
184 -- At beginning of the third pass, if the class is marked
185 -- `changed', the compiler produces byte code and type check
186 -- the features marked `melted' and type check the others
187 -- if the class is marked `changed3'.
188 do
189 Result := propagators.make_pass3 or need_type_check
190 end
191
192 changed3a : BOOLEAN
193 -- Type check?
194
195 need_type_check: BOOLEAN
196 -- Does current needs a complete type check?
197 -- If True, forces a complete type check in `pass3' on all features
198 -- written in current class.
199
200 changed4: BOOLEAN
201 -- Has the class a new class type, or changed its generics?
202
203 is_generic: BOOLEAN is
204 -- Is current class generic?
205 do
206 Result := generics /= Void
207 ensure
208 result_is_generic: Result implies (generics /= Void)
209 end
210
211 is_removable: BOOLEAN is
212 -- May current class be removed from system?
213 do
214 -- It should not be precompiled, nor already removed from system.
215 Result := not is_precompiled and is_eiffel_class_c
216 end
217
218 is_in_system: BOOLEAN
219 -- Is current class part of system (i.e. precompiled and used)?
220
221 is_modifiable: BOOLEAN is
222 -- Is current class not part of a precompiled library?
223 do
224 Result := not is_precompiled
225 end
226
227 is_debuggable: BOOLEAN is
228 -- Is the class able to be debugged?
229 -- (not if it doesn't have class types)
230 do
231 Result := has_types
232 end
233
234 has_expanded: BOOLEAN
235 -- Does the class use expanded ?
236
237 is_used_as_expanded: BOOLEAN
238 -- Is `Current' used as an expanded class ?
239
240 is_special: BOOLEAN is
241 -- Is class SPECIAL?
242 do
243 -- Do nothing
244 end
245
246 is_tuple: BOOLEAN is
247 -- Is class TUPLE?
248 do
249
250 end
251
252 is_typed_pointer: BOOLEAN is
253 -- Is class TYPED_POINTER?
254 do
255 end
256
257 is_native_array: BOOLEAN is
258 -- Is class a NATIVE_ARRAY class?
259 do
260 end
261
262 conformance_table: PACKED_BOOLEANS
263 -- Conformance table of the class: once a class has changed
264 -- it must be reprocessed and the conformance table of the
265 -- recursive descendants also.
266
267 filters: FILTER_LIST -- ## FIXME 2.3 Patch: redefinition of equal in
268 -- GEN_TYPE_I
269 -- Filters associated to the class: useful for recalculating
270 -- the type system: it is empty if the class is a non-generic
271 -- one.
272
273 feature_id_counter: COUNTER
274 -- Counter of feature ids
275
276 has_unique: BOOLEAN
277 -- Does class have unique feature(s)?
278
279 changed_features: SEARCH_TABLE [INTEGER]
280 -- Names of the changed features
281
282 propagators: PASS3_CONTROL
283 -- Set of class ids of the classes responsible for
284 -- a type check of the current class
285
286 creators: HASH_TABLE [EXPORT_I, STRING]
287 -- Creation procedure names
288
289 creation_feature: FEATURE_I
290 -- Creation feature for expanded types
291
292 melted_set: SEARCH_TABLE [MELTED_INFO]
293 -- Melting information list
294 -- [Processed by the third pass.]
295
296 skeleton: GENERIC_SKELETON
297 -- Attributes skeleton
298
299 changed: BOOLEAN is
300 -- Is the class syntactically changed ?
301 do
302 Result := original_class.changed
303 end
304
305 already_compiled: BOOLEAN is
306 -- Has the class already been compiled before the current
307 -- compilation ?
308 do
309 Result := Ast_server.has (class_id)
310 end
311
312 assembly_info: ASSEMBLY_INFO
313 -- Information about assembly in which current class is being generated
314
315 feature -- Access: Convertibility
316
317 convert_to: DS_HASH_TABLE [INTEGER, NAMED_TYPE_A]
318 -- Set of feature name IDs indexed by type to which they convert to.
319
320 convert_from: DS_HASH_TABLE [INTEGER, NAMED_TYPE_A]
321 -- Set of feature name IDs indexed by type to which they convert from.
322
323 feature -- Access: CLI implementation
324
325 class_interface: CLASS_INTERFACE
326 -- CLI corresponding interface of Current class.
327
328 feature -- Status report
329
330 is_warning_enabled (a_warning: STRING): BOOLEAN is
331 -- Is `a_warning' set for Current?
332 require
333 a_warning_not_void: a_warning /= Void
334 do
335 Result := lace_class.options.is_warning_enabled (a_warning)
336 end
337
338 apply_msil_application_optimizations: BOOLEAN is
339 -- Should MSIL application optimizations be applied?
340 do
341 Result := False
342 end
343
344 has_external_ancestor_class: BOOLEAN is
345 -- Does current class have an external ancestor which is a class (not interface)?
346 local
347 p: like parents_classes
348 parent_class: CLASS_C
349 do
350 p := parents_classes
351 if p /= Void then
352 from
353 p.start
354 until
355 p.after
356 loop
357 parent_class := p.item
358 if
359 not parent_class.is_interface and then
360 (parent_class.is_external or else parent_class.has_external_ancestor_class)
361 then
362 Result := True
363 p.finish
364 end
365 p.forth
366 end
367 end
368 end
369
370 feature -- Action
371
372 record_precompiled_class_in_system is
373 do
374 end
375
376 feature -- Conformance dependencies
377
378 conf_dep_table: PACKED_BOOLEANS
379 -- Table for quick lookup
380
381 conf_dep_classes : LINKED_LIST [CLASS_C]
382 -- Classes which depend on Current's conformance
383 -- to some other class.
384
385 add_dep_class (a_class : CLASS_C) is
386 -- Add `a_class' to `conf_dep_classes'
387 -- Do nothing if already there.
388 require
389 not_void : a_class /= Void
390 local
391 topid: INTEGER
392 loc_list: LINKED_LIST [CLASS_C]
393 loc_tab: PACKED_BOOLEANS
394 do
395 topid := a_class.topological_id
396
397 if conf_dep_table = Void then
398 create conf_dep_table.make (topid + 32)
399
400 if conf_dep_classes /= Void then
401 -- Topological ids have changed
402 -- Recreate lookup table
403
404 from
405 loc_list := conf_dep_classes
406 loc_tab := conf_dep_table
407 loc_list.start
408 until
409 loc_list.after
410 loop
411 loc_tab.force (True, loc_list.item.topological_id)
412 loc_list.forth
413 end
414 end
415 end
416
417 if conf_dep_classes = Void then
418 create conf_dep_classes.make
419 create conf_dep_table.make (topid + 32)
420 end
421
422 loc_list := conf_dep_classes
423 loc_tab := conf_dep_table
424
425 if topid > loc_tab.upper then
426 -- Table needs resizing
427 loc_tab.resize (topid + 32)
428 end
429
430 if not loc_tab.item (topid) then
431 loc_list.extend (a_class)
432 loc_list.finish
433 loc_tab.put (True, topid)
434 end
435 ensure
436 has_dep_class : has_dep_class (a_class)
437 end
438
439 remove_dep_class (a_class : CLASS_C) is
440 -- Remove `a_class' from `conf_dep_classes'
441 require
442 not_void : a_class /= Void
443 has: has_dep_class (a_class)
444 do
445 conf_dep_classes.start
446 conf_dep_classes.prune (a_class)
447 conf_dep_table.put (False, a_class.topological_id)
448 ensure
449 removed : not has_dep_class (a_class)
450 end
451
452 has_dep_class (a_class: CLASS_C): BOOLEAN is
453 -- Is `a_class' in `conf_dep_classes'?
454 require
455 not_void : a_class /= Void
456 local
457 topid: INTEGER
458 loc_tab: PACKED_BOOLEANS
459 do
460 topid := a_class.topological_id
461 loc_tab := conf_dep_table
462
463 Result := (loc_tab /= Void)
464 and then (topid <= loc_tab.upper)
465 and then loc_tab.item (topid)
466 end
467
468 reset_dep_classes is
469 -- Update `conf_dep_classes' with removed classes.
470 local
471 a_class: CLASS_C
472 do
473 if conf_dep_classes /= Void then
474 from
475 conf_dep_classes.start
476 until
477 conf_dep_classes.after
478 loop
479 a_class := conf_dep_classes.item
480 if System.classes.item (a_class.class_id) = Void then
481 -- Class has been removed and we should discard
482 -- any previous dependency.
483 conf_dep_classes.remove
484 else
485 conf_dep_classes.forth
486 end
487 end
488 end
489 end
490
491 feature -- Building conformance table
492
493 fill_conformance_table is
494 -- Fill the conformance table. All the class processed
495 -- during second pass must see their conformance table
496 -- processed/re-processed by this routine.
497 require
498 topological_id_processed: topological_id > 0
499 do
500 -- Resize the table after the topological sort
501 conformance_table.resize (topological_id)
502 conformance_table.clear_all
503 conf_dep_table := Void
504 build_conformance_table_of (Current)
505 end
506
507 build_conformance_table_of (cl: CLASS_C) is
508 -- Build recursively the conformance table of class `cl.
509 require
510 good_argument: cl /= Void
511 topological_id_processed: topological_id > 0
512 conformance: topological_id <= cl.topological_id
513 local
514 a_parent: CLASS_C
515 a_table: PACKED_BOOLEANS
516 l_area: SPECIAL [CLASS_C]
517 i, nb: INTEGER
518 do
519 a_table := cl.conformance_table
520 if a_table.item (topological_id) = False then
521 -- The parent has not been inserted yet
522 a_table.put (True, topological_id)
523 from
524 l_area := parents_classes.area
525 nb := parents_classes.count
526 until
527 i = nb
528 loop
529 a_parent := l_area.item (i)
530 a_parent.build_conformance_table_of (cl)
531 i := i + 1
532 end
533 end
534 end
535
536 feature -- Expanded rues validity
537
538 check_expanded is
539 -- Check the expanded validity rule.
540 -- Pass 2 must be done on all the classes
541 -- (the creators must be up to date)
542 local
543 constraint_types: LIST[RENAMED_TYPE_A [TYPE_A]]
544 l_formals: like generic_features
545 l_cursor: CURSOR
546 l_formal_dec: FORMAL_CONSTRAINT_AS
547 do
548 debug ("CHECK_EXPANDED")
549 io.error.put_string ("Checking expanded for: ")
550 io.error.put_string (name)
551 io.error.put_new_line
552 end
553 feature_table.check_expanded
554
555 -- Check validity of all formal generic parameters instantiated
556 -- as expanded types.
557 l_formals := generic_features
558 if l_formals /= Void then
559 from
560 l_cursor := l_formals.cursor
561 l_formals.start
562 until
563 l_formals.after
564 loop
565 l_formals.item_for_iteration.check_expanded (Current)
566 l_formals.forth
567 end
568 l_formals.go_to (l_cursor)
569 Error_handler.checksum
570 end
571
572 if is_generic then
573 from
574 generics.start
575 until
576 generics.after
577 loop
578 l_formal_dec ?= generics.item
579 check l_formal_dec_not_void: l_formal_dec /= Void end
580 constraint_types := l_formal_dec.constraint_types (Current)
581 from
582 constraint_types.start
583 until
584 constraint_types.after
585 loop
586 if constraint_types.item.type.has_generics then
587 System.expanded_checker.check_actual_type (constraint_types.item.type)
588 end
589 constraint_types.forth
590 end
591 generics.forth
592 end
593 end
594 end
595
596 feature -- Third pass: byte code production and type check
597
598 record_suppliers (feature_i: FEATURE_I; dependances: CLASS_DEPENDANCE) is
599 -- Record suppliers of `feature_i' and insert it in `dependances'.
600 require
601 feature_i_not_void: feature_i /= Void
602 dependances_not_void: dependances /= Void
603 local
604 f_suppliers: FEATURE_DEPENDANCE
605 body_index: INTEGER
606 do
607 body_index := feature_i.body_index
608 -- If `body_index' is 0, it means that `feature_i' is declared
609 -- in an external class.
610 check
611 written_in_external_class: body_index = 0 implies
612 feature_i.written_class.is_true_external
613 end
614 if body_index /= 0 then
615 if dependances.has (body_index) then
616 dependances.remove (body_index)
617 end
618 create f_suppliers.make
619 f_suppliers.set_feature_name_id (feature_i.feature_name_id)
620 feature_i.record_suppliers (f_suppliers)
621 dependances.put (f_suppliers, body_index)
622 end
623 ensure
624 inserted: feature_i.body_index /= 0 implies dependances.has (feature_i.body_index)
625 end
626
627 update_suppliers (new_suppliers: like suppliers) is
628 -- Update the supplier list with `new_suppliers'.
629 require
630 good_argument: new_suppliers /= Void
631 local
632 local_suppliers: like suppliers
633 supplier_clients: ARRAYED_LIST [CLASS_C]
634 do
635 from
636 local_suppliers := suppliers
637 local_suppliers.start
638 until
639 local_suppliers.after
640 loop
641 supplier_clients := local_suppliers.item.supplier.clients
642 supplier_clients.start
643 supplier_clients.search (Current)
644 supplier_clients.remove
645 local_suppliers.forth
646 end
647
648 from
649 new_suppliers.start
650 until
651 new_suppliers.after
652 loop
653 new_suppliers.item.supplier.clients.extend (Current)
654 new_suppliers.forth
655 end
656 set_suppliers (new_suppliers)
657 end
658
659 feature -- Generation
660
661 pass4 is
662 -- Generation of C files for each type associated to the current
663 -- class
664 --|Don't forget to modify also `generate_workbench_files' when modifying
665 --|this function
666 do
667 end
668
669 feature -- Setting
670
671 set_assembly_info (a: like assembly_info) is
672 -- Set `assembly_info' with `a'.
673 require
674 a_not_void: a /= Void
675 do
676 assembly_info := a
677 ensure
678 assembly_info_set: assembly_info = a
679 end
680
681 feature -- Melting
682
683 melt is
684 -- Melt changed features.
685 require
686 good_context: has_features_to_melt
687 do
688 end
689
690 update_execution_table is
691 -- Update execution table.
692 require
693 good_context: has_features_to_melt
694 do
695 end
696
697 has_features_to_melt: BOOLEAN is
698 -- Has the current class features to melt ?
699 do
700 end
701
702 melt_all is
703 -- Melt all the features written in the class
704 do
705 end
706
707 feature -- Skeleton processing
708
709 init_process_skeleton (old_skeletons: ARRAY [SKELETON]) is
710 -- Fill `old_skeletons' with old skeleton of class types in `types'.
711 require
712 old_skeletons_not_void: old_skeletons /= Void
713 has_skeleton: skeleton /= Void
714 local
715 class_type: CLASS_TYPE
716 do
717 from
718 types.start
719 until
720 types.after
721 loop
722 class_type := types.item
723 old_skeletons.force (class_type.skeleton, class_type.type_id)
724 types.forth
725 end
726 end
727
728 process_skeleton (old_skeletons: ARRAY [SKELETON]) is
729 -- Type skeleton processing: If skeleton of a class type changed,
730 -- it must be re-processed and marked `is_changed'.
731 require
732 old_skeletons_not_void: old_skeletons /= Void
733 has_skeleton: skeleton /= Void
734 local
735 class_type: CLASS_TYPE
736 new_skeleton, old_skeleton: SKELETON
737 class_types: SPECIAL [CLASS_TYPE]
738 i: INTEGER
739 n: INTEGER
740 generic_class_type: CLASS_TYPE
741 do
742 from
743 types.start
744 until
745 types.after
746 loop
747 class_type := types.item
748 old_skeleton := class_type.skeleton
749 new_skeleton := skeleton.instantiation_in (class_type)
750 if
751 old_skeleton = Void
752 or else not new_skeleton.equiv (old_skeletons, old_skeleton)
753 then
754 class_type.set_is_changed (True)
755 class_type.set_skeleton (new_skeleton)
756 if class_type.is_expanded and old_skeleton /= Void then
757 -- Force recompilation of all clients, as the layout of expanded
758 -- have changed possibly making some of our generated code incorrect
759 -- if the skeleton size have change. Note that we cannot query the size
760 -- here in case of VLEC errors that will be find later in the
761 -- compilation.
762 from
763 clients.start
764 until
765 clients.after
766 loop
767 clients.item.melt_all
768 clients.forth
769 end
770 -- Recompile generic derivations that depend on `class_type' as
771 -- `clients' does not include them.
772 from
773 class_types := system.class_types
774 i := class_types.lower
775 n := class_types.upper
776 until
777 i > n
778 loop
779 generic_class_type := class_types [i]
780 if generic_class_type /= Void and then generic_class_type.type.has_actual (class_type.type) then
781 debug ("to_implement")
782 to_implement ("Recompilation could be done on a per-class-type rather than per-class basis.")
783 end
784 generic_class_type.associated_class.melt_all
785 end
786 i := i + 1
787 end
788 end
789 Degree_1.insert_class (Current)
790 end
791 types.forth
792 end
793 changed2 := False
794 changed4 := False
795 end
796
797 feature {NONE} -- Class initialization
798
799 similar_parents
800 (a_old_parents, a_new_parents: EIFFEL_LIST [PARENT_AS]): TUPLE [BOOLEAN, BOOLEAN]
801 is
802 -- First element of tuple: Does `a_new_parents' include all types used in
803 -- `a_old_parents' and no type has been removed from `a_old_parents'.
804 -- Second element of tuple: was a parent type of `a_old_parents' removed from
805 -- `a_new_parents'.
806 local
807 i, o_count, j, l_count: INTEGER
808 l_area, o_area: SPECIAL [PARENT_AS]
809 l_parent_type: CLASS_TYPE_AS
810 l_same_parent, l_removed_parent, l_found: BOOLEAN
811 do
812 if a_old_parents = Void then
813 -- Parents may have changed, but none has been removed.
814 Result := [a_new_parents = Void, False]
815 elseif a_new_parents /= Void then
816 l_area := a_new_parents.area
817 o_area := a_old_parents.area
818 l_count := a_new_parents.count - 1
819 o_count := a_old_parents.count - 1
820
821 -- Check if all types used in new parents clauses were also used in previous
822 -- compilation (possibly in different order and with different number of
823 -- occurrences)
824 from
825 check
826 i_is_zero: i = 0
827 end
828 l_same_parent := True
829 until
830 i > l_count or else not l_same_parent
831 loop
832 l_parent_type := l_area.item (i).type
833 from
834 j := 0
835 l_same_parent := False
836 until
837 j > o_count or else l_same_parent
838 loop
839 l_same_parent := l_parent_type.is_equivalent (o_area.item (j).type)
840 j := j + 1
841 end
842 i := i + 1
843 end
844
845 -- We need to check that all types of `a_old_parents' are present
846 -- in `a_new_parents'.
847 from
848 check
849 l_removed_parent_set: not l_removed_parent
850 end
851 i := 0
852 l_area := a_new_parents.area
853 o_area := a_old_parents.area
854 until
855 i > o_count or else l_removed_parent
856 loop
857 l_parent_type := o_area.item (i).type
858 from
859 j := 0
860 l_found := False
861 until
862 j > l_count or else l_found
863 loop
864 l_found := l_parent_type.is_equivalent (l_area.item (j).type)
865 j := j + 1
866 end
867 l_removed_parent := not l_found
868 i := i + 1
869 end
870
871 Result := [l_same_parent and not l_removed_parent, l_removed_parent]
872 else
873 -- Case where all parents have been removed, clearly it is not
874 -- the same and they have been removed.
875 check
876 status: a_old_parents /= Void and a_new_parents = Void
877 end
878 Result := [False, True]
879 end
880 end
881
882 feature -- Class initialization
883
884 init_class_interface is
885 -- Initialize `class_interface' accordingly to current class
886 -- definition.
887 require
888 il_generation: System.il_generation
889 do
890 if class_interface = Void then
891 create class_interface.make_with_class (Current)
892 end
893 end
894
895 feature {NONE} -- Private access
896
897 Any_type: CL_TYPE_A is
898 -- Default parent type
899 once
900 create Result.make (System.any_id)
901 ensure
902 any_type_not_void: Result /= Void
903 end
904
905 Any_parent: PARENT_C is
906 -- Default compiled parent
907 once
908 create Result
909 Result.set_parent_type (Any_type)
910 ensure
911 any_parent_not_void: Result /= Void
912 end
913
914 feature
915
916 update_syntactical_relations (old_syntactical_suppliers: like syntactical_suppliers) is
917 -- Remove syntactical client/supplier relations and take
918 -- care of possible removed classes
919 local
920 a_class: CLASS_C
921 supplier_clients: like syntactical_clients
922 do
923 -- Remove old syntactical supplier/client relations
924 from
925 old_syntactical_suppliers.start
926 until
927 old_syntactical_suppliers.off
928 loop
929 a_class := old_syntactical_suppliers.item
930 if a_class /= Current then
931 supplier_clients := a_class.syntactical_clients
932 supplier_clients.start
933 supplier_clients.compare_references
934 supplier_clients.search (Current)
935 if not supplier_clients.after then
936 supplier_clients.remove
937 end
938 end
939 old_syntactical_suppliers.forth
940 end
941 -- Add new syntactical supplier/client relations
942 from
943 syntactical_suppliers.start
944 until
945 syntactical_suppliers.off
946 loop
947 a_class := syntactical_suppliers.item
948 if a_class /= Current then
949 supplier_clients := a_class.syntactical_clients
950 supplier_clients.extend (Current)
951 end
952 syntactical_suppliers.forth
953 end
954 end
955
956 remove_relations is
957 -- Remove client/supplier and parent/descendant relations
958 -- of the current class.
959 require
960 parents_exists: parents_classes /= Void
961 local
962 local_suppliers: SUPPLIER_LIST
963 clients_list: ARRAYED_LIST [CLASS_C]
964 do
965 remove_parent_relations
966 from
967 local_suppliers := suppliers
968 local_suppliers.start
969 until
970 local_suppliers.after
971 loop
972 clients_list := local_suppliers.item.supplier.clients
973 clients_list.start
974 clients_list.search (Current)
975 if not clients_list.after then
976 clients_list.remove
977 end
978 local_suppliers.forth
979 end
980 local_suppliers.wipe_out
981 end
982
983 remove_parent_relations is
984 -- Remove parent/descendant relations of the Current class
985 require
986 parents_exists: parents_classes /= Void
987 local
988 des: ARRAYED_LIST [CLASS_C]
989 l_area: SPECIAL [CLASS_C]
990 i, nb: INTEGER
991 c: CLASS_C
992 do
993 from
994 l_area := parents_classes.area
995 nb := parents_classes.count
996 until
997 i = nb
998 loop
999 c := l_area.item (i)
1000 if c /= Void then
1001 des:= c.descendants
1002 des.start
1003 des.search (Current)
1004 if not des.after then
1005 des.remove
1006 end
1007 end
1008 i := i + 1
1009 end
1010 end
1011
1012 mark_class (marked_classes: SEARCH_TABLE [INTEGER]) is
1013 -- Mark the class as used in the system
1014 -- and propagate to the suppliers
1015 -- Used by remove_useless_classes in SYSTEM_I
1016 local
1017 l_syntactical_suppliers: like syntactical_suppliers
1018 do
1019 if not marked_classes.has (class_id) then
1020 marked_classes.put (class_id)
1021 from
1022 l_syntactical_suppliers := syntactical_suppliers
1023 l_syntactical_suppliers.start
1024 until
1025 l_syntactical_suppliers.after
1026 loop
1027 l_syntactical_suppliers.item.mark_class (marked_classes)
1028 l_syntactical_suppliers.forth
1029 end
1030 end
1031 end
1032
1033 check_generics is
1034 -- Check validity formal generic parameter declaration.
1035 -- Validity rule VCFG (page 52)
1036 require
1037 generics_exists: is_generic
1038 do
1039 end
1040
1041 check_generic_parameters is
1042 -- Check validity formal generic parameter declaration.
1043 -- Validity rule VCFG1 (page 52)
1044 require
1045 generics_exists: is_generic
1046 do
1047 end
1048
1049 check_creation_constraint_genericity is
1050 -- Check validity of creation constraint genericity
1051 -- I.e. that the specified creation procedures does exist
1052 -- in the constraint class.
1053 require
1054 generics_exists: is_generic
1055 do
1056 end
1057
1058 check_constraint_genericity is
1059 -- Check validity of constraint genericity
1060 require
1061 generics_exists: is_generic
1062 do
1063 end
1064
1065 check_constraint_renaming is
1066 -- Check validity of renaming
1067 -- Requires feature tables!!
1068 do
1069 end
1070
1071 feature -- Parent checking
1072
1073 fill_parents (a_old_class_info, a_class_info: CLASS_INFO) is
1074 -- Initialization of the parent types `parents': put
1075 -- the default parent HERE if needed. Calculates also the
1076 -- lists `descendants'. Since the routine `check_suppliers'
1077 -- has been called before, all the instances of CLASS_C
1078 -- corresponding to the parents of the current class are
1079 -- in the system (even if a parent is not already parsed).
1080 require
1081 need_new_parents: need_new_parents
1082 a_class_info_not_void: a_class_info /= Void
1083 local
1084 l_parents_as: EIFFEL_LIST [PARENT_AS]
1085 l_parent_c: PARENT_C
1086 l_parent_class: CLASS_C
1087 l_parent_as: PARENT_AS
1088 l_raw_type: CLASS_TYPE_AS
1089 l_ancestor_id, l_count: INTEGER
1090 l_vhpr1: VHPR1
1091 l_ve04: VE04
1092 l_dummy_list: LINKED_LIST [INTEGER]
1093 l_client: CLASS_C
1094 l_tuple: TUPLE [BOOLEAN, BOOLEAN]
1095 l_compiled_parent_generator: AST_PARENT_C_GENERATOR
1096 l_parent_type: CL_TYPE_A
1097 l_vtug: VTUG
1098 do
1099 -- Reset flag
1100 need_new_parents := False
1101
1102 -- Initialize context
1103 Inst_context.set_group (group)
1104 l_parents_as := a_class_info.parents
1105 l_ancestor_id := System.any_id
1106
1107 if l_parents_as /= Void and then not l_parents_as.is_empty then
1108 if class_id = l_ancestor_id then
1109 create l_vhpr1
1110 create l_dummy_list.make
1111 l_dummy_list.extend (class_id)
1112 l_vhpr1.set_involved_classes (l_dummy_list)
1113 Error_handler.insert_error (l_vhpr1)
1114 -- Cannot go on here
1115 Error_handler.raise_error
1116 end
1117
1118 -- VHPR3 checking and extract structure from parsing.
1119 from
1120 l_count := l_parents_as.count
1121 create parents_classes.make (l_count)
1122 create computed_parents.make (l_count)
1123 create parents.make (l_count)
1124 create l_compiled_parent_generator
1125 l_parents_as.start
1126 until
1127 l_parents_as.after
1128 loop
1129 -- Evaluation of the parent type
1130 l_parent_as := l_parents_as.item
1131 l_raw_type := l_parent_as.type
1132 l_parent_c := l_compiled_parent_generator.compiled_parent (Current, l_parent_as)
1133 -- Check if there is no anchor and no bit symbol in the parent type.
1134 if not l_parent_c.parent_type.is_valid or else l_parent_c.parent_type.has_like then
1135 create l_ve04
1136 l_ve04.set_class (Current)
1137 l_ve04.set_parent_type (l_raw_type)
1138 l_ve04.set_location (l_parent_as.start_location)
1139 Error_handler.insert_error (l_ve04)
1140 else
1141 computed_parents.extend (l_parent_c)
1142
1143 l_parent_class := clickable_info.associated_eiffel_class (lace_class,
1144 l_parent_as.type).compiled_class
1145 -- Insertion of a new descendant for the parent class
1146 check
1147 parent_class_exists: l_parent_class /= Void
1148 -- This ensures that routine `check_suppliers'
1149 -- has been called before.
1150 end
1151 l_parent_class.add_descendant (Current)
1152
1153 -- Use reference class type as a parent.
1154 l_parent_type := l_parent_c.parent_type
1155 if l_parent_type.is_expanded then
1156 l_parent_type := l_parent_type.reference_type
1157 end
1158
1159 if l_parent_class.is_generic then
1160 -- Look for a derivation of the same class.
1161 from
1162 parents_classes.start
1163 until
1164 parents_classes.after
1165 loop
1166 if parents_classes.item = l_parent_class then
1167 if not parents.i_th (parents_classes.index).same_as (l_parent_type) then
1168 -- Different generic derivations are used in Parent parts.
1169 error_handler.insert_error (create {VHPR5_ECMA}.make
1170 (Current, l_parent_type, parents.i_th (parents_classes.index), l_parent_as.start_location))
1171 end
1172 end
1173 parents_classes.forth
1174 end
1175 end
1176
1177 -- This addresses eweasel test#term146 where we assumed before at degree 4
1178 -- they had the correct number of formal generics and thus performed conformance
1179 -- checking blindly. Now we check the error at the end of degree 5 to prevent
1180 -- this problem.
1181 if not l_parent_type.good_generics then
1182 l_vtug := l_parent_type.error_generics
1183 l_vtug.set_class (Current)
1184 l_vtug.set_location (l_parent_as.start_location)
1185 error_handler.insert_error (l_vtug)
1186 end
1187
1188 parents.extend (l_parent_type)
1189 -- Insertion in `parents_classes'.
1190 parents_classes.extend (l_parent_class)
1191 end
1192 l_parents_as.forth
1193 end
1194 elseif not (class_id = l_ancestor_id) then
1195 -- No parents are syntactiaclly specified: ANY is
1196 -- the default parent for Eiffel classes.
1197 create parents_classes.make (1)
1198 create computed_parents.make (1)
1199 create parents.make (1)
1200
1201 -- Add a descendant to class ANY
1202 System.any_class.compiled_class.add_descendant (Current)
1203 -- Insertion in `parents_classes'
1204 parents_classes.extend (System.any_class.compiled_class)
1205 -- Insertion in `parents'
1206 parents.extend (Any_type)
1207 -- Insertion in `computed_parents'
1208 computed_parents.extend (Any_parent)
1209 else
1210 -- In case of the ancestor class to all classes, just create an empty
1211 -- parent structure.
1212 create parents_classes.make (0)
1213 create parents.make (0)
1214 create computed_parents.make (0)
1215 end
1216
1217 if a_old_class_info /= Void then
1218 l_tuple := similar_parents (a_old_class_info.parents, a_class_info.parents)
1219 if not l_tuple.boolean_item (1) then
1220 -- Conformance tables incrementality as inheritance has changed
1221 set_changed (True)
1222 set_changed3a (True)
1223 System.set_update_sort (True)
1224
1225 if l_tuple.boolean_item (2) then
1226 -- A parent has been removed:
1227 -- Take care of signature conformance for redefinion of
1228 -- f(p:PARENT) in f(c: CHILD). If CHILD does not inherit
1229 -- from PARENT anymore, the redefinition of f is not valid
1230 from
1231 syntactical_clients.start
1232 until
1233 syntactical_clients.after
1234 loop
1235 l_client := syntactical_clients.item
1236 l_client.set_changed2 (True)
1237 Degree_4.insert_new_class (l_client)
1238 syntactical_clients.forth
1239 end
1240 end
1241 end
1242 if not changed then
1243 -- If the class is not changed, it is marked `changed2'
1244 changed2 := True
1245 end
1246 else
1247 -- First compilation of the class
1248 System.set_update_sort (True)
1249 end
1250 ensure
1251 not_need_new_parents: not need_new_parents
1252 parents_not_void: parents /= Void
1253 parents_classes_not_void: parents_classes /= Void
1254 computed_parents_not_void: computed_parents /= Void
1255 end
1256
1257 check_parents is
1258 -- Check generical parents
1259 require
1260 parents_not_void: parents /= Void
1261 local
1262 vtcg4: VTCG4
1263 vifi1: VIFI1
1264 vifi2: VIFI2
1265 parent_actual_type: CL_TYPE_A
1266 l_area: SPECIAL [CL_TYPE_A]
1267 i, nb: INTEGER
1268 l_parent_class: CLASS_C
1269 l_single_classes: LINKED_LIST [CLASS_C]
1270 l_old_is_single, l_has_external_parent: BOOLEAN
1271 do
1272 -- Clear feature context
1273 ast_context.clear_feature_context
1274 from
1275 l_area := parents.area
1276 nb := parents.count
1277 l_old_is_single := is_single
1278 has_external_main_parent := False
1279 until
1280 i = nb
1281 loop
1282 parent_actual_type := l_area.item (i)
1283 l_parent_class := parent_actual_type.associated_class
1284 l_has_external_parent := l_parent_class.is_external and then not l_parent_class.is_interface
1285 if l_has_external_parent then
1286 has_external_main_parent := True
1287 end
1288 if l_has_external_parent or l_parent_class.is_single then
1289 if l_single_classes = Void then
1290 create l_single_classes.make
1291 end
1292 l_single_classes.extend (l_parent_class)
1293 l_single_classes.finish
1294 end
1295
1296 check
1297 -- This has already been checked in `fill_parents'.
1298 valid_generics: parent_actual_type.good_generics
1299 end
1300 if parent_actual_type.generics /= Void then
1301 -- Check constrained genericity validity rule
1302 parent_actual_type.reset_constraint_error_list
1303 -- Check creation readyness because parents have to be creation ready.
1304 parent_actual_type.check_constraints (Current, Void, True)
1305 if not parent_actual_type.constraint_error_list.is_empty then
1306 create vtcg4
1307 vtcg4.set_class (Current)
1308 vtcg4.set_error_list (parent_actual_type.constraint_error_list)
1309 vtcg4.set_parent_type (parent_actual_type)
1310 fixme ("Shouldn't we be able to provide a location?")
1311 Error_handler.insert_error (vtcg4)
1312 end
1313 end
1314
1315 if l_parent_class.is_frozen then
1316 -- Error which occurs only during IL generation.
1317 create vifi1.make (Current)
1318 vifi1.set_parent_class (l_parent_class)
1319 fixme ("Shouldn't we be able to provide a location?")
1320 Error_handler.insert_error (vifi1)
1321 end
1322 i := i + 1
1323 end
1324
1325 if l_single_classes /= Void and then l_single_classes.count > 1 then
1326 -- Error we are trying to do multiple inheritance of classes
1327 -- that inherit from external classes or that are external classes.
1328 -- Error which occurs only during IL generation.
1329 create vifi2.make (Current)
1330 vifi2.set_parent_classes (l_single_classes)
1331 fixme ("Shouldn't we be able to provide a location?")
1332 Error_handler.insert_error (vifi2)
1333 end
1334 if l_single_classes /= Void and then is_expanded then
1335 -- External classes are inherited by expanded class.
1336 check
1337 l_single_classes_not_empty: not l_single_classes.is_empty
1338 end
1339 fixme ("Shouldn't we be able to provide a location?")
1340 Error_handler.insert_error (create {VIFI3}.make (Current, l_single_classes))
1341 end
1342
1343 -- Only classes that explicitely inherit from an external class only once
1344 -- are marked `single.
1345 set_is_single (l_single_classes /= Void and then l_single_classes.count = 1)
1346 if System.il_generation and then l_old_is_single /= is_single then
1347 -- Class has its `is_single' status changed.
1348 -- We have to reset its `types' so that they are recomputed and
1349 -- we have to remove existing types from `System.class_types'
1350 remove_types
1351 -- Force recompilation of all clients, as the code to create objects might have changed
1352 from
1353 clients.start
1354 until
1355 clients.after
1356 loop
1357 clients.item.melt_all
1358 clients.forth
1359 end
1360 end
1361 Error_handler.checksum
1362 ensure
1363 parents_set: parents /= Void
1364 end
1365
1366 remove_types is
1367 -- Removes all types from system
1368 do
1369 if has_types then
1370 from
1371 types.start
1372 until
1373 types.after
1374 loop
1375 System.remove_class_type (types.item)
1376 types.forth
1377 end
1378 types.wipe_out
1379 set_changed4 (True)
1380 end
1381 ensure
1382 types_empty: not has_types
1383 end
1384
1385 feature -- Supplier checking
1386
1387 check_that_root_class_is_not_deferred is
1388 -- Check non-genericity of root class
1389 require
1390 is_root_class: Current = System.root_class.compiled_class
1391 local
1392 l_vsrt3: VSRT3
1393 do
1394 if is_deferred then
1395 create l_vsrt3
1396 l_vsrt3.set_class (Current)
1397 Error_handler.insert_error (l_vsrt3)
1398 Error_handler.checksum
1399 end
1400 end
1401
1402 check_root_class_creators is
1403 -- Check creation procedures of root class
1404 require
1405 is_root: Current = System.root_type.associated_class
1406 local
1407 l_creation_proc: FEATURE_I
1408 l_system_creation: STRING
1409 l_error: BOOLEAN
1410 l_vsrp2: VSRP2
1411 l_arg_type: TYPE_A
1412 l_vd27: VD27
1413 l_feat_tbl: like feature_table
1414 do
1415 l_system_creation := System.root_creation_name
1416 if creators /= Void and l_system_creation/= Void then
1417 l_feat_tbl := feature_table
1418 from
1419 creators.start
1420 until
1421 creators.after
1422 loop
1423 if l_system_creation.is_equal (creators.key_for_iteration) then
1424 -- `creators.key_for_iteration' contains the creation_name
1425 l_creation_proc := l_feat_tbl.item (creators.key_for_iteration)
1426
1427 inspect
1428 l_creation_proc.argument_count
1429 when 0 then
1430 l_error := False
1431 when 1 then
1432 l_arg_type ?= l_creation_proc.arguments.first
1433 l_arg_type := l_arg_type.instantiation_in (system.root_type, class_id).actual_type
1434 l_error := not l_arg_type.is_safe_equivalent (Array_of_string)
1435 else
1436 l_error := True
1437 end
1438
1439 if l_error then
1440 create l_vsrp2
1441 l_vsrp2.set_class (Current)
1442 l_vsrp2.set_root_type (system.root_type)
1443 -- Need duplication otherwise we would change the original FEATURE_I
1444 -- object while displaying the error.
1445 l_creation_proc := l_creation_proc.duplicate
1446 l_creation_proc.instantiation_in (system.root_type)
1447 l_vsrp2.set_creation_feature (l_creation_proc)
1448 Error_handler.insert_error (l_vsrp2)
1449 end
1450 end
1451 creators.forth
1452 end
1453 end
1454
1455 if l_system_creation /= Void and then creators = Void then
1456 -- Check default create
1457 l_creation_proc := default_create_feature
1458 if not l_creation_proc.feature_name.is_equal (l_system_creation) then
1459 create l_vd27
1460 l_vd27.set_creation_routine (l_system_creation)
1461 l_vd27.set_root_class (Current)
1462 Error_handler.insert_error (l_vd27)
1463 end
1464 elseif l_system_creation /= Void and then not creators.has (l_system_creation) then
1465 create l_vd27
1466 l_vd27.set_creation_routine (l_system_creation)
1467 l_vd27.set_root_class (Current)
1468 Error_handler.insert_error (l_vd27)
1469 elseif l_system_creation = Void then
1470 if allows_default_creation then
1471 -- Set creation_name in System
1472 System.set_creation_name (default_create_feature.feature_name)
1473 else
1474 create l_vd27
1475 l_vd27.set_creation_routine ("")
1476 l_vd27.set_root_class (Current)
1477 Error_handler.insert_error (l_vd27)
1478 end
1479 end
1480
1481 Error_handler.checksum
1482 end
1483
1484 Array_of_string: GEN_TYPE_A is
1485 -- Type ARRAY [STRING]
1486 local
1487 array_generics: ARRAY [TYPE_A]
1488 string_type: CL_TYPE_A
1489 once
1490 create string_type.make (System.string_8_id)
1491 create array_generics.make (1, 1)
1492 array_generics.put (string_type, 1)
1493 create Result.make (System.array_id, array_generics)
1494 ensure
1495 array_of_string_not_void: Result /= Void
1496 end
1497
1498 feature -- Order relation for inheritance and topological sort
1499
1500 simple_conform_to (other: CLASS_C): BOOLEAN is
1501 -- Is `other' an ancestor of Current?
1502 require
1503 good_argument: other /= Void
1504 local
1505 otopid: INTEGER
1506 do
1507 otopid := other.topological_id
1508 Result := otopid <= topological_id
1509 -- A parent has necessarily a class id
1510 -- less or equal than the one of the heir class
1511 and then conformance_table.item (otopid)
1512 -- Check conformance table
1513 end
1514
1515 conform_to (other: CLASS_C): BOOLEAN is
1516 -- Is `other' an ancestor of Current ?
1517 require
1518 good_argument: other /= Void
1519 local
1520 dep_class: CLASS_C
1521 otopid: INTEGER
1522 do
1523 Result := True
1524
1525 if Current /= other then
1526 otopid := other.topological_id
1527 Result := otopid <= topological_id
1528 -- A parent has necessarily a class id
1529 -- less or equal than the one of the heir class
1530 and then conformance_table.item (otopid)
1531 -- Check conformance table
1532
1533 if Result and then (not is_class_none) and then (not other.is_class_any) then
1534 dep_class := System.current_class
1535
1536 if dep_class /= Void and then dep_class /= Current then
1537 add_dep_class (dep_class)
1538 end
1539 end
1540 end
1541 end
1542
1543 valid_creation_procedure (fn: STRING): BOOLEAN is
1544 -- Is `fn' a valid creation procedure ?
1545 require
1546 good_argument: fn /= Void
1547 local
1548 dcr_feat : FEATURE_I
1549 do
1550 if creators /= Void then
1551 Result := creators.has (fn)
1552 else
1553 dcr_feat := default_create_feature
1554
1555 if dcr_feat /= Void then
1556 Result := fn.is_equal (dcr_feat.feature_name)
1557 end
1558 end
1559 end
1560
1561 feature -- Propagation
1562
1563 recompile_syntactical_clients is
1564 -- Order relation on classes
1565 local
1566 class_i: CLASS_I
1567 l_syntactical_clients: like syntactical_clients
1568 do
1569 from
1570 l_syntactical_clients := syntactical_clients
1571 l_syntactical_clients.start
1572 until
1573 l_syntactical_clients.after
1574 loop
1575 class_i := l_syntactical_clients.item.original_class
1576 debug ("REMOVE_CLASS")
1577 io.error.put_string ("Propagation to client: ")
1578 io.error.put_string (class_i.name)
1579 io.error.put_new_line
1580 end
1581 workbench.add_class_to_recompile (class_i)
1582 class_i.set_changed (True)
1583 l_syntactical_clients.forth
1584 end
1585 end
1586
1587 feature -- Convenience features
1588
1589 set_changed (b: BOOLEAN) is
1590 -- Mark the associated lace class changed.
1591 do
1592 original_class.set_changed (b)
1593 ensure
1594 changed_set: changed = b
1595 end
1596
1597 set_changed2 (b: BOOLEAN) is
1598 -- Assign `b' to `changed2'.
1599 do
1600 changed2 := b
1601 ensure
1602 changed2_set: changed2 = b
1603 end
1604
1605 set_changed3a (b: BOOLEAN) is
1606 -- Assign `b' to `changed3a'.
1607 do
1608 changed3a := b
1609 ensure
1610 changed3a_set: changed3a = b
1611 end
1612
1613 set_need_type_check (b: like need_type_check) is
1614 -- Assign `b' to `need_tye_check'.
1615 do
1616 need_type_check := b
1617 ensure
1618 need_type_check_set: need_type_check = b
1619 end
1620
1621 set_changed4 (b: BOOLEAN) is
1622 -- Assign `b' to `changed4'.
1623 do
1624 changed4 := b
1625 ensure
1626 changed4_set: changed4 = b
1627 end
1628
1629 set_has_unique is
1630 -- Set `has_unique' to True
1631 do
1632 has_unique := True
1633 ensure
1634 has_unique_set: has_unique
1635 end
1636
1637 set_has_expanded is
1638 -- Set `has_expanded' to True
1639 do
1640 has_expanded := True
1641 ensure
1642 has_expanded_set: has_expanded
1643 end
1644
1645 set_is_in_system (v: BOOLEAN) is
1646 -- Set `is_in_system' to `v'.
1647 require
1648 not_precompiling: not Compilation_modes.is_precompiling
1649 do
1650 is_in_system := v
1651 ensure
1652 is_in_system_set: is_in_system = v
1653 end
1654
1655 set_is_used_as_expanded is
1656 do
1657 is_used_as_expanded := True
1658 ensure
1659 is_used_as_expanded_set: is_used_as_expanded
1660 end
1661
1662 set_invariant_feature (f: INVARIANT_FEAT_I) is
1663 -- Set `invariant_feature' with `f'.
1664 do
1665 invariant_feature := f
1666 ensure
1667 invariant_feature_set: invariant_feature = f
1668 end
1669
1670 set_skeleton (s: GENERIC_SKELETON) is
1671 -- Assign `s' to `skeleton'.
1672 do
1673 skeleton := s
1674 ensure
1675 skeleton_set: skeleton = s
1676 end
1677
1678 set_convert_to (c: like convert_to) is
1679 -- Assign `c' to `convert_to'.
1680 do
1681 convert_to := c
1682 ensure
1683 convert_to_set: convert_to = c
1684 end
1685
1686 set_convert_from (c: like convert_from) is
1687 -- Assign `c' to `convert_from'.
1688 do
1689 convert_from := c
1690 ensure
1691 convert_from_set: convert_from = c
1692 end
1693
1694 set_creators (c: like creators) is
1695 -- Assign `c' to `creators'.
1696 do
1697 creators := c
1698 ensure
1699 creators_set: creators = c
1700 end
1701
1702 set_visible_table_size (i: INTEGER) is
1703 -- Assign `i' to `visible_table_size'
1704 require
1705 i_positive: i >= 0
1706 do
1707 visible_table_size := i
1708 ensure
1709 visible_table_size_set: visible_table_size = i
1710 end
1711
1712 set_is_single (v: BOOLEAN) is
1713 -- Set `is_single' with `v'
1714 do
1715 is_single := v
1716 ensure
1717 is_single_set: is_single = v
1718 end
1719
1720 add_descendant (c: CLASS_C) is
1721 -- Insert class `c' into the descendant list
1722 require
1723 good_argument: c /= Void
1724 local
1725 desc: like descendants
1726 do
1727 desc := descendants
1728 if not desc.has (c) then
1729 desc.extend (c)
1730 end
1731 ensure
1732 inserted: descendants.has (c)
1733 end
1734
1735 external_name: STRING is
1736 -- External name
1737 local
1738 l_vis: EQUALITY_TUPLE [TUPLE [class_renamed: STRING; features: EQUALITY_HASH_TABLE [STRING, STRING]]]
1739 do
1740 l_vis := lace_class.visible
1741 if l_vis /= Void then
1742 Result := l_vis.item.class_renamed
1743 else
1744 Result := name
1745 end
1746 ensure
1747 external_name_not_void: Result /= Void
1748 external_name_in_upper: Result.as_upper.is_equal (Result)
1749 end
1750
1751 assertion_level: ASSERTION_I is
1752 -- Assertion level of the class
1753 do
1754 if System.in_final_mode then
1755 -- In final mode we do not generate assertions
1756 -- if the dead code remover is on.
1757 if not System.keep_assertions then
1758 create Result
1759 else
1760 Result := lace_class.assertion_level
1761 end
1762 else
1763 Result := lace_class.assertion_level
1764 end
1765 ensure
1766 assertion_level_not_void: Result /= Void
1767 end
1768
1769 trace_level: OPTION_I is
1770 -- Trace level of the class
1771 do
1772 Result := lace_class.trace_level
1773 end
1774
1775 profile_level: OPTION_I is
1776 -- Profile level of the class
1777 do
1778 Result := lace_class.profile_level
1779 end
1780
1781 optimize_level: OPTIMIZE_I is
1782 -- Optimization level
1783 do
1784 Result := lace_class.optimize_level
1785 end
1786
1787 debug_level: DEBUG_I is
1788 -- Debug level
1789 do
1790 Result := lace_class.debug_level
1791 end
1792
1793 visible_level: VISIBLE_I is
1794 -- Visible level
1795 do
1796 Result := lace_class.visible_level
1797 end
1798
1799 is_full_class_checking: BOOLEAN is
1800 -- Do we perform a flat checking on the calss, i.e. checking
1801 -- inherited routines in the context of the descendant class?
1802 do
1803 Result := lace_class.is_full_class_checking
1804 end
1805
1806 is_cat_call_detection: BOOLEAN is
1807 -- Do we perform cat-call detection on all feature calls?
1808 do
1809 Result := lace_class.is_cat_call_detection
1810 end
1811
1812 feature -- Actual class type
1813
1814 constraint_actual_type: CL_TYPE_A is
1815 -- Actual type of class where all formals are replaced by their constraint.
1816 local
1817 i, count: INTEGER
1818 actual_generic: ARRAY [TYPE_A]
1819 do
1820 if generics = Void then
1821 Result := actual_type
1822 else
1823 from
1824 i := 1
1825 count := generics.count
1826 create actual_generic.make (1, count)
1827 create {GEN_TYPE_A} Result.make (class_id, actual_generic)
1828 until
1829 i > count
1830 loop
1831 actual_generic.put (constraints (i), i)
1832 i := i + 1
1833 end
1834 end
1835 ensure
1836 constraint_actual_type_not_void: Result /= Void
1837 end
1838
1839 actual_type: CL_TYPE_A is
1840 -- Actual type of the class
1841 local
1842 i, nb: INTEGER
1843 actual_generic: ARRAY [FORMAL_A]
1844 formal: FORMAL_A
1845 l_formal_dec: FORMAL_CONSTRAINT_AS
1846 do
1847 if generics = Void then
1848 create Result.make (class_id)
1849 else
1850 from
1851 i := 1
1852 nb := generics.count
1853 create actual_generic.make (1, nb)
1854 create {GEN_TYPE_A} Result.make (class_id, actual_generic)
1855 until
1856 i > nb
1857 loop
1858 l_formal_dec ?= generics.i_th (i)
1859 check l_formal_dec_not_void: l_formal_dec /= Void end
1860 create formal.make (l_formal_dec.is_reference, l_formal_dec.is_expanded, i)
1861 actual_generic.put (formal, i)
1862 i := i + 1
1863 end
1864 end
1865 ensure
1866 actual_type_not_void: Result /= Void
1867 end
1868
1869 feature {TYPE_AS, AST_TYPE_A_GENERATOR, AST_FEATURE_CHECKER_GENERATOR} -- Actual class type
1870
1871 partial_actual_type (gen: ARRAY [TYPE_A]; is_exp, is_sep, is_mono: BOOLEAN): CL_TYPE_A is
1872 -- Actual type of `current depending on the context in which it is declared
1873 -- in CLASS_TYPE_AS. That is to say, it could have generics `gen' but not
1874 -- be a generic class. It simplifies creation of `CL_TYPE_A' instances in
1875 -- CLASS_TYPE_AS when trying to resolve types, by using dynamic binding
1876 -- rather than if statements.
1877 require
1878 is_exp_set: is_exp implies (not is_sep)
1879 is_sep_set: is_sep implies (not is_exp)
1880 do
1881 if gen /= Void then
1882 create {GEN_TYPE_A} Result.make (class_id, gen)
1883 else
1884 create Result.make (class_id)
1885 end
1886 if is_exp then
1887 Result.set_expanded_mark
1888 elseif is_sep then
1889 Result.set_separate_mark
1890 end
1891 if is_expanded then
1892 Result.set_expanded_class_mark
1893 elseif is_mono then
1894 Result.set_monomorph_mark
1895 end
1896 ensure
1897 actual_type_not_void: Result /= Void
1898 end
1899
1900 feature -- Incrementality
1901
1902 insert_changed_feature (feature_name_id: INTEGER) is
1903 -- Insert feature `feature_name_id' in `changed_features'.
1904 require
1905 good_argument: feature_name_id > 0
1906 do
1907 debug ("ACTIVITY")
1908 io.error.put_string ("CLASS_C: ")
1909 io.error.put_string (name)
1910 io.error.put_string ("%NChanged_feature: ")
1911 io.error.put_string (Names_heap.item (feature_name_id))
1912 io.error.put_new_line
1913 end
1914 changed_features.put (feature_name_id)
1915 end
1916
1917 constraint (i: INTEGER): TYPE_A is
1918 -- I-th constraint of the class
1919 require
1920 generics_exists: is_generic
1921 valid_index: generics.valid_index (i)
1922 not_is_multi_constraint: not generics.i_th (i).has_multi_constraints
1923 local
1924 l_formal_dec: FORMAL_CONSTRAINT_AS
1925 do
1926 l_formal_dec ?= generics.i_th (i)
1927 check l_formal_dec_not_void: l_formal_dec /= Void end
1928 Result := l_formal_dec.constraint_type (Current).type
1929 ensure
1930 constraint_not_void: Result /= Void
1931 end
1932
1933 constraint_if_possible (i: INTEGER): TYPE_A is
1934 -- I-th constraint of the class
1935 require
1936 generics_exists: is_generic
1937 valid_index: generics.valid_index (i)
1938 not_is_multi_constraint: not generics.i_th (i).has_multi_constraints
1939 local
1940 l_formal_dec: FORMAL_CONSTRAINT_AS
1941 l_result: RENAMED_TYPE_A [TYPE_A]
1942 do
1943 l_formal_dec ?= generics.i_th (i)
1944 check l_formal_dec_not_void: l_formal_dec /= Void end
1945 l_result := l_formal_dec.constraint_type_if_possible (Current)
1946 if l_result /= Void then
1947 Result := l_result.type
1948 end
1949 end
1950
1951 constraints (i: INTEGER): TYPE_SET_A is
1952 -- I-th constraint set of the class
1953 require
1954 generics_exists: is_generic
1955 valid_index: generics.valid_index (i)
1956 local
1957 l_formal_dec: FORMAL_CONSTRAINT_AS
1958 do
1959 -- Fixme: Should we store computation of `constraint_types'?
1960 l_formal_dec ?= generics.i_th (i)
1961 check l_formal_dec_not_void: l_formal_dec /= Void end
1962 Result := l_formal_dec.constraint_types (Current)
1963 ensure
1964 constraint_not_void: Result /= Void
1965 end
1966
1967 constraints_if_possible (i: INTEGER): TYPE_SET_A is
1968 -- I-th constraint set of the class
1969 require
1970 generics_exists: is_generic
1971 valid_index: generics.valid_index (i)
1972 local
1973 l_formal_dec: FORMAL_CONSTRAINT_AS
1974 do
1975 -- Fixme: Should we store computation of `constraint_types_if_possible'?
1976 l_formal_dec ?= generics.i_th (i)
1977 check l_formal_dec_not_void: l_formal_dec /= Void end
1978 Result := l_formal_dec.constraint_types_if_possible (Current)
1979 ensure
1980 constraint_not_void: Result /= Void
1981 end
1982
1983 constrained_type (a_formal_position: INTEGER): TYPE_A
1984 -- Constraint of Current.
1985 --
1986 -- `a_formal_position' is the position of the formal whose constraint is returned.
1987 -- Warning: Result is cached, do not modify it.
1988 require
1989 is_generic: is_generic
1990 valid_formal_position: is_valid_formal_position (a_formal_position)
1991 not_multi_constraint: not generics [a_formal_position].is_multi_constrained (generics)
1992 local
1993 l_formal_type: FORMAL_A
1994 l_recursion_break: SPECIAL [BOOLEAN]
1995 l_break: BOOLEAN
1996 l_formal_type_position: INTEGER
1997 do
1998 Result := constrained_type_cache [a_formal_position - 1]
1999 if Result = Void then
2000 create l_recursion_break.make (generics.count + 1)
2001 from
2002 Result := constraint (a_formal_position)
2003 until
2004 not Result.is_formal or l_break
2005 loop
2006 l_formal_type ?= Result
2007 check l_formal_type_not_void: l_formal_type /= Void end
2008 l_formal_type_position := l_formal_type.position
2009 check valid_formal_position: is_valid_formal_position (l_formal_type_position) end
2010 l_break := l_recursion_break [l_formal_type_position]
2011 l_recursion_break [l_formal_type_position] := True
2012 Result := constraint (l_formal_type_position)
2013 end
2014 if l_break then
2015 Result := any_type
2016 end
2017 constrained_type_cache [a_formal_position - 1] := Result
2018 end
2019 ensure
2020 Result_not_void: Result /= Void
2021 Result_is_named_but_not_formal: (Result.is_none or Result.is_named_type) and not Result.is_formal
2022 end
2023
2024 constrained_types (a_formal_position: INTEGER): TYPE_SET_A
2025 -- Constrained types of Current.
2026 --
2027 -- `a_context_class' is the context class where the formal occurs in.
2028 --| It is a list of class types which constraint the current Formal.
2029 -- Warning: Result is cached, do not modify it.
2030 require
2031 valid_formal_position: is_valid_formal_position (a_formal_position)
2032 do
2033 Result ?= constrained_types_cache [a_formal_position - 1]
2034 if Result = Void then
2035 Result := constraints (a_formal_position).constraining_types (Current)
2036 constrained_types_cache [a_formal_position - 1] := Result
2037 end
2038 ensure
2039 Result_not_void_and_not_empty: Result /= Void and not Result.is_empty
2040 end
2041
2042 update_instantiator1 is
2043 -- Ensure that parents classes have a proper generic derivation
2044 -- matching needs of current class which has syntactically
2045 -- been changed.
2046 require
2047 is_syntactically_changed: changed
2048 parents_not_void: parents /= Void
2049 local
2050 parent_type: CL_TYPE_A
2051 l_area: SPECIAL [CL_TYPE_A]
2052 i, nb: INTEGER
2053 do
2054 from
2055 l_area := parents.area
2056 nb := parents.count
2057 until
2058 i = nb
2059 loop
2060 parent_type := l_area.item (i)
2061 -- Because inheritance clause does not care about expanded
2062 -- status, we remove it in case parent class is by default
2063 -- expanded.
2064 if parent_type.is_expanded then
2065 parent_type := parent_type.reference_type
2066 end
2067 Instantiator.dispatch (parent_type, Current)
2068 i := i + 1
2069 end
2070 end
2071
2072 init_types is
2073 -- Standard initialization of attribute `types' for non
2074 -- generic classes.
2075 require
2076 no_generic: not is_generic
2077 local
2078 data: CL_TYPE_I
2079 do
2080 data := actual_type.type_i
2081 register_type (data).do_nothing
2082 instantiator.dispatch (data.type_a, Current)
2083 if data.is_expanded and then not data.is_external or else data.is_basic then -- and then not data.is_char then
2084 -- Process reference counterpart.
2085 data := data.reference_type
2086 register_type (data).do_nothing
2087 instantiator.dispatch (data.type_a, Current)
2088 end
2089 end
2090
2091 update_types (data: CL_TYPE_I) is
2092 -- Update `types' with `data'.
2093 require
2094 good_argument: data /= Void
2095 consistency: data.base_class = Current
2096 good_context:
2097 (data.base_class.original_class /= system.native_array_class and then
2098 data.base_class.original_class /= system.typed_pointer_class) implies
2099 not data.has_formal
2100 local
2101 new_class_type: CLASS_TYPE
2102 do
2103 if not derivations.has_derivation (class_id, data) then
2104 -- The recursive update is done only once
2105 derivations.insert_derivation (class_id, data)
2106
2107 debug ("GENERICITY")
2108 io.error.put_string ("Update_types%N")
2109 io.error.put_string (name)
2110 data.trace
2111 end
2112 new_class_type := register_type (data)
2113
2114 if data.is_expanded and then not data.is_external then
2115 -- Process reference counterpart.
2116 update_types (data.reference_type)
2117 end
2118
2119 -- Propagation along the filters since we have a new type
2120 update_filter_types (new_class_type)
2121 if new_class_type.is_expanded then
2122 -- Propagate to all parent filters to ensure that
2123 -- all the required class types are registered
2124 -- for generating this expanded class type
2125 from
2126 parents_classes.start
2127 until
2128 parents_classes.after
2129 loop
2130 parents_classes.item.update_filter_anchored_types (new_class_type)
2131 parents_classes.forth
2132 end
2133 end
2134 end
2135 end
2136
2137 feature {NONE} -- Incrementality
2138
2139 derivations: DERIVATIONS is
2140 once
2141 Result := instantiator.derivations
2142 ensure
2143 derivations_not_void: Result /= Void
2144 end
2145
2146 register_type (data: CL_TYPE_I): CLASS_TYPE is
2147 -- Ensure that `data' has an associated class type by creating
2148 -- a new class type descriptor if it is not already created;
2149 -- return the associated class type.
2150 require
2151 data_not_void: data /= Void
2152 local
2153 g: GEN_TYPE_I
2154 do
2155 if data.meta_generic /= Void then
2156 -- Register this generic type and other required types.
2157 g ?= data
2158 Result := register_generic_type (g, g.meta_generic.count)
2159 elseif types.has_type (data) then
2160 Result := types.found_item
2161 else
2162 -- Found a new type for the class
2163 Result := register_new_type (data)
2164 end
2165 ensure
2166 result_not_void: Result /= Void
2167 data_is_registered: types.has_type (data)
2168 end
2169
2170 register_new_type (data: CL_TYPE_I): CLASS_TYPE is
2171 -- Register new type `data' and return the corresponding descriptor.
2172 require
2173 data_attached: data /= Void
2174 data_is_new: not types.has_type (data)
2175 do
2176 debug ("GENERICITY")
2177 io.error.put_string ("new type%N")
2178 end
2179 Result := new_type (normalized_type_i (data))
2180 -- If the $ operator is used in the class,
2181 -- an encapsulation of the feature must be generated
2182 if System.address_table.class_has_dollar_operator (class_id) then
2183 System.request_freeze
2184 end
2185 -- Mark the class `changed4' because there is a new type
2186 changed4 := True
2187 Degree_2.insert_new_class (Current)
2188 -- Insertion of the new class type
2189 types.extend (Result)
2190 System.insert_class_type (Result)
2191 ensure
2192 result_attached: Result /= Void
2193 data_is_registered: types.has_type (data)
2194 end
2195
2196 register_generic_type (data: GEN_TYPE_I; n: INTEGER): CLASS_TYPE is
2197 -- Ensure that `data' has an associated class type by creating
2198 -- a new class type descriptor if it is not already created;
2199 -- return the associated class type. Register all the types
2200 -- required by this type for code generation.
2201 local
2202 g: GEN_TYPE_I
2203 t: ARRAY [TYPE_I]
2204 p: TYPE_I
2205 c: CL_TYPE_I
2206 i: INTEGER
2207 a: NATIVE_ARRAY_TYPE_I
2208 r: GEN_TYPE_I
2209 do
2210 if types.has_type (data) then
2211 Result := types.found_item
2212 else
2213 -- Found a new type for the class
2214 Result := register_new_type (data)
2215 r ?= Result.type
2216 check
2217 r_attached: r /= Void
2218 end
2219 a ?= r
2220 -- if False then
2221 -- -- TODO: see GEN_TYPE_I.enumerate_interfaces
2222 if a = Void and then system.is_precompiled then
2223 -- Register all types where expanded parameters are replaced with reference ones.
2224 t := r.true_generics
2225 from
2226 i := n
2227 until
2228 i <= 0
2229 loop
2230 p := t [i]
2231 if p.is_expanded then
2232 g := r.duplicate
2233 c ?= p
2234 check
2235 c_attached: c /= Void
2236 end
2237 g.true_generics [i] := c.reference_type
2238 g.meta_generic [i] := reference_c_type
2239 register_generic_type (g, i - 1).do_nothing
2240 update_types (g)
2241 end
2242 i := i - 1
2243 end
2244 end
2245 end
2246 end
2247
2248 normalized_type_i (data: CL_TYPE_I): CL_TYPE_I is
2249 -- Class type `data' normalized in terms of the current class.
2250 require
2251 data_not_void: data /= Void
2252 do
2253 Result := data
2254 ensure
2255 result_not_void: Result /= Void
2256 end
2257
2258 new_type (data: CL_TYPE_I): CLASS_TYPE is
2259 -- New class type for current class
2260 do
2261 create Result.make (data)
2262 if already_compiled then
2263 -- Melt all the code written in the associated class of the new class type
2264 melt_all
2265 end
2266 ensure
2267 new_type_not_void: Result /= Void
2268 end
2269
2270 update_filter_types (new_class_type: CLASS_TYPE) is
2271 -- Update all types associated with `filters' using `new_class_type'.
2272 require
2273 new_class_type_not_void: new_class_type /= Void
2274 filters_not_void: filters /= Void
2275 local
2276 class_filters: like filters
2277 filter: CL_TYPE_I
2278 class_filters_cursor: CURSOR
2279 do
2280 class_filters := filters
2281 -- Propagation along the filters since we have a new type
2282 -- Clean the filters. Some of the filters can be obsolete
2283 -- if the base class has been removed from the system
2284 class_filters.clean
2285 from
2286 class_filters.start
2287 until
2288 class_filters.after
2289 loop
2290 -- We need to store cursor position because when you
2291 -- have an expanded class used as a reference or vice versa
2292 -- and that this class has some `like Current' then
2293 -- we are going to traverse recursively the `filters' list.
2294 class_filters_cursor := class_filters.cursor
2295 -- Instantiation of the filter with `data'
2296 filter := class_filters.item.instantiation_in (new_class_type)
2297 debug ("GENERICITY")
2298 io.error.put_string ("Propagation of ")
2299 filter.trace
2300 io.error.put_string ("propagation to ")
2301 io.error.put_string (filter.base_class.name)
2302 io.error.put_new_line
2303 end
2304 if filter.has_formal implies
2305 (filter.base_class.original_class = system.native_array_class or else
2306 filter.base_class.original_class = system.typed_pointer_class)
2307 then
2308 filter.base_class.update_types (filter)
2309 end
2310 class_filters.go_to (class_filters_cursor)
2311 class_filters.forth
2312 end
2313 end
2314
2315 feature {CLASS_C} -- Incrementality
2316
2317 update_filter_anchored_types (new_class_type: CLASS_TYPE) is
2318 -- Update all anchored types associated with `filters' using `new_class_type'.
2319 require
2320 new_class_type_not_void: new_class_type /= Void
2321 new_class_type_is_expanded: new_class_type.is_expanded
2322 filters_not_void: filters /= Void
2323 local
2324 class_filters: like filters
2325 filter: CL_TYPE_I
2326 class_filters_cursor: CURSOR
2327 do
2328 class_filters := filters
2329 -- Propagation along the filters since we have a new type
2330 -- Clean the filters. Some of the filters can be obsolete
2331 -- if the base class has been removed from the system
2332 class_filters.clean
2333 from
2334 class_filters.start
2335 until
2336 class_filters.after
2337 loop
2338 -- We need to store cursor position because when you
2339 -- have an expanded class used as a reference or vice versa
2340 -- and that this class has some `like Current' then
2341 -- we are going to traverse recursively the `filters' list.
2342 class_filters_cursor := class_filters.cursor
2343 -- Instantiation of the filter with `data'
2344 filter := class_filters.item.anchor_instantiation_in (new_class_type)
2345 if
2346 (filter.base_class.original_class /= system.native_array_class and then
2347 filter.base_class.original_class /= system.typed_pointer_class) implies
2348 not filter.has_formal
2349 then
2350 debug ("GENERICITY")
2351 io.error.put_string ("Propagation of ")
2352 filter.trace
2353 io.error.put_string ("propagation to ")
2354 io.error.put_string (filter.base_class.name)
2355 io.error.put_new_line
2356 end
2357 filter.base_class.update_types (filter)
2358 end
2359 class_filters.go_to (class_filters_cursor)
2360 class_filters.forth
2361 end
2362 end
2363
2364 feature -- Meta-type
2365
2366 meta_type (class_type: CLASS_TYPE): CLASS_TYPE is
2367 -- Associated class type of Current class in the context
2368 -- of descendant type `class_type'.
2369 require
2370 good_argument: class_type /= Void
2371 conformance: class_type.associated_class.conform_to (Current)
2372 local
2373 actual_class_type, written_actual_type: CL_TYPE_A
2374 do
2375 if class_type.type.class_id = class_id then
2376 -- Use supplied `class_type' to preserve expandedness status, generic parameters, etc.
2377 Result := class_type
2378 elseif generics = Void then
2379 -- No instantiation for non-generic class
2380 Result := types.first
2381 else
2382 actual_class_type := class_type.associated_class.actual_type
2383 -- General instantiation of the actual class type where
2384 -- the feature is written in the context of the actual
2385 -- type of the base class of `class_type'.
2386 written_actual_type ?= actual_type.instantiation_in
2387 (actual_class_type, class_id)
2388 if written_actual_type.is_expanded then
2389 -- Ancestors are always reference types.
2390 written_actual_type := written_actual_type.reference_type
2391 end
2392 -- Ask for the meta-type
2393 Result := written_actual_type.type_i.instantiation_in (class_type).associated_class_type
2394 end
2395 ensure
2396 meta_type_not_void: Result /= Void
2397 end
2398
2399 feature -- Validity class
2400
2401 check_validity is
2402 -- Special classes validity check.
2403 local
2404 l_feature: FEATURE_I
2405 do
2406 if System.any_class = original_class then
2407 -- We are checking ANY.
2408 l_feature := feature_table.item_id (names_heap.Internal_correct_mismatch_name_id)
2409 if
2410 l_feature = Void or else
2411 not l_feature.is_routine or l_feature.argument_count > 0
2412 then
2413 error_handler.insert_error (
2414 create {SPECIAL_ERROR}.make ("Class ANY must have a procedure `internal_correct_mismatch' with no arguments", Current))
2415 end
2416 l_feature := feature_table.item_id (names_heap.equal_name_id)
2417 if
2418 l_feature = Void or else
2419 l_feature.argument_count /= 2 or else
2420 not l_feature.arguments.i_th (1).actual_argument_type (l_feature.arguments).is_reference or else
2421 not l_feature.arguments.i_th (2).actual_argument_type (l_feature.arguments).is_reference or else
2422 not l_feature.type.is_boolean
2423 then
2424 error_handler.insert_error (
2425 create {SPECIAL_ERROR}.make ("Class ANY must have a boolean query `equal' with 2 reference arguments", Current))
2426 end
2427 l_feature := feature_table.item_id (names_heap.twin_name_id)
2428 if
2429 l_feature = Void or else
2430 not l_feature.is_routine or else l_feature.argument_count > 0 or else l_feature.type.is_expanded
2431 then
2432 error_handler.insert_error (
2433 create {SPECIAL_ERROR}.make ("Class ANY must have a function `twin' with no arguments", Current))
2434 end
2435 end
2436 end
2437
2438 feature -- default_rescue routine
2439
2440 default_rescue_feature: FEATURE_I is
2441 -- The version of `default_rescue' from ANY.
2442 -- Void if ANY has not been compiled yet or
2443 -- does not possess the feature.
2444 require
2445 has_feature_table: has_feature_table
2446 any_class_compiled: System.any_class /= Void
2447 do
2448 Result := feature_table.feature_of_rout_id (System.default_rescue_id)
2449 end
2450
2451 feature -- default_create routine
2452
2453 default_create_feature : FEATURE_I is
2454 -- The version of `default_create' from ANY.
2455 -- Void if ANY has not been compiled yet or
2456 -- does not posess the feature or class is deferred.
2457 require
2458 has_feature_table: has_feature_table
2459 do
2460 Result := feature_table.feature_of_rout_id (System.default_create_id)
2461 end
2462
2463 allows_default_creation : BOOLEAN is
2464 -- Can an instance of this class be
2465 -- created with 'default_create'?
2466 require
2467 has_feature_table: has_feature_table
2468 local
2469 dcr_feat : FEATURE_I
2470 do
2471 -- Answer is NO if class is deferred
2472 if not is_deferred then
2473 dcr_feat := default_create_feature
2474 -- Answer is NO if the class has no
2475 -- 'default_create'
2476 Result := dcr_feat /= Void and then (
2477 (creators = Void) or else (not creators.is_empty and then creators.has (dcr_feat.feature_name)))
2478 end
2479 end
2480
2481 feature -- Dead code removal
2482
2483 mark_visible (remover: REMOVER) is
2484 -- Dead code removal from the visible features
2485 require
2486 visible_level.has_visible
2487 do
2488 visible_level.mark_visible (remover, feature_table)
2489 end
2490
2491 has_visible: BOOLEAN is
2492 -- Has the class some visible features
2493 do
2494 Result := visible_level.has_visible
2495 end
2496
2497 visible_table_size: INTEGER
2498 -- Size of hash table for visible features of Current class.
2499
2500 feature -- Cecil
2501
2502 generate_cecil (generated_wrappers: DS_HASH_SET [STRING]) is
2503 -- Generate cecil table for a class having visible features
2504 require
2505 has_visible: has_visible
2506 generated_wrappers_attached: generated_wrappers /= Void
2507 do
2508 -- Reset hash-table size which will be computed during
2509 -- generation.
2510 set_visible_table_size (0)
2511 visible_level.generate_cecil_table (Current, generated_wrappers)
2512 end
2513
2514 feature -- Invariant feature
2515
2516 has_invariant: BOOLEAN is
2517 -- Has the current class an invariant clause ?
2518 do
2519 Result := invariant_feature /= Void
2520 end
2521
2522 feature -- Process the creation feature
2523
2524 process_creation_feature is
2525 -- Assign `default_create' creation procedure (if applicable) to
2526 -- `creation_feature'.
2527 require
2528 has_feature_table: has_feature_table
2529 do
2530 if allows_default_creation then
2531 creation_feature := default_create_feature
2532 else
2533 creation_feature := Void
2534 end
2535 end
2536
2537 insert_changed_assertion (a_feature: FEATURE_I) is
2538 -- Insert `a_feature' in the melted set
2539 do
2540 add_feature_to_melted_set (a_feature)
2541 Degree_1.insert_class (Current)
2542 end
2543
2544 feature {NONE} -- Implementation
2545
2546 add_feature_to_melted_set (f: FEATURE_I) is
2547 local
2548 melt_set: like melted_set
2549 melted_info: MELTED_INFO
2550 do
2551 melt_set := melted_set
2552 if melt_set = Void then
2553 create melt_set.make (melted_set_chunk)
2554 melted_set := melt_set
2555 end
2556
2557 if f = invariant_feature then
2558 create {INV_MELTED_INFO} melted_info.make (f, Current)
2559 else
2560 create {FEAT_MELTED_INFO} melted_info.make (f, Current)
2561 end
2562 melt_set.force (melted_info)
2563 end
2564
2565 Melted_set_chunk: INTEGER is 20
2566 -- Size of `melted_set' which contains melted features.
2567
2568 feature -- Initialization
2569
2570 initialize (l: like original_class) is
2571 -- Initialization of Current.
2572 require
2573 good_argument: l /= Void
2574 do
2575 original_class := l
2576 l.set_compiled_class (Current)
2577
2578 -- Set `is_class_any' and `is_class_none'
2579 is_class_any := name.is_equal ("ANY")
2580 is_class_none := name.is_equal ("NONE")
2581 -- Creation of the descendant list
2582 create descendants.make (10)
2583 -- Creation of the supplier list
2584 create suppliers.make (2)
2585 -- Creation of the client list
2586 create clients.make (10)
2587 -- Types list creation
2588 create types.make (1)
2589 end
2590
2591 feature -- Properties
2592
2593 original_class: CLASS_I
2594 -- Original lace class
2595 --
2596 -- See `lace_class' for example.
2597
2598 lace_class: like original_class is
2599 -- Lace class (takes overriding into account)
2600 --
2601 -- e.g. Class in cluster c1 and in override o1
2602 --
2603 -- c1.compiled_class = Current
2604 -- o1.compiled_class = Void
2605 -- Current.lace_class = o1
2606 -- Current.original_class = c1
2607 do
2608 Result := original_class.actual_class
2609 end
2610
2611 main_parent: CLASS_C
2612 -- Parent of current class which has most features.
2613
2614 number_of_features: INTEGER
2615 -- Number of features in current class including inherited one.
2616
2617 parents_classes: FIXED_LIST [CLASS_C]
2618 -- Parent classes
2619
2620 need_new_parents: BOOLEAN
2621 -- Does Current need to recompute `parents' and `computed_parents'?
2622
2623 parents: FIXED_LIST [CL_TYPE_A]
2624 -- Parent class types
2625
2626 computed_parents: PARENT_LIST
2627 -- Computed version of parent clauses.
2628
2629 descendants: ARRAYED_LIST [CLASS_C]
2630 -- Direct descendants of the current class
2631
2632 clients: ARRAYED_LIST [CLASS_C]
2633 -- Clients of the class
2634
2635 suppliers: SUPPLIER_LIST
2636 -- Suppliers of the class in terms of calls
2637 -- [Useful for incremental type check].
2638
2639 generics: EIFFEL_LIST [FORMAL_DEC_AS]
2640 -- Formal generical parameters
2641
2642 generic_features: HASH_TABLE [TYPE_FEATURE_I, INTEGER]
2643 -- Collect all possible generic derivations inherited or current.
2644 -- Indexed by `rout_id' of formal generic parmater.
2645 -- Updated during `pass2' of INHERIT_TABLE.
2646
2647 anchored_features: like generic_features
2648 -- Collect all features that are used for creating or doing an assignment
2649 -- attempt in current or in an inherited class.
2650 -- Indexed by `rout_id' of feature on which anchor is done.
2651 -- Updated before each IL code generation.
2652
2653 type_set: SEARCH_TABLE [INTEGER]
2654 -- Set of routine IDs used for anchored type in current class.
2655 -- It does not take into accounts inherited one.
2656
2657 topological_id: INTEGER
2658 -- Unique number for a class. Could change during a topological
2659 -- sort on classes.
2660
2661 is_deferred: BOOLEAN
2662 -- Is class deferred ?
2663
2664 is_interface: BOOLEAN
2665 -- Is class an interface for IL code generation?
2666
2667 is_expanded: BOOLEAN
2668 -- Is class expanded?
2669
2670 is_enum: BOOLEAN
2671 -- Is class an IL enum type?
2672 -- Useful to perform call optimization on enum type in FEATURE_B.
2673
2674 is_basic: BOOLEAN is
2675 -- Is class basic?
2676 do
2677 end
2678
2679 is_single: BOOLEAN
2680 -- Is class generated as a single entity in IL code generation.
2681
2682 has_external_main_parent: BOOLEAN
2683 -- Is one non-external parent class generated as a single IL type?
2684
2685 is_frozen: BOOLEAN is
2686 -- Is class frozen, ie we cannot inherit from it?
2687 do
2688 Result := internal_is_frozen or apply_msil_application_optimizations
2689 end
2690
2691 is_external: BOOLEAN
2692 -- Is class an external one?
2693 -- If yes, we do not generate it.
2694
2695 is_true_external: BOOLEAN is
2696 -- Is class an instance of EXTERNAL_CLASS_C?
2697 -- If yes, we do not generate it.
2698 do
2699 end
2700
2701 obsolete_message: STRING
2702 -- Obsolete message
2703 -- (Void if Current is not obsolete)
2704
2705 custom_attributes, class_custom_attributes, interface_custom_attributes: BYTE_LIST [BYTE_NODE]
2706 -- Associated custom attributes if any.
2707
2708 assembly_custom_attributes: BYTE_LIST [BYTE_NODE]
2709 -- Associated custom attributes for assembly if any.
2710
2711 name: STRING is
2712 -- Class name
2713 do
2714 Result := lace_class.name
2715 end
2716
2717 external_class_name: STRING is
2718 -- External class name.
2719 do
2720 if private_external_name /= Void then
2721 Result := private_external_name
2722 else
2723 Result := name
2724 end
2725 end
2726
2727 text: STRING is
2728 -- Class text
2729 require
2730 valid_file_name: file_name /= Void
2731 do
2732 Result := lace_class.text
2733 end
2734
2735 constraint_classes (a_formal_dec: FORMAL_DEC_AS) : ARRAY [CLASS_C] is
2736 -- Computed constraint classes for every formal of the current class.
2737 -- Only class types are put into this cache so every item in the cache is error free.
2738 -- All other positions are void especially those of formals.
2739 require
2740 a_formal_dec_not_void: a_formal_dec /= Void
2741 valid_formal: a_formal_dec.position <= generics.count
2742 local
2743 l_cache: like constraint_cache
2744 l_formal_cache: like formal_constraint_cache
2745 l_pos: INTEGER
2746 do
2747 -- Check if `constraint_cache' has been created.
2748 l_cache := constraint_cache
2749 if l_cache = Void then
2750 create l_cache.make (generics.count)
2751 constraint_cache := l_cache
2752 end
2753 -- Check if an entry for `a_formal_dec' was created.
2754 l_pos := a_formal_dec.position - 1
2755 l_formal_cache := l_cache.item (l_pos)
2756 if l_formal_cache /= Void then
2757 Result := l_formal_cache.constraint_classes
2758 -- Check if it is Void (case where `constraint_renaming'
2759 -- was already called for `a_formal_dec').
2760 if Result = Void then
2761 create Result.make (1, a_formal_dec.constraints.count)
2762 l_formal_cache.constraint_classes := Result
2763 end
2764 else
2765 -- Insert `a_formal_dec'.
2766 create Result.make (1, a_formal_dec.constraints.count)
2767 l_cache.put ([Result, Void], l_pos)
2768 end
2769 ensure
2770 constraint_classes_not_void: Result /= Void
2771 end
2772
2773 constraint_renaming (a_formal_dec: FORMAL_DEC_AS): ARRAY [RENAMING_A] is
2774 -- Computed renamings for every formal of the current class.
2775 -- Only sane renamings are put into this cache so every item in the cache is error free.
2776 -- All other positions are void especially those of formal constraints as they are not allowed to have renamings.
2777 require
2778 a_formal_dec_not_void: a_formal_dec /= Void
2779 local
2780 l_cache: like constraint_cache
2781 l_formal_cache: like formal_constraint_cache
2782 l_pos: INTEGER
2783 do
2784 -- Check if `constraint_cache' has been created.
2785 l_cache := constraint_cache
2786 if l_cache = Void then
2787 create l_cache.make (generics.count)
2788 constraint_cache := l_cache
2789 end
2790 -- Check if an entry for `a_formal_dec' was created.
2791 l_pos := a_formal_dec.position - 1
2792 l_formal_cache := l_cache.item (l_pos)
2793 if l_formal_cache /= Void then
2794 Result := l_formal_cache.constraint_renaming
2795 -- Check if it is Void (case where `constraint_classes'
2796 -- was already called for `a_formal_dec').
2797 if Result = Void then
2798 create Result.make (1, a_formal_dec.constraints.count)
2799 l_formal_cache.constraint_renaming := Result
2800 end
2801 else
2802 -- Insert `a_formal_dec'.
2803 create Result.make (1, a_formal_dec.constraints.count)
2804 l_cache.put ([Void, Result], l_pos)
2805 end
2806 ensure
2807 constraint_renaming_not_void: Result /= Void
2808 end
2809
2810 feature {NONE} -- Implementation: Properties
2811
2812 constraint_cache: SPECIAL [like formal_constraint_cache]
2813 -- To store computed information about generic constraints of Current.
2814
2815 formal_constraint_cache: TUPLE [
2816 constraint_classes: ARRAY [CLASS_C];
2817 constraint_renaming: ARRAY [RENAMING_A]]
2818 is
2819 -- For easy type checking of `constraint_cache'.
2820 do
2821 end
2822
2823 constrained_type_cache: SPECIAL [TYPE_A]
2824 -- Constraining type for each given formal, if there exists one
2825
2826 constrained_types_cache: SPECIAL [TYPE_SET_A]
2827 -- Constraining types for each given formal
2828 --| In case someone requests a type set for a single constraint this is just fine.
2829 --| That is why we have two caches.
2830
2831 feature -- IL code generation
2832
2833 il_data_name: STRING is
2834 -- IL class name of class data
2835 require
2836 not_is_external: not is_external
2837 local
2838 namespace: STRING
2839 class_name: STRING
2840 use_dotnet_naming: BOOLEAN
2841 do
2842 if is_precompiled then
2843 namespace := precompiled_namespace
2844 class_name := precompiled_class_name
2845 use_dotnet_naming := is_dotnet_naming
2846 else
2847 namespace := original_class.actual_namespace
2848 class_name := name.as_lower
2849 use_dotnet_naming := System.dotnet_naming_convention
2850 end
2851 Result := il_casing.type_name (namespace, data_prefix, class_name, use_dotnet_naming)
2852 ensure
2853 result_not_void: Result /= Void
2854 end
2855
2856 set_il_name is
2857 -- Store basic information that will help us reconstruct
2858 -- a complete name.
2859 require
2860 not_is_precompiled: not is_precompiled
2861 do
2862 is_dotnet_naming := System.dotnet_naming_convention
2863 precompiled_namespace := original_class.actual_namespace.twin
2864 precompiled_class_name := il_casing.type_name (Void, Void, name.as_lower, is_dotnet_naming)
2865 end
2866
2867 is_dotnet_naming: BOOLEAN
2868 -- Is current class being generated using dotnet naming convention?
2869
2870 feature {NONE} -- IL code generation
2871
2872 precompiled_namespace: STRING
2873 -- Namespace of this class when it is precompiled
2874
2875 precompiled_class_name: STRING
2876 -- Name of this class when it is precompiled
2877
2878 data_prefix: STRING is "Data"
2879 -- Prefix in a name of class data
2880
2881 feature -- status
2882
2883 hash_code: INTEGER is
2884 -- Hash code value corresponds to `class_id'.
2885 do
2886 Result := class_id
2887 end
2888
2889 feature {CLASS_I} -- Settings
2890
2891 set_original_class (cl: like original_class) is
2892 -- Assign `cl' to `lace_class'.
2893 require
2894 cl_not_void: cl /= Void
2895 cl_different_from_current_lace_class: cl /= original_class
2896 do
2897 original_class := cl
2898 ensure
2899 original_class_set: original_class = cl
2900 end
2901
2902 feature -- Access
2903
2904 has_multi_constraints (i: INTEGER): BOOLEAN is
2905 -- Does i-th generic parameter have multiple constraints?
2906 require
2907 has_generics: generics /= Void
2908 local
2909 l_formal_dec: FORMAL_CONSTRAINT_AS
2910 do
2911 l_formal_dec ?= generics.i_th (i)
2912 check l_formal_dec_not_void: l_formal_dec /= Void end
2913 Result := l_formal_dec.has_multi_constraints
2914 end
2915
2916 is_fully_deferred: BOOLEAN is
2917 -- Are parents of current class either ANY or a fully deferred class?
2918 -- Does current class contain only deferred features?
2919 require
2920 has_feature_table: has_feature_table
2921 parents_classes_not_void: parents_classes /= Void
2922 local
2923 feat: FEATURE_I
2924 feat_tbl: FEATURE_TABLE
2925 written_in: INTEGER
2926 par: like parents_classes
2927 do
2928 Result := True
2929 -- FIXME: Manu 1/21/2002: Test below is not the most correct one.
2930 if class_id > 1 then
2931 Result := is_deferred
2932 if Result then
2933 from
2934 par := parents_classes
2935 par.start
2936 until
2937 par.after or else not Result
2938 loop
2939 Result := Result and then par.item.is_fully_deferred
2940 par.forth
2941 end
2942 if Result then
2943 from
2944 written_in := class_id
2945 feat_tbl := feature_table
2946 feat_tbl.start
2947 until
2948 feat_tbl.after or else not Result
2949 loop
2950 feat := feat_tbl.item_for_iteration
2951 if feat.written_in = written_in then
2952 Result := Result and then feat.is_deferred
2953 end
2954 feat_tbl.forth
2955 end
2956 end
2957 end
2958 end
2959 end
2960
2961 name_in_upper: STRING is
2962 -- Class name in upper case
2963 do
2964 Result := name
2965 ensure
2966 name_in_upper_not_void: Result /= Void
2967 end
2968
2969 ast: CLASS_AS is
2970 -- Associated AST structure
2971 do
2972 if Tmp_ast_server.has (class_id) then
2973 Result := Tmp_ast_server.item (class_id)
2974 elseif Ast_server.has (class_id) then
2975 Result := Ast_server.item (class_id)
2976 end
2977 ensure
2978 non_void_result_if: has_ast implies Result /= Void
2979 end
2980
2981 invariant_ast: INVARIANT_AS is
2982 -- Associated invariant AST structure
2983 do
2984 if invariant_feature /= Void then
2985 Result := Inv_ast_server.item (class_id)
2986 end
2987 end
2988
2989 has_types: BOOLEAN is
2990 -- Are there any generic instantiations of Current
2991 -- in the system or is Current a non generic class?
2992 do
2993 Result := (types /= Void) and then (not types.is_empty)
2994 end
2995
2996 is_obsolete: BOOLEAN is
2997 -- Is Current feature obsolete?
2998 do
2999 Result := obsolete_message /= Void
3000 end
3001
3002 feature_with_name_id (a_feature_name_id: INTEGER): E_FEATURE is
3003 -- Feature whose internal name is `n'
3004 require
3005 valid_a_feature_name_id: a_feature_name_id > 0
3006 has_feature_table: has_feature_table
3007 local
3008 f: FEATURE_I
3009 do
3010 f := feature_table.item_id (a_feature_name_id)
3011 if f /= Void then
3012 Result := f.api_feature (class_id)
3013 end
3014 end
3015
3016 feature_with_id (a_feature_id: ID_AS): E_FEATURE is
3017 -- Feature whose internal name is `n'
3018 require
3019 valid_a_feature_id: a_feature_id /= Void
3020 has_feature_table: has_feature_table
3021 local
3022 f: FEATURE_I
3023 do
3024 f := feature_table.item_id (a_feature_id.name_id)
3025 if f /= Void then
3026 Result := f.api_feature (class_id)
3027 end
3028 end
3029
3030 feature_with_name (n: STRING): E_FEATURE is
3031 -- Feature whose internal name is `n'
3032 require
3033 valid_n: n /= Void
3034 has_feature_table: has_feature_table
3035 local
3036 f: FEATURE_I
3037 do
3038 f := feature_table.item (n)
3039 if f /= Void then
3040 Result := f.api_feature (class_id)
3041 end
3042 end
3043
3044 feature_with_rout_id (rout_id: INTEGER): E_FEATURE is
3045 -- Feature whose routine id `rout_id'.
3046 require
3047 valid_rout_id: rout_id /= 0
3048 has_feature_table: has_feature_table
3049 local
3050 feat: FEATURE_I
3051 do
3052 feat := feature_table.feature_of_rout_id (rout_id)
3053 if feat /= Void then
3054 Result := feat.api_feature (class_id)
3055 end
3056 end
3057
3058 feature_i_with_body_index (a_body_index: INTEGER): FEATURE_I is
3059 -- Feature whose body index is `a_body_index'.
3060 require
3061 a_body_index_non_negative: a_body_index >= 0
3062 has_feature_table: has_feature_table
3063 do
3064 Result := feature_table.feature_of_body_index (a_body_index)
3065 end
3066
3067 feature_with_body_index (a_body_index: INTEGER): E_FEATURE is
3068 -- Feature whose body index is `a_body_index'.
3069 require
3070 a_body_index_non_negative: a_body_index >= 0
3071 has_feature_table: has_feature_table
3072 local
3073 l_feat: FEATURE_I
3074 do
3075 l_feat := feature_table.feature_of_body_index (a_body_index)
3076 if l_feat /= Void then
3077 Result := l_feat.api_feature (class_id)
3078 end
3079 end
3080
3081 feature_with_feature_id (a_feature_id: INTEGER): E_FEATURE is
3082 -- Feature whose feature id `a_feature_id.
3083 require
3084 feature_id_non_negative: a_feature_id >= 0
3085 has_feature_table: has_feature_table
3086 local
3087 l_feat: FEATURE_I
3088 do
3089 l_feat := feature_table.feature_of_feature_id (a_feature_id)
3090 if l_feat /= Void then
3091 Result := l_feat.api_feature (class_id)
3092 end
3093 end
3094
3095 feature_of_rout_id (a_routine_id: INTEGER): FEATURE_I is
3096 -- Feature whose routine_id is `a_routine_id'.
3097 -- Look into `feature_table', `generic_features' and
3098 -- `anchored_features'.
3099 require
3100 rout_id_valid: a_routine_id > 0
3101 has_feature_table: has_feature_table
3102 local
3103 l_cursor: CURSOR
3104 l_anch: like anchored_features
3105 l_gen: like generic_features
3106 do
3107 Result := feature_table.feature_of_rout_id (a_routine_id)
3108 if Result = Void then
3109 l_anch := anchored_features
3110 if l_anch /= Void then
3111 from
3112 l_cursor := l_anch.cursor
3113 l_anch.start
3114 until
3115 l_anch.after or Result /= Void
3116 loop
3117 if l_anch.item_for_iteration.rout_id_set.has (a_routine_id) then
3118 Result := l_anch.item_for_iteration
3119 end
3120 l_anch.forth
3121 end
3122 l_anch.go_to (l_cursor)
3123 end
3124 l_gen := generic_features
3125 if Result = Void and l_gen /= Void then
3126 from
3127 l_cursor := l_gen.cursor
3128 l_gen.start
3129 until
3130 l_gen.after or Result /= Void
3131 loop
3132 if l_gen.item_for_iteration.rout_id_set.has (a_routine_id) then
3133 Result := l_gen.item_for_iteration
3134 end
3135 l_gen.forth
3136 end
3137 l_gen.go_to (l_cursor)
3138 end
3139 end
3140 end
3141
3142 feature_of_feature_id (a_feature_id: INTEGER): FEATURE_I is
3143 -- Feature whose feature_id is `a_feature_id'.
3144 -- Look into `feature_table', `generic_features' and
3145 -- `anchored_features'.
3146 require
3147 rout_id_valid: a_feature_id > 0
3148 has_feature_table: has_feature_table
3149 local
3150 l_cursor: CURSOR
3151 l_anch: like anchored_features
3152 l_gen: like generic_features
3153 do
3154 Result := feature_table.feature_of_feature_id (a_feature_id)
3155 if Result = Void then
3156 l_anch := anchored_features
3157 if l_anch /= Void then
3158 from
3159 l_cursor := l_anch.cursor
3160 l_anch.start
3161 until
3162 l_anch.after or Result /= Void
3163 loop
3164 if l_anch.item_for_iteration.feature_id = a_feature_id then
3165 Result := l_anch.item_for_iteration
3166 end
3167 l_anch.forth
3168 end
3169 l_anch.go_to (l_cursor)
3170 end
3171 l_gen := generic_features
3172 if Result = Void and l_gen /= Void then
3173 from
3174 l_cursor := l_gen.cursor
3175 l_gen.start
3176 until
3177 l_gen.after or Result /= Void
3178 loop
3179 if l_gen.item_for_iteration.feature_id = a_feature_id then
3180 Result := l_gen.item_for_iteration
3181 end
3182 l_gen.forth
3183 end
3184 l_gen.go_to (l_cursor)
3185 end
3186 end
3187 end
3188
3189 feature_of_name_id (a_name_id: INTEGER): FEATURE_I is
3190 -- Feature whose feature_id is `a_feature_id'.
3191 -- Look into `feature_table', `generic_features' and
3192 -- `anchored_features'.
3193 require
3194 a_name_id: a_name_id > 0
3195 has_feature_table: has_feature_table
3196 do
3197 Result := feature_table.item_id (a_name_id)
3198 end
3199
3200 api_feature_table: E_FEATURE_TABLE is
3201 -- Feature table for current class
3202 --| Can be Void when `feature_table' has not yet
3203 --| been computed (for example, error at degree 5).
3204 do
3205 if feature_table /= Void then
3206 Result := feature_table.api_table
3207 end
3208 end
3209
3210 once_functions: SORTED_TWO_WAY_LIST [E_FEATURE] is
3211 -- List of once functions.
3212 local
3213 f_table: FEATURE_TABLE
3214 feat: FEATURE_I
3215 cid: INTEGER
3216 do
3217 cid := class_id
3218 create Result.make
3219 f_table := feature_table
3220 from
3221 f_table.start
3222 until
3223 f_table.after
3224 loop
3225 feat := f_table.item_for_iteration
3226 if feat.is_once and then feat.is_function then
3227 Result.put_front (feat.api_feature (cid))
3228 end
3229 f_table.forth
3230 end
3231 Result.sort
3232 ensure
3233 non_void_result: Result /= Void
3234 result_sorted: Result.sorted
3235 end
3236
3237 once_routines: SORTED_TWO_WAY_LIST [E_FEATURE] is
3238 -- List of once features (functions and procedures).
3239 local
3240 f_table: FEATURE_TABLE
3241 feat: FEATURE_I
3242 cid: INTEGER
3243 do
3244 cid := class_id
3245 create Result.make
3246 f_table := feature_table
3247 from
3248 f_table.start
3249 until
3250 f_table.after
3251 loop
3252 feat := f_table.item_for_iteration
3253 if feat.is_once then
3254 Result.put_front (feat.api_feature (cid))
3255 end
3256 f_table.forth
3257 end
3258 Result.sort
3259 ensure
3260 non_void_result: Result /= Void
3261 result_sorted: Result.sorted
3262 end
3263
3264 is_valid: BOOLEAN is
3265 -- Is the current class valid?
3266 -- (After a compilation Current may become
3267 -- invalid)
3268 do
3269 Result := class_id > 0 and then lace_class.is_valid and then class_id <= System.classes.array_count
3270 and then System.class_of_id (class_id) = Current
3271 end
3272
3273 written_in_features: LIST [E_FEATURE] is
3274 -- List of features defined in current class
3275 require
3276 has_feature_table: has_feature_table
3277 do
3278 Result := feature_table.written_in_features
3279 ensure
3280 non_void_Result: Result /= Void
3281 end
3282
3283 is_class_any: BOOLEAN
3284 -- Is it class ANY?
3285
3286 is_class_none: BOOLEAN
3287 -- Is it class NONE?
3288
3289 feature -- Precompilation Access
3290
3291 is_precompiled: BOOLEAN is
3292 -- Is class precompiled?
3293 do
3294 Result := System.class_counter.is_precompiled (class_id)
3295 end
3296
3297 feature -- Server Access
3298
3299 has_ast: BOOLEAN is
3300 -- Does Current class have an AST structure?
3301 do
3302 Result := Ast_server.has (class_id) or else Tmp_ast_server.has (class_id)
3303 end
3304
3305 group: CONF_GROUP is
3306 -- Cluster to which the class belongs to
3307 do
3308 Result := lace_class.group
3309 ensure
3310 group_not_void: Result /= Void
3311 end
3312
3313 file_name: STRING is
3314 -- File name of the class
3315 do
3316 Result := lace_class.file_name
3317 ensure
3318 file_name_not_void: Result /= Void
3319 end
3320
3321 file_is_readable: BOOLEAN is
3322 -- Is file with `file_name' readable?
3323 local
3324 f: PLAIN_TEXT_FILE
3325 do
3326 create f.make (file_name)
3327 Result := f.exists and f.is_readable
3328 end
3329
3330 feature -- Comparison
3331
3332 infix "<" (other: like Current): BOOLEAN is
3333 -- Order relation on classes
3334 do
3335 Result := topological_id < other.topological_id
3336 end
3337
3338 feature -- Output
3339
3340 class_signature: STRING is
3341 -- Signature of class
3342 local
3343 formal_dec: FORMAL_DEC_AS
3344 old_group: CONF_GROUP
3345 gens: like generics
3346 do
3347 create Result.make (50)
3348 Result.append (name)
3349 gens := generics
3350 if gens /= Void then
3351 old_group := Inst_context.group
3352 Inst_context.set_group (group)
3353 Result.append (" [")
3354 from
3355 gens.start
3356 until
3357 gens.after
3358 loop
3359 formal_dec := gens.item
3360 Result.append (formal_dec.constraint_string)
3361 gens.forth
3362 if not gens.after then
3363 Result.append (", ")
3364 end
3365 end
3366 Inst_context.set_group (old_group)
3367 Result.append ("]")
3368 end
3369 ensure
3370 class_signature_not_void: Result /= Void
3371 end
3372
3373 append_header (a_text_formatter: TEXT_FORMATTER) is
3374 -- Append class header to `a_text_formatter'.
3375 do
3376 if is_expanded then
3377 a_text_formatter.process_keyword_text (ti_Expanded_keyword, Void)
3378 a_text_formatter.add_space
3379 elseif is_deferred then
3380 a_text_formatter.process_keyword_text (ti_Deferred_keyword, Void)
3381 a_text_formatter.add_space
3382 end
3383 a_text_formatter.process_keyword_text (ti_Class_keyword, Void)
3384 a_text_formatter.add_new_line
3385 a_text_formatter.add_indent
3386 append_signature (a_text_formatter, False)
3387 a_text_formatter.add_new_line
3388 end
3389
3390 append_signature (a_text_formatter: TEXT_FORMATTER; a_with_deferred_symbol: BOOLEAN) is
3391 -- Append the signature of current class in `a_text_formatter'. If `a_with_deferred_symbol'
3392 -- then add a `*' to the class name.
3393 require
3394 non_void_st: a_text_formatter /= Void
3395 do
3396 append_signature_internal (a_text_formatter, a_with_deferred_symbol, False)
3397 end
3398
3399 append_short_signature (a_text_formatter: TEXT_FORMATTER; a_with_deferred_symbol: BOOLEAN) is
3400 -- Append short signature of current class in `a_text_formatter'.
3401 -- Short signature is to use "..." to replace constrained generic type, so
3402 -- class {HASH_TABLE [G, H -> HASHABLE]} becomes {HASH_TABLE [G, H -> ...]}.
3403 -- Short signature is used to save some display space.
3404 -- If `a_with_deferred_symbol' then add a `*' to the class name.
3405 require
3406 non_void_st: a_text_formatter /= Void
3407 do
3408 append_signature_internal (a_text_formatter, a_with_deferred_symbol, True)
3409 end
3410
3411 append_name (a_text_formatter: TEXT_FORMATTER) is
3412 -- Append the name ot the current class in `a_text_formatter'
3413 require
3414 non_void_st: a_text_formatter /= Void
3415 do
3416 a_text_formatter.add_class (lace_class)
3417 end
3418
3419 feature {COMPILER_EXPORTER} -- Setting
3420
3421 set_main_parent (cl: like main_parent) is
3422 -- Assign `cl' to `main_parent'.
3423 require
3424 cl_not_void: cl /= Void
3425 il_generation: System.il_generation
3426 do
3427 main_parent := cl
3428 ensure
3429 main_parent_set: main_parent = cl
3430 end
3431
3432 set_number_of_features (n: like number_of_features) is
3433 -- Assign `n' to `number_of_features'.
3434 do
3435 number_of_features := n
3436 ensure
3437 number_of_features_set: number_of_features = n
3438 end
3439
3440 set_topological_id (i: INTEGER) is
3441 -- Assign `i' to `topological_id'.
3442 do
3443 topological_id := i
3444 ensure
3445 topological_id_set: topological_id = i
3446 end
3447
3448 set_is_deferred (b: BOOLEAN) is
3449 -- Assign `b' to `is_deferred'.
3450 do
3451 is_deferred := b
3452 ensure
3453 is_deferred_set: is_deferred = b
3454 end
3455
3456 set_is_expanded (b: BOOLEAN) is
3457 -- Assign `b' to `is_expanded'.
3458 do
3459 is_expanded := b
3460 ensure
3461 is_expanded_set: is_expanded = b
3462 end
3463
3464 set_is_enum (b: BOOLEAN) is
3465 -- Assign `b' to `is_enum'.
3466 require
3467 il_generation: System.il_generation
3468 do
3469 is_enum := b
3470 ensure
3471 is_enum_set: is_enum = b
3472 end
3473
3474 set_suppliers (s: like suppliers) is
3475 -- Assign `s' to `suppliers'.
3476 do
3477 suppliers := s
3478 ensure
3479 suppliers_set: suppliers = s
3480 end
3481
3482 set_generics (g: like generics) is
3483 -- Assign `g' to `generics'.
3484 do
3485 generics := g
3486 if g /= Void then
3487 create constrained_type_cache.make (g.count)
3488 create constrained_types_cache.make (g.count)
3489 end
3490 ensure
3491 generics_set: generics = g
3492 end
3493
3494 set_obsolete_message (m: like obsolete_message) is
3495 -- Set `obsolete_message' to `m'.
3496 do
3497 obsolete_message := m
3498 ensure
3499 obsolete_message_set: obsolete_message = m
3500 end
3501
3502 set_generic_features (f: like generic_features) is
3503 -- Set `generic_features' to `f'.
3504 require
3505 f_not_void: f /= Void
3506 do
3507 generic_features := f
3508 ensure
3509 generic_features_set: generic_features = f
3510 end
3511
3512 feature -- Genericity
3513
3514 invalidate_caches_related_to_generics
3515 -- Invalidates the cache which stores computed renamings
3516 do
3517 constraint_cache := Void
3518 ensure
3519 constraint_cache_void: constraint_cache = Void
3520 end
3521
3522 formal_at_position (n: INTEGER): TYPE_FEATURE_I is
3523 -- Find first TYPE_FEATURE_I in `generic_features' that
3524 -- matches position `n'.
3525 require
3526 has_formal: is_generic
3527 generic_features_computed: generic_features /= Void
3528 local
3529 l_formals: like generic_features
3530 l_formal: FORMAL_A
3531 l_cursor: CURSOR
3532 do
3533 from
3534 l_formals := generic_features
3535 l_cursor := l_formals.cursor
3536 l_formals.start
3537 until
3538 l_formals.after or Result /= Void
3539 loop
3540 l_formal ?= l_formals.item_for_iteration.type
3541 if l_formal /= Void and then l_formal.position = n then
3542 Result := l_formals.item_for_iteration
3543 end
3544 l_formals.forth
3545 end
3546 l_formals.go_to (l_cursor)
3547 ensure
3548 result_not_void: Result /= Void
3549 end
3550
3551 update_generic_features is
3552 -- Update `generic_features' with information of Current.
3553 require
3554 parents_not_void: parents /= Void
3555 local
3556 l_parents: like parents
3557 l_formal, l_parent_formal: TYPE_FEATURE_I
3558 l_formal_type: FORMAL_A
3559 l_generic_features, l_old: like generic_features
3560 l_inherited_formals: SEARCH_TABLE [INTEGER]
3561 l_rout_id_set: ROUT_ID_SET
3562 i, nb: INTEGER
3563 l_formal_dec: FORMAL_DEC_AS
3564 do
3565 -- Clean previously stored information.
3566 l_old := generic_features
3567 generic_features := Void
3568
3569 -- Collect all information about parent formal generic parameters.
3570 from
3571 l_parents := parents
3572 l_parents.start
3573 until
3574 l_parents.after
3575 loop
3576 l_generic_features := l_parents.item.associated_class.generic_features
3577 if l_generic_features /= Void then
3578 from
3579 l_generic_features.start
3580 until
3581 l_generic_features.after
3582 loop
3583 -- Extract parent generic parameter and perform instantiation
3584 -- in current class.
3585 l_parent_formal := l_generic_features.item_for_iteration
3586 l_formal := l_parent_formal.duplicate
3587 l_formal.set_type (l_formal.type.instantiated_in (l_parents.item))
3588 l_formal.set_is_origin (False)
3589 if l_old /= Void and then l_old.has (l_formal.rout_id_set.first) then
3590 l_formal.set_feature_id (
3591 l_old.item (l_formal.rout_id_set.first).feature_id)
3592 else
3593 l_formal.set_feature_id (feature_id_counter.next)
3594 end
3595 l_formal.set_origin_feature_id (l_parent_formal.origin_feature_id)
3596
3597 if not l_formal.type.same_as (l_parent_formal.type) then
3598 -- If there is an implicit type change of the formal
3599 -- generic parameter, then we need to generate
3600 -- a new body for specifying the new type of the formal
3601 -- generic parameter.
3602 l_formal.set_written_in (class_id)
3603 end
3604
3605 extend_generic_features (l_formal)
3606 l_generic_features.forth
3607 end
3608 end
3609 l_parents.forth
3610 end
3611
3612 l_generic_features := generic_features
3613
3614 if is_generic then
3615 create l_inherited_formals.make (generics.count)
3616 if l_generic_features = Void then
3617 create l_generic_features.make (generics.count)
3618 generic_features := l_generic_features
3619 else
3620 from
3621 l_generic_features.start
3622 until
3623 l_generic_features.after
3624 loop
3625 l_formal := l_generic_features.item_for_iteration
3626 if l_formal.is_formal then
3627 l_formal_type ?= l_formal.type
3628 l_inherited_formals.put (l_formal_type.position)
3629 end
3630 l_generic_features.forth
3631 end
3632 end
3633
3634 from
3635 i := 1
3636 nb := generics.count
3637 until
3638 i > nb
3639 loop
3640 if not l_inherited_formals.has (i) then
3641 l_formal_dec := generics.i_th (i)
3642 create l_formal_type.make (l_formal_dec.is_reference,
3643 l_formal_dec.is_expanded, i)
3644
3645 create l_formal
3646 l_formal.set_feature_name ("_" + name + "_Formal#" + i.out)
3647 l_formal.set_type (l_formal_type)
3648 l_formal.set_written_in (class_id)
3649 l_formal.set_origin_class_id (class_id)
3650
3651 create l_rout_id_set.make
3652 l_rout_id_set.put (l_formal.new_rout_id)
3653 l_formal.set_rout_id_set (l_rout_id_set)
3654 l_formal.set_is_origin (True)
3655 l_formal.set_position (i)
3656
3657 if l_old /= Void and then l_old.has (l_rout_id_set.first) then
3658 l_formal.set_feature_id (
3659 l_old.item (l_formal.rout_id_set.first).feature_id)
3660 else
3661 l_formal.set_feature_id (feature_id_counter.next)
3662 end
3663 l_formal.set_origin_feature_id (l_formal.feature_id)
3664
3665 l_generic_features.put (l_formal, l_rout_id_set.first)
3666 end
3667 i := i + 1
3668 end
3669 else
3670 -- FIXME: Manu 01/02/2002. Add assertion that shows
3671 -- that all TYPE_FEATURE_I.type of `l_generic_features'
3672 -- are not instances of FORMAL_I.
3673 end
3674
3675 debug ("FORMAL_GENERIC")
3676 if l_generic_features /= Void then
3677 print ("%NFor class " + name + ": " + l_generic_features.count.out)
3678 print (" local + inherited generic parameters%N")
3679 end
3680 end
3681 end
3682
3683 feature {NONE} -- Genericity
3684
3685 extend_generic_features (an_item: TYPE_FEATURE_I) is
3686 -- Insert `an_item' in `generic_features'. If `generic_features'
3687 -- is not yet created, creates it.
3688 require
3689 an_item_not_void: an_item /= Void
3690 local
3691 l_generic_features: like generic_features
3692 l_rout_id_set: ROUT_ID_SET
3693 l_rout_id, i, nb: INTEGER
3694 do
3695 l_generic_features := generic_features
3696 if l_generic_features = Void then
3697 create l_generic_features.make (5)
3698 generic_features := l_generic_features
3699 end
3700
3701 from
3702 l_rout_id_set := an_item.rout_id_set
3703 i := 1
3704 nb := l_rout_id_set.count
3705 until
3706 i > nb
3707 loop
3708 l_rout_id := l_rout_id_set.item (i)
3709 if not l_generic_features.has (l_rout_id) then
3710 l_generic_features.put (an_item, l_rout_id)
3711 else
3712 -- Should we report an error in this case, as it is not
3713 -- well implemented by compiler? Meaning that we have
3714 -- some repeated inheritance of generic parameters.
3715 end
3716
3717 i := i + 1
3718 end
3719 end
3720
3721 feature -- Anchored types
3722
3723 update_anchors is
3724 -- Update `anchored_features' with information of Current.
3725 require
3726 il_generation: System.il_generation
3727 local
3728 l_feat_tbl: like feature_table
3729 l_anchor, l_previous_anchor: TYPE_FEATURE_I
3730 l_anchored_features, l_old: like anchored_features
3731 l_inherited_features: like anchored_features
3732 l_parents: like parents_classes
3733 l_feat: FEATURE_I
3734 l_rout_id: INTEGER
3735 l_rout_id_set: ROUT_ID_SET
3736 l_type_set: SEARCH_TABLE [INTEGER]
3737 l_select: SELECT_TABLE
3738 l_type: TYPE_A
3739 do
3740 -- Get all inherited anchored features.
3741 from
3742 create l_inherited_features.make (0)
3743 l_parents := parents_classes
3744 l_parents.start
3745 until
3746 l_parents.after
3747 loop
3748 l_old := l_parents.item.anchored_features
3749 if l_old /= Void then
3750 l_inherited_features.merge (l_old)
3751 end
3752 l_parents.forth
3753 end
3754
3755 -- Initialize `l_type_set'
3756 from
3757 l_feat_tbl := feature_table
3758 l_type_set := type_set
3759 l_feat_tbl.start
3760 until
3761 l_feat_tbl.after
3762 loop
3763 l_feat := l_feat_tbl.item_for_iteration
3764 if l_feat.is_attribute then
3765 l_type := l_feat.type.actual_type
3766 if l_type.is_formal or l_type.has_generics then
3767 if l_type_set = Void then
3768 create l_type_set.make (5)
3769 end
3770 l_type_set.put (l_feat.rout_id_set.first)
3771 end
3772 end
3773 l_feat_tbl.forth
3774 end
3775
3776 -- Create `anchored_features' if needed and fill it with inherited
3777 -- anchors.
3778 from
3779 l_old := anchored_features
3780 create l_anchored_features.make (10)
3781 l_select := l_feat_tbl.origin_table
3782 l_select.start
3783 until
3784 l_select.after
3785 loop
3786 l_rout_id := l_select.key_for_iteration
3787 if
3788 (l_type_set /= Void and then l_type_set.has (l_rout_id)) or
3789 l_inherited_features.has (l_rout_id)
3790 then
3791 l_feat := l_select.item_for_iteration
3792
3793 create l_anchor
3794 l_anchor.set_type (l_feat.type.actual_type)
3795 l_anchor.set_written_in (class_id)
3796
3797 create l_rout_id_set.make
3798 l_rout_id_set.put (l_rout_id)
3799 l_anchor.set_rout_id_set (l_rout_id_set)
3800
3801 if l_old /= Void and then l_old.has (l_rout_id) then
3802 l_anchor.set_feature_id (l_old.item (l_rout_id).feature_id)
3803 else
3804 l_anchor.set_feature_id (feature_id_counter.next)
3805 end
3806
3807 if l_inherited_features.has (l_rout_id) then
3808 l_previous_anchor := l_inherited_features.item (l_rout_id)
3809 l_anchor.set_origin_class_id (l_previous_anchor.origin_class_id)
3810 l_anchor.set_origin_feature_id (l_previous_anchor.origin_feature_id)
3811 l_anchor.set_feature_name_id (l_previous_anchor.feature_name_id, 0)
3812 l_anchor.set_is_origin (False)
3813 else
3814 l_anchor.set_is_origin (True)
3815 l_anchor.set_origin_class_id (class_id)
3816 l_anchor.set_origin_feature_id (l_anchor.feature_id)
3817 l_anchor.set_feature_name ("_" + System.name + "_type_" + l_rout_id.out)
3818 end
3819
3820 l_anchored_features.put (l_anchor, l_rout_id)
3821 end
3822 l_select.forth
3823 end
3824
3825 debug ("ANCHORED_FEATURES")
3826 if l_anchored_features /= Void then
3827 print ("%NFor class " + name + ": " + l_anchored_features.count.out)
3828 print (" local + inherited generic parameters%N")
3829 end
3830 end
3831
3832 anchored_features := l_anchored_features
3833 end
3834
3835 extend_type_set (r_id: INTEGER) is
3836 -- Extend `type_set' with `r_id'. If `type_set' is
3837 -- not yet created, creates it.
3838 require
3839 valid_routine_id: r_id > 0
3840 il_generation: System.il_generation
3841 local
3842 l_type_set: like type_set
3843 do
3844 l_type_set := type_set
3845 if l_type_set = Void then
3846 create l_type_set.make (10)
3847 type_set := l_type_set
3848 end
3849 l_type_set.force (r_id)
3850 ensure
3851 inserted: type_set.has (r_id)
3852 end
3853
3854 feature -- Implementation
3855
3856 invariant_feature: INVARIANT_FEAT_I
3857 -- Invariant feature
3858
3859 types: TYPE_LIST
3860 -- Meta-class types associated to the class: it contains
3861 -- only one type if the class is not generic
3862
3863 feature_named (n: STRING): FEATURE_I is
3864 -- Feature whose internal name is `n'
3865 require
3866 n_not_void: n /= Void
3867 do
3868 if not n.is_empty and then has_feature_table then
3869 if feature_table.is_mangled_alias_name (n) then
3870 -- Lookup for alias feature
3871 Result := feature_table.alias_item (n)
3872 else
3873 -- Lookup for identifier feature
3874 Result := feature_table.item (n)
3875 end
3876 end
3877 end
3878
3879 feature -- Implementation
3880
3881 feature_table: FEATURE_TABLE is
3882 -- Compiler feature table
3883 require
3884 has_feature_table: has_feature_table
3885 do
3886 Result := Feat_tbl_server.item (class_id)
3887 ensure
3888 valid_result: Result /= Void
3889 end
3890
3891 has_feature_table: BOOLEAN is
3892 -- Has Current a feature table
3893 do
3894 Result := Feat_tbl_server.has (class_id)
3895 end
3896
3897 feature {NONE} -- Implementation
3898
3899 private_external_name: STRING
3900 -- Store class alias name clause value.
3901
3902 private_base_file_name: STRING
3903 -- Base file name used in code generation.
3904
3905 feature {DEGREE_5} -- Degree 5
3906
3907 add_to_degree_5 is
3908 -- Add current class to Degree 5.
3909 do
3910 degree_5_needed := True
3911 ensure
3912 added: degree_5_needed
3913 end
3914
3915 remove_from_degree_5 is
3916 -- Remove current class from Degree 5.
3917 do
3918 degree_5_needed := False
3919 parsing_needed := False
3920 ensure
3921 removed: not degree_5_needed
3922 end
3923
3924 degree_5_needed: BOOLEAN
3925 -- Does current class need to be
3926 -- processed in Degree 5?
3927
3928 parsing_needed: BOOLEAN
3929 -- Does current class need to be
3930 -- parsed during Degree 5?
3931
3932 set_parsing_needed (b: BOOLEAN) is
3933 -- Set `parsing_needed' to `b'.
3934 do
3935 parsing_needed := b
3936 ensure
3937 parsing_needed_set: parsing_needed = b
3938 end
3939
3940 feature {DEGREE_4, NAMED_TUPLE_TYPE_A} -- Degree 4
3941
3942 add_to_degree_4 is
3943 -- Add current class to Degree 4.
3944 do
3945 degree_4_needed := True
3946 ensure
3947 added: degree_4_needed
3948 end
3949
3950 remove_from_degree_4 is
3951 -- Remove current class from Degree 4.
3952 do
3953 degree_4_needed := False
3954 degree_4_processed := False
3955 expanded_modified := False
3956 deferred_modified := False
3957 supplier_status_modified := False
3958 ensure
3959 removed: not degree_4_needed
3960 end
3961
3962 degree_4_needed: BOOLEAN
3963 -- Does current class need to be
3964 -- processed in Degree 4?
3965
3966 degree_4_processed: BOOLEAN
3967 -- Has current class been processed in
3968 -- first pass of Degree 4?
3969
3970 expanded_modified: BOOLEAN
3971 -- Has the expanded status of current
3972 -- class been modified?
3973
3974 supplier_status_modified: BOOLEAN
3975 -- Has the status of a supplier changed?
3976
3977 set_degree_4_processed is
3978 -- Set `degree_4_processed' to True.
3979 do
3980 degree_4_processed := True
3981 ensure
3982 degree_4_processed_set: degree_4_processed
3983 end
3984
3985 set_expanded_modified is
3986 -- Set `expanded_modifed' to True.
3987 do
3988 expanded_modified := True
3989 ensure
3990 expanded_modified_set: expanded_modified
3991 end
3992
3993 set_deferred_modified is
3994 -- Set `deferred_modified' to True.
3995 do
3996 deferred_modified := True
3997 ensure
3998 deferred_modified_set: deferred_modified
3999 end
4000
4001 set_supplier_status_modified is
4002 -- Set `supplier_status_modified' to True.
4003 do
4004 supplier_status_modified := True
4005 ensure
4006 supplier_status_modified_set: supplier_status_modified
4007 end
4008
4009 feature {DEGREE_4, INHERIT_TABLE} -- Degree 4
4010
4011 deferred_modified: BOOLEAN
4012 -- Has the deferred status of current
4013 -- class been modified?
4014
4015 feature {DEGREE_4, DEGREE_3} -- Used by degree 4 and 3 to compute new assertions
4016
4017 assert_prop_list: LINKED_LIST [INTEGER]
4018 -- List of routine ids to be propagated
4019
4020 set_assertion_prop_list (l: like assert_prop_list) is
4021 -- Set `assert_prop_list' to `l'.
4022 do
4023 assert_prop_list := l
4024 ensure
4025 assert_prop_list_set: assert_prop_list = l
4026 end
4027
4028 feature {DEGREE_3} -- Degree 3
4029
4030 add_to_degree_3 is
4031 -- Add current class to Degree 3.
4032 -- Set `finalization_needed' to True
4033 require
4034 not_a_true_external_class: not is_true_external
4035 do
4036 degree_3_needed := True
4037 finalization_needed := True
4038 ensure
4039 added: degree_3_needed
4040 finalization_needed_set: finalization_needed
4041 end
4042
4043 remove_from_degree_3 is
4044 -- Remove current class from Degree 3.
4045 do
4046 degree_3_needed := False
4047 ensure
4048 removed: not degree_3_needed
4049 end
4050
4051 degree_3_needed: BOOLEAN
4052 -- Does current class need to be
4053 -- processed in Degree 3?
4054
4055 feature {DEGREE_2} -- Degree 2
4056
4057 add_to_degree_2 is
4058 -- Add current class to Degree 2.
4059 require
4060 not_a_true_external_class: not is_true_external
4061 do
4062 degree_2_needed := True
4063 ensure
4064 added: degree_2_needed
4065 end
4066
4067 remove_from_degree_2 is
4068 -- Remove current class from Degree 2.
4069 do
4070 degree_2_needed := False
4071 ensure
4072 removed: not degree_2_needed
4073 end
4074
4075 degree_2_needed: BOOLEAN
4076 -- Does current class need to be
4077 -- processed in Degree 2?
4078
4079 feature {DEGREE_1} -- Degree 1
4080
4081 add_to_degree_1 is
4082 -- Add current class to Degree 1.
4083 require
4084 not_a_true_external_class: not is_true_external
4085 do
4086 degree_1_needed := True
4087 ensure
4088 added: degree_1_needed
4089 end
4090
4091 remove_from_degree_1 is
4092 -- Remove current class from Degree 1.
4093 do
4094 degree_1_needed := False
4095 ensure
4096 removed: not degree_1_needed
4097 end
4098
4099 degree_1_needed: BOOLEAN
4100 -- Does current class need to be
4101 -- processed in Degree 1?
4102
4103 feature {DEGREE_MINUS_1, IL_GENERATOR} -- Degree -1
4104
4105 add_to_degree_minus_1 is
4106 -- Add current class to Degree -1.
4107 require
4108 not_a_true_external_class: not is_true_external
4109 do
4110 degree_minus_1_needed := True
4111 ensure
4112 added: degree_minus_1_needed
4113 end
4114
4115 remove_from_degree_minus_1 is
4116 -- Remove current class from Degree -1.
4117 do
4118 degree_minus_1_needed := False
4119 ensure
4120 removed: not degree_minus_1_needed
4121 end
4122
4123 degree_minus_1_needed: BOOLEAN
4124 -- Does current class need to be
4125 -- processed in Degree -1?
4126
4127 feature -- Degree -2/-3
4128
4129 finalization_needed: BOOLEAN
4130 -- Does current class need to be processed for
4131 -- finalization?
4132
4133 set_finalization_needed (v: BOOLEAN) is
4134 -- Assign `finalization_needed' with `v'.
4135 do
4136 finalization_needed := v
4137 ensure
4138 finalization_needed_set: finalization_needed = v
4139 end
4140
4141 feature -- output
4142
4143 debug_output: STRING is
4144 -- Generate a nice representation of Current to be seen
4145 -- in debugger.
4146 local
4147 l_name: STRING
4148 do
4149 l_name := name
4150 create Result.make (l_name.count + 6)
4151 Result.append_integer (class_id)
4152 Result.append_character (':')
4153 Result.append_character (' ')
4154 Result.append (l_name)
4155 end
4156
4157 feature {NONE} -- Implementation
4158
4159 internal_is_frozen: BOOLEAN
4160 -- Mutable version of `is_frozen'.
4161
4162 internal_feature_table_file_id: INTEGER
4163 -- Number added at end of C file corresponding to generated
4164 -- feature table. Initialized by default to -1.
4165
4166 append_signature_internal (a_text_formatter: TEXT_FORMATTER; a_with_deferred_symbol: BOOLEAN; a_short: BOOLEAN) is
4167 -- Append the signature of current class in `a_text_formatter'. If `a_with_deferred_symbol'
4168 -- then add a `*' to the class name.
4169 -- If `a_short', use "..." to replace constrained generic type.
4170 require
4171 non_void_st: a_text_formatter /= Void
4172 local
4173 formal_dec: FORMAL_CONSTRAINT_AS
4174 old_group: CONF_GROUP
4175 gens: like generics
4176 do
4177 append_name (a_text_formatter)
4178 if a_with_deferred_symbol and is_deferred then
4179 a_text_formatter.add_char ('*')
4180 end
4181 gens := generics
4182 if gens /= Void then
4183 old_group := Inst_context.group
4184 Inst_context.set_group (group)
4185 a_text_formatter.add_space
4186 a_text_formatter.process_symbol_text (ti_L_bracket)
4187 from
4188 gens.start
4189 until
4190 gens.after
4191 loop
4192 formal_dec ?= gens.item
4193 check formal_dec_not_void: formal_dec /= Void end
4194 formal_dec.append_signature (a_text_formatter, a_short, Current)
4195 gens.forth
4196 if not gens.after then
4197 a_text_formatter.process_symbol_text (ti_Comma)
4198 a_text_formatter.add_space
4199 end
4200 end
4201 a_text_formatter.process_symbol_text (ti_R_bracket)
4202 Inst_context.set_group (old_group)
4203 end
4204 end
4205
4206 invariant
4207
4208 -- Default invariants common to all kind of generation.
4209 lace_class_exists: lace_class /= Void
4210 descendants_exists: descendants /= Void
4211 suppliers_exisis: suppliers /= Void
4212 clients_exists: clients /= Void
4213 config_class_connection: original_class.compiled_class = Current
4214 conformance_table_not_void: conformance_table /= Void
4215
4216 -- Invariants IL versus normal generation.
4217 anchored_features_void_in_non_il_generation:
4218 not System.il_generation implies anchored_features = Void
4219
4220 -- True after proper initialization of Current instance.
4221 -- has_ast: has_ast
4222
4223 indexing
4224 copyright: "Copyright (c) 1984-2006, Eiffel Software"
4225 license: "GPL version 2 (see http://www.eiffel.com/licensing/gpl.txt)"
4226 licensing_options: "http://www.eiffel.com/licensing"
4227 copying: "[
4228 This file is part of Eiffel Software's Eiffel Development Environment.
4229
4230 Eiffel Software's Eiffel Development Environment is free
4231 software; you can redistribute it and/or modify it under
4232 the terms of the GNU General Public License as published
4233 by the Free Software Foundation, version 2 of the License
4234 (available at the URL listed under "license" above).
4235
4236 Eiffel Software's Eiffel Development Environment is
4237 distributed in the hope that it will be useful, but
4238 WITHOUT ANY WARRANTY; without even the implied warranty
4239 of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
4240 See the GNU General Public License for more details.
4241
4242 You should have received a copy of the GNU General Public
4243 License along with Eiffel Software's Eiffel Development
4244 Environment; if not, write to the Free Software Foundation,
4245 Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
4246 ]"
4247 source: "[
4248 Eiffel Software
4249 356 Storke Road, Goleta, CA 93117 USA
4250 Telephone 805-685-1006, Fax 805-685-6869
4251 Website http://www.eiffel.com
4252 Customer support http://support.eiffel.com
4253 ]"
4254
4255 end -- class CLASS_C
4256

Properties

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

  ViewVC Help
Powered by ViewVC 1.1.23