/[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 69868 - (show annotations)
Fri Aug 3 22:28:26 2007 UTC (12 years, 4 months ago) by martins
File size: 113246 byte(s)
enabled more types to store monomorph information
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 record_descendants (classes: LIST [CLASS_C]) is
1813 -- Record the descendants of `Current' to `classes'.
1814 require
1815 valid_classes: classes /= Void
1816 local
1817 descendant: CLASS_C
1818 i, l_count: INTEGER
1819 do
1820 classes.extend (Current)
1821 from
1822 i := 1
1823 l_count := descendants.count
1824 until
1825 i > l_count
1826 loop
1827 descendant := descendants.i_th (i)
1828 if not classes.has (descendant) then
1829 descendant.record_descendants (classes)
1830 end
1831 i := i + 1
1832 end
1833 end
1834
1835 feature -- Actual class type
1836
1837 constraint_actual_type: CL_TYPE_A is
1838 -- Actual type of class where all formals are replaced by their constraint.
1839 local
1840 i, count: INTEGER
1841 actual_generic: ARRAY [TYPE_A]
1842 do
1843 if generics = Void then
1844 Result := actual_type
1845 else
1846 from
1847 i := 1
1848 count := generics.count
1849 create actual_generic.make (1, count)
1850 create {GEN_TYPE_A} Result.make (class_id, actual_generic)
1851 until
1852 i > count
1853 loop
1854 actual_generic.put (constraints (i), i)
1855 i := i + 1
1856 end
1857 end
1858 ensure
1859 constraint_actual_type_not_void: Result /= Void
1860 end
1861
1862 actual_type: CL_TYPE_A is
1863 -- Actual type of the class
1864 local
1865 i, nb: INTEGER
1866 actual_generic: ARRAY [FORMAL_A]
1867 formal: FORMAL_A
1868 l_formal_dec: FORMAL_CONSTRAINT_AS
1869 do
1870 if generics = Void then
1871 create Result.make (class_id)
1872 else
1873 from
1874 i := 1
1875 nb := generics.count
1876 create actual_generic.make (1, nb)
1877 create {GEN_TYPE_A} Result.make (class_id, actual_generic)
1878 until
1879 i > nb
1880 loop
1881 l_formal_dec ?= generics.i_th (i)
1882 check l_formal_dec_not_void: l_formal_dec /= Void end
1883 create formal.make (l_formal_dec.is_reference, l_formal_dec.is_expanded, l_formal_dec.is_monomorph, i)
1884 actual_generic.put (formal, i)
1885 i := i + 1
1886 end
1887 end
1888 ensure
1889 actual_type_not_void: Result /= Void
1890 end
1891
1892 feature {TYPE_AS, AST_TYPE_A_GENERATOR, AST_FEATURE_CHECKER_GENERATOR} -- Actual class type
1893
1894 partial_actual_type (gen: ARRAY [TYPE_A]; is_exp, is_sep, is_mono: BOOLEAN): CL_TYPE_A is
1895 -- Actual type of `current depending on the context in which it is declared
1896 -- in CLASS_TYPE_AS. That is to say, it could have generics `gen' but not
1897 -- be a generic class. It simplifies creation of `CL_TYPE_A' instances in
1898 -- CLASS_TYPE_AS when trying to resolve types, by using dynamic binding
1899 -- rather than if statements.
1900 require
1901 is_exp_set: is_exp implies (not is_sep)
1902 is_sep_set: is_sep implies (not is_exp)
1903 do
1904 if gen /= Void then
1905 create {GEN_TYPE_A} Result.make (class_id, gen)
1906 else
1907 create Result.make (class_id)
1908 end
1909 if is_exp then
1910 Result.set_expanded_mark
1911 elseif is_sep then
1912 Result.set_separate_mark
1913 end
1914 if is_mono then
1915 Result.set_monomorph_mark
1916 end
1917 if is_expanded then
1918 Result.set_expanded_class_mark
1919 end
1920 ensure
1921 actual_type_not_void: Result /= Void
1922 end
1923
1924 feature -- Incrementality
1925
1926 insert_changed_feature (feature_name_id: INTEGER) is
1927 -- Insert feature `feature_name_id' in `changed_features'.
1928 require
1929 good_argument: feature_name_id > 0
1930 do
1931 debug ("ACTIVITY")
1932 io.error.put_string ("CLASS_C: ")
1933 io.error.put_string (name)
1934 io.error.put_string ("%NChanged_feature: ")
1935 io.error.put_string (Names_heap.item (feature_name_id))
1936 io.error.put_new_line
1937 end
1938 changed_features.put (feature_name_id)
1939 end
1940
1941 constraint (i: INTEGER): TYPE_A is
1942 -- I-th constraint of the class
1943 require
1944 generics_exists: is_generic
1945 valid_index: generics.valid_index (i)
1946 not_is_multi_constraint: not generics.i_th (i).has_multi_constraints
1947 local
1948 l_formal_dec: FORMAL_CONSTRAINT_AS
1949 do
1950 l_formal_dec ?= generics.i_th (i)
1951 check l_formal_dec_not_void: l_formal_dec /= Void end
1952 Result := l_formal_dec.constraint_type (Current).type
1953 ensure
1954 constraint_not_void: Result /= Void
1955 end
1956
1957 constraint_if_possible (i: INTEGER): TYPE_A is
1958 -- I-th constraint of the class
1959 require
1960 generics_exists: is_generic
1961 valid_index: generics.valid_index (i)
1962 not_is_multi_constraint: not generics.i_th (i).has_multi_constraints
1963 local
1964 l_formal_dec: FORMAL_CONSTRAINT_AS
1965 l_result: RENAMED_TYPE_A [TYPE_A]
1966 do
1967 l_formal_dec ?= generics.i_th (i)
1968 check l_formal_dec_not_void: l_formal_dec /= Void end
1969 l_result := l_formal_dec.constraint_type_if_possible (Current)
1970 if l_result /= Void then
1971 Result := l_result.type
1972 end
1973 end
1974
1975 constraints (i: INTEGER): TYPE_SET_A is
1976 -- I-th constraint set of the class
1977 require
1978 generics_exists: is_generic
1979 valid_index: generics.valid_index (i)
1980 local
1981 l_formal_dec: FORMAL_CONSTRAINT_AS
1982 do
1983 -- Fixme: Should we store computation of `constraint_types'?
1984 l_formal_dec ?= generics.i_th (i)
1985 check l_formal_dec_not_void: l_formal_dec /= Void end
1986 Result := l_formal_dec.constraint_types (Current)
1987 ensure
1988 constraint_not_void: Result /= Void
1989 end
1990
1991 constraints_if_possible (i: INTEGER): TYPE_SET_A is
1992 -- I-th constraint set of the class
1993 require
1994 generics_exists: is_generic
1995 valid_index: generics.valid_index (i)
1996 local
1997 l_formal_dec: FORMAL_CONSTRAINT_AS
1998 do
1999 -- Fixme: Should we store computation of `constraint_types_if_possible'?
2000 l_formal_dec ?= generics.i_th (i)
2001 check l_formal_dec_not_void: l_formal_dec /= Void end
2002 Result := l_formal_dec.constraint_types_if_possible (Current)
2003 ensure
2004 constraint_not_void: Result /= Void
2005 end
2006
2007 constrained_type (a_formal_position: INTEGER): TYPE_A
2008 -- Constraint of Current.
2009 --
2010 -- `a_formal_position' is the position of the formal whose constraint is returned.
2011 -- Warning: Result is cached, do not modify it.
2012 require
2013 is_generic: is_generic
2014 valid_formal_position: is_valid_formal_position (a_formal_position)
2015 not_multi_constraint: not generics [a_formal_position].is_multi_constrained (generics)
2016 local
2017 l_formal_type: FORMAL_A
2018 l_recursion_break: SPECIAL [BOOLEAN]
2019 l_break: BOOLEAN
2020 l_formal_type_position: INTEGER
2021 do
2022 Result := constrained_type_cache [a_formal_position - 1]
2023 if Result = Void then
2024 create l_recursion_break.make (generics.count + 1)
2025 from
2026 Result := constraint (a_formal_position)
2027 until
2028 not Result.is_formal or l_break
2029 loop
2030 l_formal_type ?= Result
2031 check l_formal_type_not_void: l_formal_type /= Void end
2032 l_formal_type_position := l_formal_type.position
2033 check valid_formal_position: is_valid_formal_position (l_formal_type_position) end
2034 l_break := l_recursion_break [l_formal_type_position]
2035 l_recursion_break [l_formal_type_position] := True
2036 Result := constraint (l_formal_type_position)
2037 end
2038 if l_break then
2039 Result := any_type
2040 end
2041 constrained_type_cache [a_formal_position - 1] := Result
2042 end
2043 ensure
2044 Result_not_void: Result /= Void
2045 Result_is_named_but_not_formal: (Result.is_none or Result.is_named_type) and not Result.is_formal
2046 end
2047
2048 constrained_types (a_formal_position: INTEGER): TYPE_SET_A
2049 -- Constrained types of Current.
2050 --
2051 -- `a_context_class' is the context class where the formal occurs in.
2052 --| It is a list of class types which constraint the current Formal.
2053 -- Warning: Result is cached, do not modify it.
2054 require
2055 valid_formal_position: is_valid_formal_position (a_formal_position)
2056 do
2057 Result ?= constrained_types_cache [a_formal_position - 1]
2058 if Result = Void then
2059 Result := constraints (a_formal_position).constraining_types (Current)
2060 constrained_types_cache [a_formal_position - 1] := Result
2061 end
2062 ensure
2063 Result_not_void_and_not_empty: Result /= Void and not Result.is_empty
2064 end
2065
2066 update_instantiator1 is
2067 -- Ensure that parents classes have a proper generic derivation
2068 -- matching needs of current class which has syntactically
2069 -- been changed.
2070 require
2071 is_syntactically_changed: changed
2072 parents_not_void: parents /= Void
2073 local
2074 parent_type: CL_TYPE_A
2075 l_area: SPECIAL [CL_TYPE_A]
2076 i, nb: INTEGER
2077 do
2078 from
2079 l_area := parents.area
2080 nb := parents.count
2081 until
2082 i = nb
2083 loop
2084 parent_type := l_area.item (i)
2085 -- Because inheritance clause does not care about expanded
2086 -- status, we remove it in case parent class is by default
2087 -- expanded.
2088 if parent_type.is_expanded then
2089 parent_type := parent_type.reference_type
2090 end
2091 Instantiator.dispatch (parent_type, Current)
2092 i := i + 1
2093 end
2094 end
2095
2096 init_types is
2097 -- Standard initialization of attribute `types' for non
2098 -- generic classes.
2099 require
2100 no_generic: not is_generic
2101 local
2102 data: CL_TYPE_I
2103 do
2104 data := actual_type.type_i
2105 register_type (data).do_nothing
2106 instantiator.dispatch (data.type_a, Current)
2107 if data.is_expanded and then not data.is_external or else data.is_basic then -- and then not data.is_char then
2108 -- Process reference counterpart.
2109 data := data.reference_type
2110 register_type (data).do_nothing
2111 instantiator.dispatch (data.type_a, Current)
2112 end
2113 end
2114
2115 update_types (data: CL_TYPE_I) is
2116 -- Update `types' with `data'.
2117 require
2118 good_argument: data /= Void
2119 consistency: data.base_class = Current
2120 good_context:
2121 (data.base_class.original_class /= system.native_array_class and then
2122 data.base_class.original_class /= system.typed_pointer_class) implies
2123 not data.has_formal
2124 local
2125 new_class_type: CLASS_TYPE
2126 do
2127 if not derivations.has_derivation (class_id, data) then
2128 -- The recursive update is done only once
2129 derivations.insert_derivation (class_id, data)
2130
2131 debug ("GENERICITY")
2132 io.error.put_string ("Update_types%N")
2133 io.error.put_string (name)
2134 data.trace
2135 end
2136 new_class_type := register_type (data)
2137
2138 if data.is_expanded and then not data.is_external then
2139 -- Process reference counterpart.
2140 update_types (data.reference_type)
2141 end
2142
2143 -- Propagation along the filters since we have a new type
2144 update_filter_types (new_class_type)
2145 if new_class_type.is_expanded then
2146 -- Propagate to all parent filters to ensure that
2147 -- all the required class types are registered
2148 -- for generating this expanded class type
2149 from
2150 parents_classes.start
2151 until
2152 parents_classes.after
2153 loop
2154 parents_classes.item.update_filter_anchored_types (new_class_type)
2155 parents_classes.forth
2156 end
2157 end
2158 end
2159 end
2160
2161 feature {NONE} -- Incrementality
2162
2163 derivations: DERIVATIONS is
2164 once
2165 Result := instantiator.derivations
2166 ensure
2167 derivations_not_void: Result /= Void
2168 end
2169
2170 register_type (data: CL_TYPE_I): CLASS_TYPE is
2171 -- Ensure that `data' has an associated class type by creating
2172 -- a new class type descriptor if it is not already created;
2173 -- return the associated class type.
2174 require
2175 data_not_void: data /= Void
2176 local
2177 g: GEN_TYPE_I
2178 do
2179 if data.meta_generic /= Void then
2180 -- Register this generic type and other required types.
2181 g ?= data
2182 Result := register_generic_type (g, g.meta_generic.count)
2183 elseif types.has_type (data) then
2184 Result := types.found_item
2185 else
2186 -- Found a new type for the class
2187 Result := register_new_type (data)
2188 end
2189 ensure
2190 result_not_void: Result /= Void
2191 data_is_registered: types.has_type (data)
2192 end
2193
2194 register_new_type (data: CL_TYPE_I): CLASS_TYPE is
2195 -- Register new type `data' and return the corresponding descriptor.
2196 require
2197 data_attached: data /= Void
2198 data_is_new: not types.has_type (data)
2199 do
2200 debug ("GENERICITY")
2201 io.error.put_string ("new type%N")
2202 end
2203 Result := new_type (normalized_type_i (data))
2204 -- If the $ operator is used in the class,
2205 -- an encapsulation of the feature must be generated
2206 if System.address_table.class_has_dollar_operator (class_id) then
2207 System.request_freeze
2208 end
2209 -- Mark the class `changed4' because there is a new type
2210 changed4 := True
2211 Degree_2.insert_new_class (Current)
2212 -- Insertion of the new class type
2213 types.extend (Result)
2214 System.insert_class_type (Result)
2215 ensure
2216 result_attached: Result /= Void
2217 data_is_registered: types.has_type (data)
2218 end
2219
2220 register_generic_type (data: GEN_TYPE_I; n: INTEGER): CLASS_TYPE is
2221 -- Ensure that `data' has an associated class type by creating
2222 -- a new class type descriptor if it is not already created;
2223 -- return the associated class type. Register all the types
2224 -- required by this type for code generation.
2225 local
2226 g: GEN_TYPE_I
2227 t: ARRAY [TYPE_I]
2228 p: TYPE_I
2229 c: CL_TYPE_I
2230 i: INTEGER
2231 a: NATIVE_ARRAY_TYPE_I
2232 r: GEN_TYPE_I
2233 do
2234 if types.has_type (data) then
2235 Result := types.found_item
2236 else
2237 -- Found a new type for the class
2238 Result := register_new_type (data)
2239 r ?= Result.type
2240 check
2241 r_attached: r /= Void
2242 end
2243 a ?= r
2244 -- if False then
2245 -- -- TODO: see GEN_TYPE_I.enumerate_interfaces
2246 if a = Void and then system.is_precompiled then
2247 -- Register all types where expanded parameters are replaced with reference ones.
2248 t := r.true_generics
2249 from
2250 i := n
2251 until
2252 i <= 0
2253 loop
2254 p := t [i]
2255 if p.is_expanded then
2256 g := r.duplicate
2257 c ?= p
2258 check
2259 c_attached: c /= Void
2260 end
2261 g.true_generics [i] := c.reference_type
2262 g.meta_generic [i] := reference_c_type
2263 register_generic_type (g, i - 1).do_nothing
2264 update_types (g)
2265 end
2266 i := i - 1
2267 end
2268 end
2269 end
2270 end
2271
2272 normalized_type_i (data: CL_TYPE_I): CL_TYPE_I is
2273 -- Class type `data' normalized in terms of the current class.
2274 require
2275 data_not_void: data /= Void
2276 do
2277 Result := data
2278 ensure
2279 result_not_void: Result /= Void
2280 end
2281
2282 new_type (data: CL_TYPE_I): CLASS_TYPE is
2283 -- New class type for current class
2284 do
2285 create Result.make (data)
2286 if already_compiled then
2287 -- Melt all the code written in the associated class of the new class type
2288 melt_all
2289 end
2290 ensure
2291 new_type_not_void: Result /= Void
2292 end
2293
2294 update_filter_types (new_class_type: CLASS_TYPE) is
2295 -- Update all types associated with `filters' using `new_class_type'.
2296 require
2297 new_class_type_not_void: new_class_type /= Void
2298 filters_not_void: filters /= Void
2299 local
2300 class_filters: like filters
2301 filter: CL_TYPE_I
2302 class_filters_cursor: CURSOR
2303 do
2304 class_filters := filters
2305 -- Propagation along the filters since we have a new type
2306 -- Clean the filters. Some of the filters can be obsolete
2307 -- if the base class has been removed from the system
2308 class_filters.clean
2309 from
2310 class_filters.start
2311 until
2312 class_filters.after
2313 loop
2314 -- We need to store cursor position because when you
2315 -- have an expanded class used as a reference or vice versa
2316 -- and that this class has some `like Current' then
2317 -- we are going to traverse recursively the `filters' list.
2318 class_filters_cursor := class_filters.cursor
2319 -- Instantiation of the filter with `data'
2320 filter := class_filters.item.instantiation_in (new_class_type)
2321 debug ("GENERICITY")
2322 io.error.put_string ("Propagation of ")
2323 filter.trace
2324 io.error.put_string ("propagation to ")
2325 io.error.put_string (filter.base_class.name)
2326 io.error.put_new_line
2327 end
2328 if filter.has_formal implies
2329 (filter.base_class.original_class = system.native_array_class or else
2330 filter.base_class.original_class = system.typed_pointer_class)
2331 then
2332 filter.base_class.update_types (filter)
2333 end
2334 class_filters.go_to (class_filters_cursor)
2335 class_filters.forth
2336 end
2337 end
2338
2339 feature {CLASS_C} -- Incrementality
2340
2341 update_filter_anchored_types (new_class_type: CLASS_TYPE) is
2342 -- Update all anchored types associated with `filters' using `new_class_type'.
2343 require
2344 new_class_type_not_void: new_class_type /= Void
2345 new_class_type_is_expanded: new_class_type.is_expanded
2346 filters_not_void: filters /= Void
2347 local
2348 class_filters: like filters
2349 filter: CL_TYPE_I
2350 class_filters_cursor: CURSOR
2351 do
2352 class_filters := filters
2353 -- Propagation along the filters since we have a new type
2354 -- Clean the filters. Some of the filters can be obsolete
2355 -- if the base class has been removed from the system
2356 class_filters.clean
2357 from
2358 class_filters.start
2359 until
2360 class_filters.after
2361 loop
2362 -- We need to store cursor position because when you
2363 -- have an expanded class used as a reference or vice versa
2364 -- and that this class has some `like Current' then
2365 -- we are going to traverse recursively the `filters' list.
2366 class_filters_cursor := class_filters.cursor
2367 -- Instantiation of the filter with `data'
2368 filter := class_filters.item.anchor_instantiation_in (new_class_type)
2369 if
2370 (filter.base_class.original_class /= system.native_array_class and then
2371 filter.base_class.original_class /= system.typed_pointer_class) implies
2372 not filter.has_formal
2373 then
2374 debug ("GENERICITY")
2375 io.error.put_string ("Propagation of ")
2376 filter.trace
2377 io.error.put_string ("propagation to ")
2378 io.error.put_string (filter.base_class.name)
2379 io.error.put_new_line
2380 end
2381 filter.base_class.update_types (filter)
2382 end
2383 class_filters.go_to (class_filters_cursor)
2384 class_filters.forth
2385 end
2386 end
2387
2388 feature -- Meta-type
2389
2390 meta_type (class_type: CLASS_TYPE): CLASS_TYPE is
2391 -- Associated class type of Current class in the context
2392 -- of descendant type `class_type'.
2393 require
2394 good_argument: class_type /= Void
2395 conformance: class_type.associated_class.conform_to (Current)
2396 local
2397 actual_class_type, written_actual_type: CL_TYPE_A
2398 do
2399 if class_type.type.class_id = class_id then
2400 -- Use supplied `class_type' to preserve expandedness status, generic parameters, etc.
2401 Result := class_type
2402 elseif generics = Void then
2403 -- No instantiation for non-generic class
2404 Result := types.first
2405 else
2406 actual_class_type := class_type.associated_class.actual_type
2407 -- General instantiation of the actual class type where
2408 -- the feature is written in the context of the actual
2409 -- type of the base class of `class_type'.
2410 written_actual_type ?= actual_type.instantiation_in
2411 (actual_class_type, class_id)
2412 if written_actual_type.is_expanded then
2413 -- Ancestors are always reference types.
2414 written_actual_type := written_actual_type.reference_type
2415 end
2416 -- Ask for the meta-type
2417 Result := written_actual_type.type_i.instantiation_in (class_type).associated_class_type
2418 end
2419 ensure
2420 meta_type_not_void: Result /= Void
2421 end
2422
2423 feature -- Validity class
2424
2425 check_validity is
2426 -- Special classes validity check.
2427 local
2428 l_feature: FEATURE_I
2429 do
2430 if System.any_class = original_class then
2431 -- We are checking ANY.
2432 l_feature := feature_table.item_id (names_heap.Internal_correct_mismatch_name_id)
2433 if
2434 l_feature = Void or else
2435 not l_feature.is_routine or l_feature.argument_count > 0
2436 then
2437 error_handler.insert_error (
2438 create {SPECIAL_ERROR}.make ("Class ANY must have a procedure `internal_correct_mismatch' with no arguments", Current))
2439 end
2440 l_feature := feature_table.item_id (names_heap.equal_name_id)
2441 if
2442 l_feature = Void or else
2443 l_feature.argument_count /= 2 or else
2444 not l_feature.arguments.i_th (1).actual_argument_type (l_feature.arguments).is_reference or else
2445 not l_feature.arguments.i_th (2).actual_argument_type (l_feature.arguments).is_reference or else
2446 not l_feature.type.is_boolean
2447 then
2448 error_handler.insert_error (
2449 create {SPECIAL_ERROR}.make ("Class ANY must have a boolean query `equal' with 2 reference arguments", Current))
2450 end
2451 l_feature := feature_table.item_id (names_heap.twin_name_id)
2452 if
2453 l_feature = Void or else
2454 not l_feature.is_routine or else l_feature.argument_count > 0 or else l_feature.type.is_expanded
2455 then
2456 error_handler.insert_error (
2457 create {SPECIAL_ERROR}.make ("Class ANY must have a function `twin' with no arguments", Current))
2458 end
2459 end
2460 end
2461
2462 feature -- default_rescue routine
2463
2464 default_rescue_feature: FEATURE_I is
2465 -- The version of `default_rescue' from ANY.
2466 -- Void if ANY has not been compiled yet or
2467 -- does not possess the feature.
2468 require
2469 has_feature_table: has_feature_table
2470 any_class_compiled: System.any_class /= Void
2471 do
2472 Result := feature_table.feature_of_rout_id (System.default_rescue_id)
2473 end
2474
2475 feature -- default_create routine
2476
2477 default_create_feature : FEATURE_I is
2478 -- The version of `default_create' from ANY.
2479 -- Void if ANY has not been compiled yet or
2480 -- does not posess the feature or class is deferred.
2481 require
2482 has_feature_table: has_feature_table
2483 do
2484 Result := feature_table.feature_of_rout_id (System.default_create_id)
2485 end
2486
2487 allows_default_creation : BOOLEAN is
2488 -- Can an instance of this class be
2489 -- created with 'default_create'?
2490 require
2491 has_feature_table: has_feature_table
2492 local
2493 dcr_feat : FEATURE_I
2494 do
2495 -- Answer is NO if class is deferred
2496 if not is_deferred then
2497 dcr_feat := default_create_feature
2498 -- Answer is NO if the class has no
2499 -- 'default_create'
2500 Result := dcr_feat /= Void and then (
2501 (creators = Void) or else (not creators.is_empty and then creators.has (dcr_feat.feature_name)))
2502 end
2503 end
2504
2505 feature -- Dead code removal
2506
2507 mark_visible (remover: REMOVER) is
2508 -- Dead code removal from the visible features
2509 require
2510 visible_level.has_visible
2511 do
2512 visible_level.mark_visible (remover, feature_table)
2513 end
2514
2515 has_visible: BOOLEAN is
2516 -- Has the class some visible features
2517 do
2518 Result := visible_level.has_visible
2519 end
2520
2521 visible_table_size: INTEGER
2522 -- Size of hash table for visible features of Current class.
2523
2524 feature -- Cecil
2525
2526 generate_cecil (generated_wrappers: DS_HASH_SET [STRING]) is
2527 -- Generate cecil table for a class having visible features
2528 require
2529 has_visible: has_visible
2530 generated_wrappers_attached: generated_wrappers /= Void
2531 do
2532 -- Reset hash-table size which will be computed during
2533 -- generation.
2534 set_visible_table_size (0)
2535 visible_level.generate_cecil_table (Current, generated_wrappers)
2536 end
2537
2538 feature -- Invariant feature
2539
2540 has_invariant: BOOLEAN is
2541 -- Has the current class an invariant clause ?
2542 do
2543 Result := invariant_feature /= Void
2544 end
2545
2546 feature -- Process the creation feature
2547
2548 process_creation_feature is
2549 -- Assign `default_create' creation procedure (if applicable) to
2550 -- `creation_feature'.
2551 require
2552 has_feature_table: has_feature_table
2553 do
2554 if allows_default_creation then
2555 creation_feature := default_create_feature
2556 else
2557 creation_feature := Void
2558 end
2559 end
2560
2561 insert_changed_assertion (a_feature: FEATURE_I) is
2562 -- Insert `a_feature' in the melted set
2563 do
2564 add_feature_to_melted_set (a_feature)
2565 Degree_1.insert_class (Current)
2566 end
2567
2568 feature {NONE} -- Implementation
2569
2570 add_feature_to_melted_set (f: FEATURE_I) is
2571 local
2572 melt_set: like melted_set
2573 melted_info: MELTED_INFO
2574 do
2575 melt_set := melted_set
2576 if melt_set = Void then
2577 create melt_set.make (melted_set_chunk)
2578 melted_set := melt_set
2579 end
2580
2581 if f = invariant_feature then
2582 create {INV_MELTED_INFO} melted_info.make (f, Current)
2583 else
2584 create {FEAT_MELTED_INFO} melted_info.make (f, Current)
2585 end
2586 melt_set.force (melted_info)
2587 end
2588
2589 Melted_set_chunk: INTEGER is 20
2590 -- Size of `melted_set' which contains melted features.
2591
2592 feature -- Initialization
2593
2594 initialize (l: like original_class) is
2595 -- Initialization of Current.
2596 require
2597 good_argument: l /= Void
2598 do
2599 original_class := l
2600 l.set_compiled_class (Current)
2601
2602 -- Set `is_class_any' and `is_class_none'
2603 is_class_any := name.is_equal ("ANY")
2604 is_class_none := name.is_equal ("NONE")
2605 -- Creation of the descendant list
2606 create descendants.make (10)
2607 -- Creation of the supplier list
2608 create suppliers.make (2)
2609 -- Creation of the client list
2610 create clients.make (10)
2611 -- Types list creation
2612 create types.make (1)
2613 end
2614
2615 feature -- Properties
2616
2617 original_class: CLASS_I
2618 -- Original lace class
2619 --
2620 -- See `lace_class' for example.
2621
2622 lace_class: like original_class is
2623 -- Lace class (takes overriding into account)
2624 --
2625 -- e.g. Class in cluster c1 and in override o1
2626 --
2627 -- c1.compiled_class = Current
2628 -- o1.compiled_class = Void
2629 -- Current.lace_class = o1
2630 -- Current.original_class = c1
2631 do
2632 Result := original_class.actual_class
2633 end
2634
2635 main_parent: CLASS_C
2636 -- Parent of current class which has most features.
2637
2638 number_of_features: INTEGER
2639 -- Number of features in current class including inherited one.
2640
2641 parents_classes: FIXED_LIST [CLASS_C]
2642 -- Parent classes
2643
2644 need_new_parents: BOOLEAN
2645 -- Does Current need to recompute `parents' and `computed_parents'?
2646
2647 parents: FIXED_LIST [CL_TYPE_A]
2648 -- Parent class types
2649
2650 computed_parents: PARENT_LIST
2651 -- Computed version of parent clauses.
2652
2653 descendants: ARRAYED_LIST [CLASS_C]
2654 -- Direct descendants of the current class
2655
2656 clients: ARRAYED_LIST [CLASS_C]
2657 -- Clients of the class
2658
2659 suppliers: SUPPLIER_LIST
2660 -- Suppliers of the class in terms of calls
2661 -- [Useful for incremental type check].
2662
2663 generics: EIFFEL_LIST [FORMAL_DEC_AS]
2664 -- Formal generical parameters
2665
2666 generic_features: HASH_TABLE [TYPE_FEATURE_I, INTEGER]
2667 -- Collect all possible generic derivations inherited or current.
2668 -- Indexed by `rout_id' of formal generic parmater.
2669 -- Updated during `pass2' of INHERIT_TABLE.
2670
2671 anchored_features: like generic_features
2672 -- Collect all features that are used for creating or doing an assignment
2673 -- attempt in current or in an inherited class.
2674 -- Indexed by `rout_id' of feature on which anchor is done.
2675 -- Updated before each IL code generation.
2676
2677 type_set: SEARCH_TABLE [INTEGER]
2678 -- Set of routine IDs used for anchored type in current class.
2679 -- It does not take into accounts inherited one.
2680
2681 topological_id: INTEGER
2682 -- Unique number for a class. Could change during a topological
2683 -- sort on classes.
2684
2685 is_deferred: BOOLEAN
2686 -- Is class deferred ?
2687
2688 is_interface: BOOLEAN
2689 -- Is class an interface for IL code generation?
2690
2691 is_expanded: BOOLEAN
2692 -- Is class expanded?
2693
2694 is_enum: BOOLEAN
2695 -- Is class an IL enum type?
2696 -- Useful to perform call optimization on enum type in FEATURE_B.
2697
2698 is_basic: BOOLEAN is
2699 -- Is class basic?
2700 do
2701 end
2702
2703 is_single: BOOLEAN
2704 -- Is class generated as a single entity in IL code generation.
2705
2706 has_external_main_parent: BOOLEAN
2707 -- Is one non-external parent class generated as a single IL type?
2708
2709 is_frozen: BOOLEAN is
2710 -- Is class frozen, ie we cannot inherit from it?
2711 do
2712 Result := internal_is_frozen or apply_msil_application_optimizations
2713 end
2714
2715 is_external: BOOLEAN
2716 -- Is class an external one?
2717 -- If yes, we do not generate it.
2718
2719 is_true_external: BOOLEAN is
2720 -- Is class an instance of EXTERNAL_CLASS_C?
2721 -- If yes, we do not generate it.
2722 do
2723 end
2724
2725 obsolete_message: STRING
2726 -- Obsolete message
2727 -- (Void if Current is not obsolete)
2728
2729 custom_attributes, class_custom_attributes, interface_custom_attributes: BYTE_LIST [BYTE_NODE]
2730 -- Associated custom attributes if any.
2731
2732 assembly_custom_attributes: BYTE_LIST [BYTE_NODE]
2733 -- Associated custom attributes for assembly if any.
2734
2735 name: STRING is
2736 -- Class name
2737 do
2738 Result := lace_class.name
2739 end
2740
2741 external_class_name: STRING is
2742 -- External class name.
2743 do
2744 if private_external_name /= Void then
2745 Result := private_external_name
2746 else
2747 Result := name
2748 end
2749 end
2750
2751 text: STRING is
2752 -- Class text
2753 require
2754 valid_file_name: file_name /= Void
2755 do
2756 Result := lace_class.text
2757 end
2758
2759 constraint_classes (a_formal_dec: FORMAL_DEC_AS) : ARRAY [CLASS_C] is
2760 -- Computed constraint classes for every formal of the current class.
2761 -- Only class types are put into this cache so every item in the cache is error free.
2762 -- All other positions are void especially those of formals.
2763 require
2764 a_formal_dec_not_void: a_formal_dec /= Void
2765 valid_formal: a_formal_dec.position <= generics.count
2766 local
2767 l_cache: like constraint_cache
2768 l_formal_cache: like formal_constraint_cache
2769 l_pos: INTEGER
2770 do
2771 -- Check if `constraint_cache' has been created.
2772 l_cache := constraint_cache
2773 if l_cache = Void then
2774 create l_cache.make (generics.count)
2775 constraint_cache := l_cache
2776 end
2777 -- Check if an entry for `a_formal_dec' was created.
2778 l_pos := a_formal_dec.position - 1
2779 l_formal_cache := l_cache.item (l_pos)
2780 if l_formal_cache /= Void then
2781 Result := l_formal_cache.constraint_classes
2782 -- Check if it is Void (case where `constraint_renaming'
2783 -- was already called for `a_formal_dec').
2784 if Result = Void then
2785 create Result.make (1, a_formal_dec.constraints.count)
2786 l_formal_cache.constraint_classes := Result
2787 end
2788 else
2789 -- Insert `a_formal_dec'.
2790 create Result.make (1, a_formal_dec.constraints.count)
2791 l_cache.put ([Result, Void], l_pos)
2792 end
2793 ensure
2794 constraint_classes_not_void: Result /= Void
2795 end
2796
2797 constraint_renaming (a_formal_dec: FORMAL_DEC_AS): ARRAY [RENAMING_A] is
2798 -- Computed renamings for every formal of the current class.
2799 -- Only sane renamings are put into this cache so every item in the cache is error free.
2800 -- All other positions are void especially those of formal constraints as they are not allowed to have renamings.
2801 require
2802 a_formal_dec_not_void: a_formal_dec /= Void
2803 local
2804 l_cache: like constraint_cache
2805 l_formal_cache: like formal_constraint_cache
2806 l_pos: INTEGER
2807 do
2808 -- Check if `constraint_cache' has been created.
2809 l_cache := constraint_cache
2810 if l_cache = Void then
2811 create l_cache.make (generics.count)
2812 constraint_cache := l_cache
2813 end
2814 -- Check if an entry for `a_formal_dec' was created.
2815 l_pos := a_formal_dec.position - 1
2816 l_formal_cache := l_cache.item (l_pos)
2817 if l_formal_cache /= Void then
2818 Result := l_formal_cache.constraint_renaming
2819 -- Check if it is Void (case where `constraint_classes'
2820 -- was already called for `a_formal_dec').
2821 if Result = Void then
2822 create Result.make (1, a_formal_dec.constraints.count)
2823 l_formal_cache.constraint_renaming := Result
2824 end
2825 else
2826 -- Insert `a_formal_dec'.
2827 create Result.make (1, a_formal_dec.constraints.count)
2828 l_cache.put ([Void, Result], l_pos)
2829 end
2830 ensure
2831 constraint_renaming_not_void: Result /= Void
2832 end
2833
2834 feature {NONE} -- Implementation: Properties
2835
2836 constraint_cache: SPECIAL [like formal_constraint_cache]
2837 -- To store computed information about generic constraints of Current.
2838
2839 formal_constraint_cache: TUPLE [
2840 constraint_classes: ARRAY [CLASS_C];
2841 constraint_renaming: ARRAY [RENAMING_A]]
2842 is
2843 -- For easy type checking of `constraint_cache'.
2844 do
2845 end
2846
2847 constrained_type_cache: SPECIAL [TYPE_A]
2848 -- Constraining type for each given formal, if there exists one
2849
2850 constrained_types_cache: SPECIAL [TYPE_SET_A]
2851 -- Constraining types for each given formal
2852 --| In case someone requests a type set for a single constraint this is just fine.
2853 --| That is why we have two caches.
2854
2855 feature -- IL code generation
2856
2857 il_data_name: STRING is
2858 -- IL class name of class data
2859 require
2860 not_is_external: not is_external
2861 local
2862 namespace: STRING
2863 class_name: STRING
2864 use_dotnet_naming: BOOLEAN
2865 do
2866 if is_precompiled then
2867 namespace := precompiled_namespace
2868 class_name := precompiled_class_name
2869 use_dotnet_naming := is_dotnet_naming
2870 else
2871 namespace := original_class.actual_namespace
2872 class_name := name.as_lower
2873 use_dotnet_naming := System.dotnet_naming_convention
2874 end
2875 Result := il_casing.type_name (namespace, data_prefix, class_name, use_dotnet_naming)
2876 ensure
2877 result_not_void: Result /= Void
2878 end
2879
2880 set_il_name is
2881 -- Store basic information that will help us reconstruct
2882 -- a complete name.
2883 require
2884 not_is_precompiled: not is_precompiled
2885 do
2886 is_dotnet_naming := System.dotnet_naming_convention
2887 precompiled_namespace := original_class.actual_namespace.twin
2888 precompiled_class_name := il_casing.type_name (Void, Void, name.as_lower, is_dotnet_naming)
2889 end
2890
2891 is_dotnet_naming: BOOLEAN
2892 -- Is current class being generated using dotnet naming convention?
2893
2894 feature {NONE} -- IL code generation
2895
2896 precompiled_namespace: STRING
2897 -- Namespace of this class when it is precompiled
2898
2899 precompiled_class_name: STRING
2900 -- Name of this class when it is precompiled
2901
2902 data_prefix: STRING is "Data"
2903 -- Prefix in a name of class data
2904
2905 feature -- status
2906
2907 hash_code: INTEGER is
2908 -- Hash code value corresponds to `class_id'.
2909 do
2910 Result := class_id
2911 end
2912
2913 feature {CLASS_I} -- Settings
2914
2915 set_original_class (cl: like original_class) is
2916 -- Assign `cl' to `lace_class'.
2917 require
2918 cl_not_void: cl /= Void
2919 cl_different_from_current_lace_class: cl /= original_class
2920 do
2921 original_class := cl
2922 ensure
2923 original_class_set: original_class = cl
2924 end
2925
2926 feature -- Access
2927
2928 has_multi_constraints (i: INTEGER): BOOLEAN is
2929 -- Does i-th generic parameter have multiple constraints?
2930 require
2931 has_generics: generics /= Void
2932 local
2933 l_formal_dec: FORMAL_CONSTRAINT_AS
2934 do
2935 l_formal_dec ?= generics.i_th (i)
2936 check l_formal_dec_not_void: l_formal_dec /= Void end
2937 Result := l_formal_dec.has_multi_constraints
2938 end
2939
2940 is_fully_deferred: BOOLEAN is
2941 -- Are parents of current class either ANY or a fully deferred class?
2942 -- Does current class contain only deferred features?
2943 require
2944 has_feature_table: has_feature_table
2945 parents_classes_not_void: parents_classes /= Void
2946 local
2947 feat: FEATURE_I
2948 feat_tbl: FEATURE_TABLE
2949 written_in: INTEGER
2950 par: like parents_classes
2951 do
2952 Result := True
2953 -- FIXME: Manu 1/21/2002: Test below is not the most correct one.
2954 if class_id > 1 then
2955 Result := is_deferred
2956 if Result then
2957 from
2958 par := parents_classes
2959 par.start
2960 until
2961 par.after or else not Result
2962 loop
2963 Result := Result and then par.item.is_fully_deferred
2964 par.forth
2965 end
2966 if Result then
2967 from
2968 written_in := class_id
2969 feat_tbl := feature_table
2970 feat_tbl.start
2971 until
2972 feat_tbl.after or else not Result
2973 loop
2974 feat := feat_tbl.item_for_iteration
2975 if feat.written_in = written_in then
2976 Result := Result and then feat.is_deferred
2977 end
2978 feat_tbl.forth
2979 end
2980 end
2981 end
2982 end
2983 end
2984
2985 name_in_upper: STRING is
2986 -- Class name in upper case
2987 do
2988 Result := name
2989 ensure
2990 name_in_upper_not_void: Result /= Void
2991 end
2992
2993 ast: CLASS_AS is
2994 -- Associated AST structure
2995 do
2996 if Tmp_ast_server.has (class_id) then
2997 Result := Tmp_ast_server.item (class_id)
2998 elseif Ast_server.has (class_id) then
2999 Result := Ast_server.item (class_id)
3000 end
3001 ensure
3002 non_void_result_if: has_ast implies Result /= Void
3003 end
3004
3005 invariant_ast: INVARIANT_AS is
3006 -- Associated invariant AST structure
3007 do
3008 if invariant_feature /= Void then
3009 Result := Inv_ast_server.item (class_id)
3010 end
3011 end
3012
3013 has_types: BOOLEAN is
3014 -- Are there any generic instantiations of Current
3015 -- in the system or is Current a non generic class?
3016 do
3017 Result := (types /= Void) and then (not types.is_empty)
3018 end
3019
3020 is_obsolete: BOOLEAN is
3021 -- Is Current feature obsolete?
3022 do
3023 Result := obsolete_message /= Void
3024 end
3025
3026 feature_with_name_id (a_feature_name_id: INTEGER): E_FEATURE is
3027 -- Feature whose internal name is `n'
3028 require
3029 valid_a_feature_name_id: a_feature_name_id > 0
3030 has_feature_table: has_feature_table
3031 local
3032 f: FEATURE_I
3033 do
3034 f := feature_table.item_id (a_feature_name_id)
3035 if f /= Void then
3036 Result := f.api_feature (class_id)
3037 end
3038 end
3039
3040 feature_with_id (a_feature_id: ID_AS): E_FEATURE is
3041 -- Feature whose internal name is `n'
3042 require
3043 valid_a_feature_id: a_feature_id /= Void
3044 has_feature_table: has_feature_table
3045 local
3046 f: FEATURE_I
3047 do
3048 f := feature_table.item_id (a_feature_id.name_id)
3049 if f /= Void then
3050 Result := f.api_feature (class_id)
3051 end
3052 end
3053
3054 feature_with_name (n: STRING): E_FEATURE is
3055 -- Feature whose internal name is `n'
3056 require
3057 valid_n: n /= Void
3058 has_feature_table: has_feature_table
3059 local
3060 f: FEATURE_I
3061 do
3062 f := feature_table.item (n)
3063 if f /= Void then
3064 Result := f.api_feature (class_id)
3065 end
3066 end
3067
3068 feature_with_rout_id (rout_id: INTEGER): E_FEATURE is
3069 -- Feature whose routine id `rout_id'.
3070 require
3071 valid_rout_id: rout_id /= 0
3072 has_feature_table: has_feature_table
3073 local
3074 feat: FEATURE_I
3075 do
3076 feat := feature_table.feature_of_rout_id (rout_id)
3077 if feat /= Void then
3078 Result := feat.api_feature (class_id)
3079 end
3080 end
3081
3082 feature_i_with_body_index (a_body_index: INTEGER): FEATURE_I is
3083 -- Feature whose body index is `a_body_index'.
3084 require
3085 a_body_index_non_negative: a_body_index >= 0
3086 has_feature_table: has_feature_table
3087 do
3088 Result := feature_table.feature_of_body_index (a_body_index)
3089 end
3090
3091 feature_with_body_index (a_body_index: INTEGER): E_FEATURE is
3092 -- Feature whose body index is `a_body_index'.
3093 require
3094 a_body_index_non_negative: a_body_index >= 0
3095 has_feature_table: has_feature_table
3096 local
3097 l_feat: FEATURE_I
3098 do
3099 l_feat := feature_table.feature_of_body_index (a_body_index)
3100 if l_feat /= Void then
3101 Result := l_feat.api_feature (class_id)
3102 end
3103 end
3104
3105 feature_with_feature_id (a_feature_id: INTEGER): E_FEATURE is
3106 -- Feature whose feature id `a_feature_id.
3107 require
3108 feature_id_non_negative: a_feature_id >= 0
3109 has_feature_table: has_feature_table
3110 local
3111 l_feat: FEATURE_I
3112 do
3113 l_feat := feature_table.feature_of_feature_id (a_feature_id)
3114 if l_feat /= Void then
3115 Result := l_feat.api_feature (class_id)
3116 end
3117 end
3118
3119 feature_of_rout_id (a_routine_id: INTEGER): FEATURE_I is
3120 -- Feature whose routine_id is `a_routine_id'.
3121 -- Look into `feature_table', `generic_features' and
3122 -- `anchored_features'.
3123 require
3124 rout_id_valid: a_routine_id > 0
3125 has_feature_table: has_feature_table
3126 local
3127 l_cursor: CURSOR
3128 l_anch: like anchored_features
3129 l_gen: like generic_features
3130 do
3131 Result := feature_table.feature_of_rout_id (a_routine_id)
3132 if Result = Void then
3133 l_anch := anchored_features
3134 if l_anch /= Void then
3135 from
3136 l_cursor := l_anch.cursor
3137 l_anch.start
3138 until
3139 l_anch.after or Result /= Void
3140 loop
3141 if l_anch.item_for_iteration.rout_id_set.has (a_routine_id) then
3142 Result := l_anch.item_for_iteration
3143 end
3144 l_anch.forth
3145 end
3146 l_anch.go_to (l_cursor)
3147 end
3148 l_gen := generic_features
3149 if Result = Void and l_gen /= Void then
3150 from
3151 l_cursor := l_gen.cursor
3152 l_gen.start
3153 until
3154 l_gen.after or Result /= Void
3155 loop
3156 if l_gen.item_for_iteration.rout_id_set.has (a_routine_id) then
3157 Result := l_gen.item_for_iteration
3158 end
3159 l_gen.forth
3160 end
3161 l_gen.go_to (l_cursor)
3162 end
3163 end
3164 end
3165
3166 feature_of_feature_id (a_feature_id: INTEGER): FEATURE_I is
3167 -- Feature whose feature_id is `a_feature_id'.
3168 -- Look into `feature_table', `generic_features' and
3169 -- `anchored_features'.
3170 require
3171 rout_id_valid: a_feature_id > 0
3172 has_feature_table: has_feature_table
3173 local
3174 l_cursor: CURSOR
3175 l_anch: like anchored_features
3176 l_gen: like generic_features
3177 do
3178 Result := feature_table.feature_of_feature_id (a_feature_id)
3179 if Result = Void then
3180 l_anch := anchored_features
3181 if l_anch /= Void then
3182 from
3183 l_cursor := l_anch.cursor
3184 l_anch.start
3185 until
3186 l_anch.after or Result /= Void
3187 loop
3188 if l_anch.item_for_iteration.feature_id = a_feature_id then
3189 Result := l_anch.item_for_iteration
3190 end
3191 l_anch.forth
3192 end
3193 l_anch.go_to (l_cursor)
3194 end
3195 l_gen := generic_features
3196 if Result = Void and l_gen /= Void then
3197 from
3198 l_cursor := l_gen.cursor
3199 l_gen.start
3200 until
3201 l_gen.after or Result /= Void
3202 loop
3203 if l_gen.item_for_iteration.feature_id = a_feature_id then
3204 Result := l_gen.item_for_iteration
3205 end
3206 l_gen.forth
3207 end
3208 l_gen.go_to (l_cursor)
3209 end
3210 end
3211 end
3212
3213 feature_of_name_id (a_name_id: INTEGER): FEATURE_I is
3214 -- Feature whose feature_id is `a_feature_id'.
3215 -- Look into `feature_table', `generic_features' and
3216 -- `anchored_features'.
3217 require
3218 a_name_id: a_name_id > 0
3219 has_feature_table: has_feature_table
3220 do
3221 Result := feature_table.item_id (a_name_id)
3222 end
3223
3224 api_feature_table: E_FEATURE_TABLE is
3225 -- Feature table for current class
3226 --| Can be Void when `feature_table' has not yet
3227 --| been computed (for example, error at degree 5).
3228 do
3229 if feature_table /= Void then
3230 Result := feature_table.api_table
3231 end
3232 end
3233
3234 once_functions: SORTED_TWO_WAY_LIST [E_FEATURE] is
3235 -- List of once functions.
3236 local
3237 f_table: FEATURE_TABLE
3238 feat: FEATURE_I
3239 cid: INTEGER
3240 do
3241 cid := class_id
3242 create Result.make
3243 f_table := feature_table
3244 from
3245 f_table.start
3246 until
3247 f_table.after
3248 loop
3249 feat := f_table.item_for_iteration
3250 if feat.is_once and then feat.is_function then
3251 Result.put_front (feat.api_feature (cid))
3252 end
3253 f_table.forth
3254 end
3255 Result.sort
3256 ensure
3257 non_void_result: Result /= Void
3258 result_sorted: Result.sorted
3259 end
3260
3261 once_routines: SORTED_TWO_WAY_LIST [E_FEATURE] is
3262 -- List of once features (functions and procedures).
3263 local
3264 f_table: FEATURE_TABLE
3265 feat: FEATURE_I
3266 cid: INTEGER
3267 do
3268 cid := class_id
3269 create Result.make
3270 f_table := feature_table
3271 from
3272 f_table.start
3273 until
3274 f_table.after
3275 loop
3276 feat := f_table.item_for_iteration
3277 if feat.is_once then
3278 Result.put_front (feat.api_feature (cid))
3279 end
3280 f_table.forth
3281 end
3282 Result.sort
3283 ensure
3284 non_void_result: Result /= Void
3285 result_sorted: Result.sorted
3286 end
3287
3288 is_valid: BOOLEAN is
3289 -- Is the current class valid?
3290 -- (After a compilation Current may become
3291 -- invalid)
3292 do
3293 Result := class_id > 0 and then lace_class.is_valid and then class_id <= System.classes.array_count
3294 and then System.class_of_id (class_id) = Current
3295 end
3296
3297 written_in_features: LIST [E_FEATURE] is
3298 -- List of features defined in current class
3299 require
3300 has_feature_table: has_feature_table
3301 do
3302 Result := feature_table.written_in_features
3303 ensure
3304 non_void_Result: Result /= Void
3305 end
3306
3307 is_class_any: BOOLEAN
3308 -- Is it class ANY?
3309
3310 is_class_none: BOOLEAN
3311 -- Is it class NONE?
3312
3313 feature -- Precompilation Access
3314
3315 is_precompiled: BOOLEAN is
3316 -- Is class precompiled?
3317 do
3318 Result := System.class_counter.is_precompiled (class_id)
3319 end
3320
3321 feature -- Server Access
3322
3323 has_ast: BOOLEAN is
3324 -- Does Current class have an AST structure?
3325 do
3326 Result := Ast_server.has (class_id) or else Tmp_ast_server.has (class_id)
3327 end
3328
3329 group: CONF_GROUP is
3330 -- Cluster to which the class belongs to
3331 do
3332 Result := lace_class.group
3333 ensure
3334 group_not_void: Result /= Void
3335 end
3336
3337 file_name: STRING is
3338 -- File name of the class
3339 do
3340 Result := lace_class.file_name
3341 ensure
3342 file_name_not_void: Result /= Void
3343 end
3344
3345 file_is_readable: BOOLEAN is
3346 -- Is file with `file_name' readable?
3347 local
3348 f: PLAIN_TEXT_FILE
3349 do
3350 create f.make (file_name)
3351 Result := f.exists and f.is_readable
3352 end
3353
3354 feature -- Comparison
3355
3356 infix "<" (other: like Current): BOOLEAN is
3357 -- Order relation on classes
3358 do
3359 Result := topological_id < other.topological_id
3360 end
3361
3362 feature -- Output
3363
3364 class_signature: STRING is
3365 -- Signature of class
3366 local
3367 formal_dec: FORMAL_DEC_AS
3368 old_group: CONF_GROUP
3369 gens: like generics
3370 do
3371 create Result.make (50)
3372 Result.append (name)
3373 gens := generics
3374 if gens /= Void then
3375 old_group := Inst_context.group
3376 Inst_context.set_group (group)
3377 Result.append (" [")
3378 from
3379 gens.start
3380 until
3381 gens.after
3382 loop
3383 formal_dec := gens.item
3384 Result.append (formal_dec.constraint_string)
3385 gens.forth
3386 if not gens.after then
3387 Result.append (", ")
3388 end
3389 end
3390 Inst_context.set_group (old_group)
3391 Result.append ("]")
3392 end
3393 ensure
3394 class_signature_not_void: Result /= Void
3395 end
3396
3397 append_header (a_text_formatter: TEXT_FORMATTER) is
3398 -- Append class header to `a_text_formatter'.
3399 do
3400 if is_expanded then
3401 a_text_formatter.process_keyword_text (ti_Expanded_keyword, Void)
3402 a_text_formatter.add_space
3403 elseif is_deferred then
3404 a_text_formatter.process_keyword_text (ti_Deferred_keyword, Void)
3405 a_text_formatter.add_space
3406 end
3407 a_text_formatter.process_keyword_text (ti_Class_keyword, Void)
3408 a_text_formatter.add_new_line
3409 a_text_formatter.add_indent
3410 append_signature (a_text_formatter, False)
3411 a_text_formatter.add_new_line
3412 end
3413
3414 append_signature (a_text_formatter: TEXT_FORMATTER; a_with_deferred_symbol: BOOLEAN) is
3415 -- Append the signature of current class in `a_text_formatter'. If `a_with_deferred_symbol'
3416 -- then add a `*' to the class name.
3417 require
3418 non_void_st: a_text_formatter /= Void
3419 do
3420 append_signature_internal (a_text_formatter, a_with_deferred_symbol, False)
3421 end
3422
3423 append_short_signature (a_text_formatter: TEXT_FORMATTER; a_with_deferred_symbol: BOOLEAN) is
3424 -- Append short signature of current class in `a_text_formatter'.
3425 -- Short signature is to use "..." to replace constrained generic type, so
3426 -- class {HASH_TABLE [G, H -> HASHABLE]} becomes {HASH_TABLE [G, H -> ...]}.
3427 -- Short signature is used to save some display space.
3428 -- If `a_with_deferred_symbol' then add a `*' to the class name.
3429 require
3430 non_void_st: a_text_formatter /= Void
3431 do
3432 append_signature_internal (a_text_formatter, a_with_deferred_symbol, True)
3433 end
3434
3435 append_name (a_text_formatter: TEXT_FORMATTER) is
3436 -- Append the name ot the current class in `a_text_formatter'
3437 require
3438 non_void_st: a_text_formatter /= Void
3439 do
3440 a_text_formatter.add_class (lace_class)
3441 end
3442
3443 feature {COMPILER_EXPORTER} -- Setting
3444
3445 set_main_parent (cl: like main_parent) is
3446 -- Assign `cl' to `main_parent'.
3447 require
3448 cl_not_void: cl /= Void
3449 il_generation: System.il_generation
3450 do
3451 main_parent := cl
3452 ensure
3453 main_parent_set: main_parent = cl
3454 end
3455
3456 set_number_of_features (n: like number_of_features) is
3457 -- Assign `n' to `number_of_features'.
3458 do
3459 number_of_features := n
3460 ensure
3461 number_of_features_set: number_of_features = n
3462 end
3463
3464 set_topological_id (i: INTEGER) is
3465 -- Assign `i' to `topological_id'.
3466 do
3467 topological_id := i
3468 ensure
3469 topological_id_set: topological_id = i
3470 end
3471
3472 set_is_deferred (b: BOOLEAN) is
3473 -- Assign `b' to `is_deferred'.
3474 do
3475 is_deferred := b
3476 ensure
3477 is_deferred_set: is_deferred = b
3478 end
3479
3480 set_is_expanded (b: BOOLEAN) is
3481 -- Assign `b' to `is_expanded'.
3482 do
3483 is_expanded := b
3484 ensure
3485 is_expanded_set: is_expanded = b
3486 end
3487
3488 set_is_enum (b: BOOLEAN) is
3489 -- Assign `b' to `is_enum'.
3490 require
3491 il_generation: System.il_generation
3492 do
3493 is_enum := b
3494 ensure
3495 is_enum_set: is_enum = b
3496 end
3497
3498 set_suppliers (s: like suppliers) is
3499 -- Assign `s' to `suppliers'.
3500 do
3501 suppliers := s
3502 ensure
3503 suppliers_set: suppliers = s
3504 end
3505
3506 set_generics (g: like generics) is
3507 -- Assign `g' to `generics'.
3508 do
3509 generics := g
3510 if g /= Void then
3511 create constrained_type_cache.make (g.count)
3512 create constrained_types_cache.make (g.count)
3513 end
3514 ensure
3515 generics_set: generics = g
3516 end
3517
3518 set_obsolete_message (m: like obsolete_message) is
3519 -- Set `obsolete_message' to `m'.
3520 do
3521 obsolete_message := m
3522 ensure
3523 obsolete_message_set: obsolete_message = m
3524 end
3525
3526 set_generic_features (f: like generic_features) is
3527 -- Set `generic_features' to `f'.
3528 require
3529 f_not_void: f /= Void
3530 do
3531 generic_features := f
3532 ensure
3533 generic_features_set: generic_features = f
3534 end
3535
3536 feature -- Genericity
3537
3538 invalidate_caches_related_to_generics
3539 -- Invalidates the cache which stores computed renamings
3540 do
3541 constraint_cache := Void
3542 ensure
3543 constraint_cache_void: constraint_cache = Void
3544 end
3545
3546 formal_at_position (n: INTEGER): TYPE_FEATURE_I is
3547 -- Find first TYPE_FEATURE_I in `generic_features' that
3548 -- matches position `n'.
3549 require
3550 has_formal: is_generic
3551 generic_features_computed: generic_features /= Void
3552 local
3553 l_formals: like generic_features
3554 l_formal: FORMAL_A
3555 l_cursor: CURSOR
3556 do
3557 from
3558 l_formals := generic_features
3559 l_cursor := l_formals.cursor
3560 l_formals.start
3561 until
3562 l_formals.after or Result /= Void
3563 loop
3564 l_formal ?= l_formals.item_for_iteration.type
3565 if l_formal /= Void and then l_formal.position = n then
3566 Result := l_formals.item_for_iteration
3567 end
3568 l_formals.forth
3569 end
3570 l_formals.go_to (l_cursor)
3571 ensure
3572 result_not_void: Result /= Void
3573 end
3574
3575 update_generic_features is
3576 -- Update `generic_features' with information of Current.
3577 require
3578 parents_not_void: parents /= Void
3579 local
3580 l_parents: like parents
3581 l_formal, l_parent_formal: TYPE_FEATURE_I
3582 l_formal_type: FORMAL_A
3583 l_generic_features, l_old: like generic_features
3584 l_inherited_formals: SEARCH_TABLE [INTEGER]
3585 l_rout_id_set: ROUT_ID_SET
3586 i, nb: INTEGER
3587 l_formal_dec: FORMAL_DEC_AS
3588 do
3589 -- Clean previously stored information.
3590 l_old := generic_features
3591 generic_features := Void
3592
3593 -- Collect all information about parent formal generic parameters.
3594 from
3595 l_parents := parents
3596 l_parents.start
3597 until
3598 l_parents.after
3599 loop
3600 l_generic_features := l_parents.item.associated_class.generic_features
3601 if l_generic_features /= Void then
3602 from
3603 l_generic_features.start
3604 until
3605 l_generic_features.after
3606 loop
3607 -- Extract parent generic parameter and perform instantiation
3608 -- in current class.
3609 l_parent_formal := l_generic_features.item_for_iteration
3610 l_formal := l_parent_formal.duplicate
3611 l_formal.set_type (l_formal.type.instantiated_in (l_parents.item))
3612 l_formal.set_is_origin (False)
3613 if l_old /= Void and then l_old.has (l_formal.rout_id_set.first) then
3614 l_formal.set_feature_id (
3615 l_old.item (l_formal.rout_id_set.first).feature_id)
3616 else
3617 l_formal.set_feature_id (feature_id_counter.next)
3618 end
3619 l_formal.set_origin_feature_id (l_parent_formal.origin_feature_id)
3620
3621 if not l_formal.type.same_as (l_parent_formal.type) then
3622 -- If there is an implicit type change of the formal
3623 -- generic parameter, then we need to generate
3624 -- a new body for specifying the new type of the formal
3625 -- generic parameter.
3626 l_formal.set_written_in (class_id)
3627 end
3628
3629 extend_generic_features (l_formal)
3630 l_generic_features.forth
3631 end
3632 end
3633 l_parents.forth
3634 end
3635
3636 l_generic_features := generic_features
3637
3638 if is_generic then
3639 create l_inherited_formals.make (generics.count)
3640 if l_generic_features = Void then
3641 create l_generic_features.make (generics.count)
3642 generic_features := l_generic_features
3643 else
3644 from
3645 l_generic_features.start
3646 until
3647 l_generic_features.after
3648 loop
3649 l_formal := l_generic_features.item_for_iteration
3650 if l_formal.is_formal then
3651 l_formal_type ?= l_formal.type
3652 l_inherited_formals.put (l_formal_type.position)
3653 end
3654 l_generic_features.forth
3655 end
3656 end
3657
3658 from
3659 i := 1
3660 nb := generics.count
3661 until
3662 i > nb
3663 loop
3664 if not l_inherited_formals.has (i) then
3665 l_formal_dec := generics.i_th (i)
3666 create l_formal_type.make (l_formal_dec.is_reference,
3667 l_formal_dec.is_expanded, l_formal_dec.is_monomorph, i)
3668
3669 create l_formal
3670 l_formal.set_feature_name ("_" + name + "_Formal#" + i.out)
3671 l_formal.set_type (l_formal_type)
3672 l_formal.set_written_in (class_id)
3673 l_formal.set_origin_class_id (class_id)
3674
3675 create l_rout_id_set.make
3676 l_rout_id_set.put (l_formal.new_rout_id)
3677 l_formal.set_rout_id_set (l_rout_id_set)
3678 l_formal.set_is_origin (True)
3679 l_formal.set_position (i)
3680
3681 if l_old /= Void and then l_old.has (l_rout_id_set.first) then
3682 l_formal.set_feature_id (
3683 l_old.item (l_formal.rout_id_set.first).feature_id)
3684 else
3685 l_formal.set_feature_id (feature_id_counter.next)
3686 end
3687 l_formal.set_origin_feature_id (l_formal.feature_id)
3688
3689 l_generic_features.put (l_formal, l_rout_id_set.first)
3690 end
3691 i := i + 1
3692 end
3693 else
3694 -- FIXME: Manu 01/02/2002. Add assertion that shows
3695 -- that all TYPE_FEATURE_I.type of `l_generic_features'
3696 -- are not instances of FORMAL_I.
3697 end
3698
3699 debug ("FORMAL_GENERIC")
3700 if l_generic_features /= Void then
3701 print ("%NFor class " + name + ": " + l_generic_features.count.out)
3702 print (" local + inherited generic parameters%N")
3703 end
3704 end
3705 end
3706
3707 feature {NONE} -- Genericity
3708
3709 extend_generic_features (an_item: TYPE_FEATURE_I) is
3710 -- Insert `an_item' in `generic_features'. If `generic_features'
3711 -- is not yet created, creates it.
3712 require
3713 an_item_not_void: an_item /= Void
3714 local
3715 l_generic_features: like generic_features
3716 l_rout_id_set: ROUT_ID_SET
3717 l_rout_id, i, nb: INTEGER
3718 do
3719 l_generic_features := generic_features
3720 if l_generic_features = Void then
3721 create l_generic_features.make (5)
3722 generic_features := l_generic_features
3723 end
3724
3725 from
3726 l_rout_id_set := an_item.rout_id_set
3727 i := 1
3728 nb := l_rout_id_set.count
3729 until
3730 i > nb
3731 loop
3732 l_rout_id := l_rout_id_set.item (i)
3733 if not l_generic_features.has (l_rout_id) then
3734 l_generic_features.put (an_item, l_rout_id)
3735 else
3736 -- Should we report an error in this case, as it is not
3737 -- well implemented by compiler? Meaning that we have
3738 -- some repeated inheritance of generic parameters.
3739 end
3740
3741 i := i + 1
3742 end
3743 end
3744
3745 feature -- Anchored types
3746
3747 update_anchors is
3748 -- Update `anchored_features' with information of Current.
3749 require
3750 il_generation: System.il_generation
3751 local
3752 l_feat_tbl: like feature_table
3753 l_anchor, l_previous_anchor: TYPE_FEATURE_I
3754 l_anchored_features, l_old: like anchored_features
3755 l_inherited_features: like anchored_features
3756 l_parents: like parents_classes
3757 l_feat: FEATURE_I
3758 l_rout_id: INTEGER
3759 l_rout_id_set: ROUT_ID_SET
3760 l_type_set: SEARCH_TABLE [INTEGER]
3761 l_select: SELECT_TABLE
3762 l_type: TYPE_A
3763 do
3764 -- Get all inherited anchored features.
3765 from
3766 create l_inherited_features.make (0)
3767 l_parents := parents_classes
3768 l_parents.start
3769 until
3770 l_parents.after
3771 loop
3772 l_old := l_parents.item.anchored_features
3773 if l_old /= Void then
3774 l_inherited_features.merge (l_old)
3775 end
3776 l_parents.forth
3777 end
3778
3779 -- Initialize `l_type_set'
3780 from
3781 l_feat_tbl := feature_table
3782 l_type_set := type_set
3783 l_feat_tbl.start
3784 until
3785 l_feat_tbl.after
3786 loop
3787 l_feat := l_feat_tbl.item_for_iteration
3788 if l_feat.is_attribute then
3789 l_type := l_feat.type.actual_type
3790 if l_type.is_formal or l_type.has_generics then
3791 if l_type_set = Void then
3792 create l_type_set.make (5)
3793 end
3794 l_type_set.put (l_feat.rout_id_set.first)
3795 end
3796 end
3797 l_feat_tbl.forth
3798 end
3799
3800 -- Create `anchored_features' if needed and fill it with inherited
3801 -- anchors.
3802 from
3803 l_old := anchored_features
3804 create l_anchored_features.make (10)
3805 l_select := l_feat_tbl.origin_table
3806 l_select.start
3807 until
3808 l_select.after
3809 loop
3810 l_rout_id := l_select.key_for_iteration
3811 if
3812 (l_type_set /= Void and then l_type_set.has (l_rout_id)) or
3813 l_inherited_features.has (l_rout_id)
3814 then
3815 l_feat := l_select.item_for_iteration
3816
3817 create l_anchor
3818 l_anchor.set_type (l_feat.type.actual_type)
3819 l_anchor.set_written_in (class_id)
3820
3821 create l_rout_id_set.make
3822 l_rout_id_set.put (l_rout_id)
3823 l_anchor.set_rout_id_set (l_rout_id_set)
3824
3825 if l_old /= Void and then l_old.has (l_rout_id) then
3826 l_anchor.set_feature_id (l_old.item (l_rout_id).feature_id)
3827 else
3828 l_anchor.set_feature_id (feature_id_counter.next)
3829 end
3830
3831 if l_inherited_features.has (l_rout_id) then
3832 l_previous_anchor := l_inherited_features.item (l_rout_id)
3833 l_anchor.set_origin_class_id (l_previous_anchor.origin_class_id)
3834 l_anchor.set_origin_feature_id (l_previous_anchor.origin_feature_id)
3835 l_anchor.set_feature_name_id (l_previous_anchor.feature_name_id, 0)
3836 l_anchor.set_is_origin (False)
3837 else
3838 l_anchor.set_is_origin (True)
3839 l_anchor.set_origin_class_id (class_id)
3840 l_anchor.set_origin_feature_id (l_anchor.feature_id)
3841 l_anchor.set_feature_name ("_" + System.name + "_type_" + l_rout_id.out)
3842 end
3843
3844 l_anchored_features.put (l_anchor, l_rout_id)
3845 end
3846 l_select.forth
3847 end
3848
3849 debug ("ANCHORED_FEATURES")
3850 if l_anchored_features /= Void then
3851 print ("%NFor class " + name + ": " + l_anchored_features.count.out)
3852 print (" local + inherited generic parameters%N")
3853 end
3854 end
3855
3856 anchored_features := l_anchored_features
3857 end
3858
3859 extend_type_set (r_id: INTEGER) is
3860 -- Extend `type_set' with `r_id'. If `type_set' is
3861 -- not yet created, creates it.
3862 require
3863 valid_routine_id: r_id > 0
3864 il_generation: System.il_generation
3865 local
3866 l_type_set: like type_set
3867 do
3868 l_type_set := type_set
3869 if l_type_set = Void then
3870 create l_type_set.make (10)
3871 type_set := l_type_set
3872 end
3873 l_type_set.force (r_id)
3874 ensure
3875 inserted: type_set.has (r_id)
3876 end
3877
3878 feature -- Implementation
3879
3880 invariant_feature: INVARIANT_FEAT_I
3881 -- Invariant feature
3882
3883 types: TYPE_LIST
3884 -- Meta-class types associated to the class: it contains
3885 -- only one type if the class is not generic
3886
3887 feature_named (n: STRING): FEATURE_I is
3888 -- Feature whose internal name is `n'
3889 require
3890 n_not_void: n /= Void
3891 do
3892 if not n.is_empty and then has_feature_table then
3893 if feature_table.is_mangled_alias_name (n) then
3894 -- Lookup for alias feature
3895 Result := feature_table.alias_item (n)
3896 else
3897 -- Lookup for identifier feature
3898 Result := feature_table.item (n)
3899 end
3900 end
3901 end
3902
3903 feature -- Implementation
3904
3905 feature_table: FEATURE_TABLE is
3906 -- Compiler feature table
3907 require
3908 has_feature_table: has_feature_table
3909 do
3910 Result := Feat_tbl_server.item (class_id)
3911 ensure
3912 valid_result: Result /= Void
3913 end
3914
3915 has_feature_table: BOOLEAN is
3916 -- Has Current a feature table
3917 do
3918 Result := Feat_tbl_server.has (class_id)
3919 end
3920
3921 feature {NONE} -- Implementation
3922
3923 private_external_name: STRING
3924 -- Store class alias name clause value.
3925
3926 private_base_file_name: STRING
3927 -- Base file name used in code generation.
3928
3929 feature {DEGREE_5} -- Degree 5
3930
3931 add_to_degree_5 is
3932 -- Add current class to Degree 5.
3933 do
3934 degree_5_needed := True
3935 ensure
3936 added: degree_5_needed
3937 end
3938
3939 remove_from_degree_5 is
3940 -- Remove current class from Degree 5.
3941 do
3942 degree_5_needed := False
3943 parsing_needed := False
3944 ensure
3945 removed: not degree_5_needed
3946 end
3947
3948 degree_5_needed: BOOLEAN
3949 -- Does current class need to be
3950 -- processed in Degree 5?
3951
3952 parsing_needed: BOOLEAN
3953 -- Does current class need to be
3954 -- parsed during Degree 5?
3955
3956 set_parsing_needed (b: BOOLEAN) is
3957 -- Set `parsing_needed' to `b'.
3958 do
3959 parsing_needed := b
3960 ensure
3961 parsing_needed_set: parsing_needed = b
3962 end
3963
3964 feature {DEGREE_4, NAMED_TUPLE_TYPE_A} -- Degree 4
3965
3966 add_to_degree_4 is
3967 -- Add current class to Degree 4.
3968 do
3969 degree_4_needed := True
3970 ensure
3971 added: degree_4_needed
3972 end
3973
3974 remove_from_degree_4 is
3975 -- Remove current class from Degree 4.
3976 do
3977 degree_4_needed := False
3978 degree_4_processed := False
3979 expanded_modified := False
3980 deferred_modified := False
3981 supplier_status_modified := False
3982 ensure
3983 removed: not degree_4_needed
3984 end
3985
3986 degree_4_needed: BOOLEAN
3987 -- Does current class need to be
3988 -- processed in Degree 4?
3989
3990 degree_4_processed: BOOLEAN
3991 -- Has current class been processed in
3992 -- first pass of Degree 4?
3993
3994 expanded_modified: BOOLEAN
3995 -- Has the expanded status of current
3996 -- class been modified?
3997
3998 supplier_status_modified: BOOLEAN
3999 -- Has the status of a supplier changed?
4000
4001 set_degree_4_processed is
4002 -- Set `degree_4_processed' to True.
4003 do
4004 degree_4_processed := True
4005 ensure
4006 degree_4_processed_set: degree_4_processed
4007 end
4008
4009 set_expanded_modified is
4010 -- Set `expanded_modifed' to True.
4011 do
4012 expanded_modified := True
4013 ensure
4014 expanded_modified_set: expanded_modified
4015 end
4016
4017 set_deferred_modified is
4018 -- Set `deferred_modified' to True.
4019 do
4020 deferred_modified := True
4021 ensure
4022 deferred_modified_set: deferred_modified
4023 end
4024
4025 set_supplier_status_modified is
4026 -- Set `supplier_status_modified' to True.
4027 do
4028 supplier_status_modified := True
4029 ensure
4030 supplier_status_modified_set: supplier_status_modified
4031 end
4032
4033 feature {DEGREE_4, INHERIT_TABLE} -- Degree 4
4034
4035 deferred_modified: BOOLEAN
4036 -- Has the deferred status of current
4037 -- class been modified?
4038
4039 feature {DEGREE_4, DEGREE_3} -- Used by degree 4 and 3 to compute new assertions
4040
4041 assert_prop_list: LINKED_LIST [INTEGER]
4042 -- List of routine ids to be propagated
4043
4044 set_assertion_prop_list (l: like assert_prop_list) is
4045 -- Set `assert_prop_list' to `l'.
4046 do
4047 assert_prop_list := l
4048 ensure
4049 assert_prop_list_set: assert_prop_list = l
4050 end
4051
4052 feature {DEGREE_3} -- Degree 3
4053
4054 add_to_degree_3 is
4055 -- Add current class to Degree 3.
4056 -- Set `finalization_needed' to True
4057 require
4058 not_a_true_external_class: not is_true_external
4059 do
4060 degree_3_needed := True
4061 finalization_needed := True
4062 ensure
4063 added: degree_3_needed
4064 finalization_needed_set: finalization_needed
4065 end
4066
4067 remove_from_degree_3 is
4068 -- Remove current class from Degree 3.
4069 do
4070 degree_3_needed := False
4071 ensure
4072 removed: not degree_3_needed
4073 end
4074
4075 degree_3_needed: BOOLEAN
4076 -- Does current class need to be
4077 -- processed in Degree 3?
4078
4079 feature {DEGREE_2} -- Degree 2
4080
4081 add_to_degree_2 is
4082 -- Add current class to Degree 2.
4083 require
4084 not_a_true_external_class: not is_true_external
4085 do
4086 degree_2_needed := True
4087 ensure
4088 added: degree_2_needed
4089 end
4090
4091 remove_from_degree_2 is
4092 -- Remove current class from Degree 2.
4093 do
4094 degree_2_needed := False
4095 ensure
4096 removed: not degree_2_needed
4097 end
4098
4099 degree_2_needed: BOOLEAN
4100 -- Does current class need to be
4101 -- processed in Degree 2?
4102
4103 feature {DEGREE_1} -- Degree 1
4104
4105 add_to_degree_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_1_needed := True
4111 ensure
4112 added: degree_1_needed
4113 end
4114
4115 remove_from_degree_1 is
4116 -- Remove current class from Degree 1.
4117 do
4118 degree_1_needed := False
4119 ensure
4120 removed: not degree_1_needed
4121 end
4122
4123 degree_1_needed: BOOLEAN
4124 -- Does current class need to be
4125 -- processed in Degree 1?
4126
4127 feature {DEGREE_MINUS_1, IL_GENERATOR} -- Degree -1
4128
4129 add_to_degree_minus_1 is
4130 -- Add current class to Degree -1.
4131 require
4132 not_a_true_external_class: not is_true_external
4133 do
4134 degree_minus_1_needed := True
4135 ensure
4136 added: degree_minus_1_needed
4137 end
4138
4139 remove_from_degree_minus_1 is
4140 -- Remove current class from Degree -1.
4141 do
4142 degree_minus_1_needed := False
4143 ensure
4144 removed: not degree_minus_1_needed
4145 end
4146
4147 degree_minus_1_needed: BOOLEAN
4148 -- Does current class need to be
4149 -- processed in Degree -1?
4150
4151 feature -- Degree -2/-3
4152
4153 finalization_needed: BOOLEAN
4154 -- Does current class need to be processed for
4155 -- finalization?
4156
4157 set_finalization_needed (v: BOOLEAN) is
4158 -- Assign `finalization_needed' with `v'.
4159 do
4160 finalization_needed := v
4161 ensure
4162 finalization_needed_set: finalization_needed = v
4163 end
4164
4165 feature -- output
4166
4167 debug_output: STRING is
4168 -- Generate a nice representation of Current to be seen
4169 -- in debugger.
4170 local
4171 l_name: STRING
4172 do
4173 l_name := name
4174 create Result.make (l_name.count + 6)
4175 Result.append_integer (class_id)
4176 Result.append_character (':')
4177 Result.append_character (' ')
4178 Result.append (l_name)
4179 end
4180
4181 feature {NONE} -- Implementation
4182
4183 internal_is_frozen: BOOLEAN
4184 -- Mutable version of `is_frozen'.
4185
4186 internal_feature_table_file_id: INTEGER
4187 -- Number added at end of C file corresponding to generated
4188 -- feature table. Initialized by default to -1.
4189
4190 append_signature_internal (a_text_formatter: TEXT_FORMATTER; a_with_deferred_symbol: BOOLEAN; a_short: BOOLEAN) is
4191 -- Append the signature of current class in `a_text_formatter'. If `a_with_deferred_symbol'
4192 -- then add a `*' to the class name.
4193 -- If `a_short', use "..." to replace constrained generic type.
4194 require
4195 non_void_st: a_text_formatter /= Void
4196 local
4197 formal_dec: FORMAL_CONSTRAINT_AS
4198 old_group: CONF_GROUP
4199 gens: like generics
4200 do
4201 append_name (a_text_formatter)
4202 if a_with_deferred_symbol and is_deferred then
4203 a_text_formatter.add_char ('*')
4204 end
4205 gens := generics
4206 if gens /= Void then
4207 old_group := Inst_context.group
4208 Inst_context.set_group (group)
4209 a_text_formatter.add_space
4210 a_text_formatter.process_symbol_text (ti_L_bracket)
4211 from
4212 gens.start
4213 until
4214 gens.after
4215 loop
4216 formal_dec ?= gens.item
4217 check formal_dec_not_void: formal_dec /= Void end
4218 formal_dec.append_signature (a_text_formatter, a_short, Current)
4219 gens.forth
4220 if not gens.after then
4221 a_text_formatter.process_symbol_text (ti_Comma)
4222 a_text_formatter.add_space
4223 end
4224 end
4225 a_text_formatter.process_symbol_text (ti_R_bracket)
4226 Inst_context.set_group (old_group)
4227 end
4228 end
4229
4230 invariant
4231
4232 -- Default invariants common to all kind of generation.
4233 lace_class_exists: lace_class /= Void
4234 descendants_exists: descendants /= Void
4235 suppliers_exisis: suppliers /= Void
4236 clients_exists: clients /= Void
4237 config_class_connection: original_class.compiled_class = Current
4238 conformance_table_not_void: conformance_table /= Void
4239
4240 -- Invariants IL versus normal generation.
4241 anchored_features_void_in_non_il_generation:
4242 not System.il_generation implies anchored_features = Void
4243
4244 -- True after proper initialization of Current instance.
4245 -- has_ast: has_ast
4246
4247 indexing
4248 copyright: "Copyright (c) 1984-2006, Eiffel Software"
4249 license: "GPL version 2 (see http://www.eiffel.com/licensing/gpl.txt)"
4250 licensing_options: "http://www.eiffel.com/licensing"
4251 copying: "[
4252 This file is part of Eiffel Software's Eiffel Development Environment.
4253
4254 Eiffel Software's Eiffel Development Environment is free
4255 software; you can redistribute it and/or modify it under
4256 the terms of the GNU General Public License as published
4257 by the Free Software Foundation, version 2 of the License
4258 (available at the URL listed under "license" above).
4259
4260 Eiffel Software's Eiffel Development Environment is
4261 distributed in the hope that it will be useful, but
4262 WITHOUT ANY WARRANTY; without even the implied warranty
4263 of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
4264 See the GNU General Public License for more details.
4265
4266 You should have received a copy of the GNU General Public
4267 License along with Eiffel Software's Eiffel Development
4268 Environment; if not, write to the Free Software Foundation,
4269 Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
4270 ]"
4271 source: "[
4272 Eiffel Software
4273 356 Storke Road, Goleta, CA 93117 USA
4274 Telephone 805-685-1006, Fax 805-685-6869
4275 Website http://www.eiffel.com
4276 Customer support http://support.eiffel.com
4277 ]"
4278
4279 end -- class CLASS_C
4280

Properties

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

  ViewVC Help
Powered by ViewVC 1.1.23