/src/tools/semantics/types/impl/liberty_actual_type.e

  1-- This file is part of Liberty Eiffel.
  2--
  3-- Liberty Eiffel is free software: you can redistribute it and/or modify
  4-- it under the terms of the GNU General Public License as published by
  5-- the Free Software Foundation, version 3 of the License.
  6--
  7-- Liberty Eiffel is distributed in the hope that it will be useful,
  8-- but WITHOUT ANY WARRANTY; without even the implied warranty of
  9-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 10-- GNU General Public License for more details.
 11--
 12-- You should have received a copy of the GNU General Public License
 13-- along with Liberty Eiffel.  If not, see <http://www.gnu.org/licenses/>.
 14--
 15class LIBERTY_ACTUAL_TYPE
 16   --
 17   -- A type effectively defined, usually by an actual source file
 18   --
 19
 20inherit
 21   LIBERTY_KNOWN_TYPE
 22      redefine
 23         is_equal
 24      end
 25
 26insert
 27   EIFFEL_NODE_HANDLER
 28      undefine
 29         out_in_tagged_out_memory
 30      redefine
 31         is_equal
 32      end
 33   LIBERTY_ERROR_LEVELS
 34      undefine
 35         out_in_tagged_out_memory
 36      redefine
 37         is_equal
 38      end
 39   LIBERTY_ARRAY_MANIFEST_CONSTANTS
 40      undefine
 41         out_in_tagged_out_memory
 42      redefine
 43         is_equal
 44      end
 45
 46create {LIBERTY_UNIVERSE}
 47   make
 48
 49feature {ANY}
 50   current_entity: LIBERTY_CURRENT
 51
 52   known_type: LIBERTY_ACTUAL_TYPE is
 53      do
 54         Result := Current
 55      end
 56
 57   file: FIXED_STRING is
 58      do
 59         Result := descriptor.file
 60      end
 61
 62   obsolete_message: STRING
 63
 64   hash_code: INTEGER is
 65      do
 66         Result := descriptor.hash_code
 67      end
 68
 69   is_equal (other: like Current): BOOLEAN is
 70      do
 71         Result := other = Current
 72      end
 73
 74   is_obsolete: BOOLEAN is
 75      do
 76         Result := obsolete_message /= Void
 77      end
 78
 79   cluster: LIBERTY_CLUSTER is
 80      do
 81         Result := descriptor.cluster
 82      end
 83
 84   name: FIXED_STRING is
 85      do
 86         Result := descriptor.name
 87      end
 88
 89   parameters: TRAVERSABLE[LIBERTY_TYPE] is
 90      do
 91         Result := descriptor.parameters
 92      end
 93
 94   is_deferred: BOOLEAN is
 95      do
 96         Result := runtime_category = deferred_category
 97      end
 98
 99   is_expanded: BOOLEAN is
100      do
101         Result := runtime_category = expanded_category
102      end
103
104   is_separate: BOOLEAN is
105      do
106         Result := runtime_category = separate_category
107      end
108
109   is_reference: BOOLEAN is
110      do
111         Result := runtime_category = reference_category
112      end
113
114   is_runtime_category_set: BOOLEAN is
115      do
116         Result := runtime_category /= 0
117      end
118
119   the_invariant: LIBERTY_INVARIANT
120
121   has_feature (a_feature_name: LIBERTY_FEATURE_NAME): BOOLEAN is
122      do
123         Result := features.has(a_feature_name)
124      end
125
126   feature_definition (a_feature_name: LIBERTY_FEATURE_NAME): LIBERTY_FEATURE_DEFINITION is
127      do
128         Result := features.at(a_feature_name)
129      end
130
131   type_resolver: LIBERTY_TYPE_RESOLVER_IN_TYPE
132
133   accept (visitor: LIBERTY_TYPE_VISITOR) is
134      do
135         visit.call([visitor, Current])
136      end
137
138   converts_to (target_type: LIBERTY_KNOWN_TYPE): BOOLEAN is
139      do
140         Result := has_converter(target_type)
141      end
142
143   do_convert (target_type: LIBERTY_ACTUAL_TYPE; a_converter: LIBERTY_TYPE_CONVERTER) is
144      do
145         converter(target_type).call([a_converter])
146      end
147
148   may_promote_current: BOOLEAN
149         -- True if Current's type may be promoted in order to fix arithmetic operations (available only on a
150         -- very few select kernel types such as integers, naturals and reals)
151
152   is_built: BOOLEAN is
153      do
154         Result := builder.is_built
155      end
156
157feature {LIBERTY_TYPE_LISTENER, LIBERTY_TYPE}
158   add_listener (a_listener: LIBERTY_TYPE_LISTENER) is
159      do
160         a_listener.on_type_known(Current)
161         if is_built then
162            a_listener.on_type_built(Current)
163         else
164            listeners.add_last(a_listener)
165         end
166      ensure then
167         is_built /= has_listener(a_listener)
168      end
169
170feature {}
171   fire_type_built is
172      local
173         i: INTEGER
174      do
175         from
176            i := listeners.lower
177         until
178            i > listeners.upper
179         loop
180            listeners.item(i).on_type_built(Current)
181            i := i + 1
182         end
183         listeners := Void
184      end
185
186feature {LIBERTY_KNOWN_TYPE}
187   full_name_in (buffer: STRING) is
188      local
189         i: INTEGER
190      do
191         buffer.append(cluster.name)
192         buffer.extend('.')
193         buffer.append(name)
194         if not parameters.is_empty then
195            buffer.extend('[')
196            from
197               i := parameters.lower
198            until
199               i > parameters.upper
200            loop
201               if i > parameters.lower then
202                  buffer.extend(',')
203               end
204               parameters.item(i).full_name_in(buffer)
205               i := i + 1
206            end
207            buffer.extend(']')
208         end
209      end
210
211feature {ANY}
212   debug_display (o: OUTPUT_STREAM; show_features: BOOLEAN) is
213      local
214         i: INTEGER; fn: LIBERTY_FEATURE_NAME; fd: LIBERTY_FEATURE_DEFINITION
215      do
216         if is_runtime_category_set then
217            if is_expanded then
218               o.put_string(once "expanded type ")
219            elseif is_separate then
220               o.put_string(once "separate type ")
221            elseif is_deferred then
222               o.put_string(once "deferred type ")
223            else
224               o.put_string(once "type ")
225            end
226         else
227            o.put_string(once "type ")
228         end
229         o.put_line(full_name.out)
230         o.put_string(once "   building state: ")
231         o.put_line(builder.current_state.out)
232         if show_features then
233            from
234               i := features.lower
235            until
236               i > features.upper
237            loop
238               fn := features.key(i)
239               fd := features.item(i)
240               check
241                  fn = fd.feature_name
242               end
243               fd.debug_display(o, True)
244               i := i + 1
245            end
246         end
247         o.put_string(once "end -- type ")
248         o.put_line(full_name.out)
249      end
250
251feature {ANY} -- Inheritance
252   is_conform_to (other: LIBERTY_KNOWN_TYPE): BOOLEAN is
253      local
254         i: INTEGER
255      do
256         if other = Current then
257            Result := True
258         elseif conformant_parents /= Void then
259            from
260               i := conformant_parents.lower
261            until
262               Result or else i > conformant_parents.upper
263            loop
264               Result := conformant_parents.item(i).is_conform_to(other)
265               i := i + 1
266            end
267            if not Result and then other.same_base_class_as(Current) then
268               Result := conformance_checker.inherits(other, Current)
269            end
270         end
271      end
272
273   is_non_conformant_child_of (other: LIBERTY_KNOWN_TYPE): BOOLEAN is
274      local
275         i: INTEGER
276      do
277         if other = Current then
278            Result := True
279         else
280            if non_conformant_parents /= Void then
281               from
282                  i := non_conformant_parents.lower
283               until
284                  Result or else i > non_conformant_parents.upper
285               loop
286                  Result := non_conformant_parents.item(i).is_non_conformant_child_of(other)
287                  i := i + 1
288               end
289            end
290            if conformant_parents /= Void then
291               from
292                  i := conformant_parents.lower
293               until
294                  Result or else i > conformant_parents.upper
295               loop
296                  Result := conformant_parents.item(i).is_non_conformant_child_of(other)
297                  i := i + 1
298               end
299            end
300            if not Result and then other.same_base_class_as(Current) then
301               Result := conformance_checker.inserts(other, Current)
302            end
303         end
304      end
305
306feature {LIBERTY_KNOWN_TYPE}
307   common_parent (other: LIBERTY_KNOWN_TYPE): LIBERTY_KNOWN_TYPE is
308         -- To implement `common_conformant_parent_with'.
309         -- Conformant common parent lookup.
310      local
311         i: INTEGER; t: LIBERTY_KNOWN_TYPE
312      do
313         from
314            i := conformant_parents.lower
315         until
316            Result /= Void or else i > conformant_parents.upper
317         loop
318            t := conformant_parents.item(i)
319            check
320               by_definition: other /= t -- because of the `not_trivial' precondition: not is_conform_to(other)
321            end
322            if other.is_conform_to(t) then
323               Result := t
324            else
325               Result := t.common_parent(other)
326            end
327            i := i + 1
328         end
329      end
330
331   same_base_class_as (other: LIBERTY_ACTUAL_TYPE): BOOLEAN is
332      do
333         Result := name = other.name and then descriptor.cluster = other.descriptor.cluster
334      end
335
336feature {LIBERTY_BUILDER_TOOLS}
337   set_obsolete (message: like obsolete_message) is
338      require
339         message /= Void
340      do
341         obsolete_message := message
342      ensure
343         is_obsolete
344         obsolete_message = message
345      end
346
347   set_deferred is
348      require
349         not is_runtime_category_set
350      do
351         runtime_category := deferred_category
352      ensure
353         is_runtime_category_set
354         is_deferred
355      end
356
357   set_expanded is
358      require
359         not is_runtime_category_set
360      do
361         runtime_category := expanded_category
362      ensure
363         is_runtime_category_set
364         is_expanded
365      end
366
367   set_separate is
368      require
369         not is_runtime_category_set
370      do
371         runtime_category := separate_category
372      ensure
373         is_runtime_category_set
374         is_separate
375      end
376
377   set_reference is
378      require
379         not is_runtime_category_set
380      do
381         runtime_category := reference_category
382      ensure
383         is_runtime_category_set
384         is_reference
385      end
386
387   add_parent (a_parent: LIBERTY_ACTUAL_TYPE; conformant: BOOLEAN) is
388      require
389         a_parent /= Void
390      do
391         torch.burn
392         if conformant then
393            if conformant_parents = no_parents then
394               create {FAST_ARRAY[LIBERTY_ACTUAL_TYPE]} conformant_parents.with_capacity(2)
395            end
396            conformant_parents.add_last(a_parent)
397            debug ("type.building")
398               log.trace.put_string(name)
399               log.trace.put_string(once ": adding conformant parent ")
400               log.trace.put_line(a_parent.name)
401            end
402         else
403            if non_conformant_parents = no_parents then
404               create {FAST_ARRAY[LIBERTY_ACTUAL_TYPE]} non_conformant_parents.with_capacity(2)
405            end
406            non_conformant_parents.add_last(a_parent)
407            debug ("type.building")
408               log.trace.put_string(name)
409               log.trace.put_string(once ": adding non-conformant parent ")
410               log.trace.put_line(a_parent.name)
411            end
412         end
413      end
414
415   features: DICTIONARY[LIBERTY_FEATURE_DEFINITION, LIBERTY_FEATURE_NAME]
416
417   set_invariant (a_invariant: like the_invariant) is
418      do
419         the_invariant := a_invariant
420      ensure
421         the_invariant = a_invariant
422      end
423
424   add_feature (a_feature: LIBERTY_FEATURE_DEFINITION) is
425      require
426         not has_feature(a_feature.feature_name)
427      do
428         features.add(a_feature, a_feature.feature_name)
429         torch.burn
430      ensure
431         has_feature(a_feature.feature_name)
432         feature_definition(a_feature.feature_name) = a_feature
433      end
434
435   replace_feature (a_feature: LIBERTY_FEATURE_DEFINITION) is
436      require
437         has_feature(a_feature.feature_name)
438         feature_definition(a_feature.feature_name) /= a_feature
439      local
440         replaced_feature: LIBERTY_FEATURE_DEFINITION
441      do
442         replaced_feature := feature_definition(a_feature.feature_name)
443         a_feature.copy_precursors(replaced_feature)
444         features.put(a_feature, a_feature.feature_name)
445         torch.burn
446      ensure
447         has_feature(a_feature.feature_name)
448         feature_definition(a_feature.feature_name) = a_feature
449      end
450
451   descriptor_position: LIBERTY_POSITION is
452      do
453         Result := descriptor.position
454      end
455
456feature {LIBERTY_UNIVERSE} -- Semantics building
457   start_build (universe: LIBERTY_UNIVERSE) is
458      require
459         not errors.has_error
460      do
461         create builder.make(Current, universe)
462      end
463
464   build_more is
465      require
466         not is_built
467      do
468         builder.build_more
469         if builder.is_built then
470            fire_type_built
471         end
472      end
473
474   set_may_promote_current is
475      do
476         may_promote_current:= True
477      ensure
478         may_promote_current
479      end
480
481   add_converter (target_type: LIBERTY_ACTUAL_TYPE; a_converter: like converter) is
482      require
483         not has_converter(target_type)
484      do
485         if converters = Void then
486            create {HASHED_DICTIONARY[PROCEDURE[TUPLE[LIBERTY_TYPE_CONVERTER]], LIBERTY_KNOWN_TYPE]} converters.with_capacity(3)
487         end
488         converters.add(a_converter, target_type)
489      ensure
490         converter(target_type) = a_converter
491      end
492
493   has_converter (target_type: LIBERTY_KNOWN_TYPE): BOOLEAN is
494      do
495         Result := converters /= Void and then converters.fast_has(target_type)
496      end
497
498   converter (target_type: LIBERTY_ACTUAL_TYPE): PROCEDURE[TUPLE[LIBERTY_TYPE_CONVERTER]] is
499      do
500         Result := converters.fast_at(target_type)
501      end
502
503feature {}
504   check_validity is
505      do
506         --| TODO
507      end
508
509feature {LIBERTY_TYPE_BUILDER}
510   conformant_parents: COLLECTION[LIBERTY_ACTUAL_TYPE]
511   non_conformant_parents: COLLECTION[LIBERTY_ACTUAL_TYPE]
512
513   has_no_parents: BOOLEAN is
514      do
515         Result := conformant_parents = no_parents and then non_conformant_parents = no_parents
516      end
517
518   set_type_resolver (a_type_resolver: like type_resolver) is
519      require
520         a_type_resolver.current_type = Current
521         type_resolver = Void
522      do
523         type_resolver := a_type_resolver
524      ensure
525         type_resolver = a_type_resolver
526      end
527
528feature {LIBERTY_UNIVERSE, LIBERTY_TYPE_BUILDER}
529   has_loaded_features: BOOLEAN is
530      do
531         Result := builder.has_loaded_features
532      end
533
534feature {LIBERTY_REACHABLE, LIBERTY_REACHABLE_COLLECTION_MARKER}
535   mark_reachable_code (mark: INTEGER) is
536      local
537         i: INTEGER; param: LIBERTY_TYPE
538      do
539         if not is_reachable then
540            torch.burn
541            log.trace.put_string(once "Marked reachable the type: ")
542            log.trace.put_line(full_name)
543         end
544         if reachable_mark < mark then
545            reachable_mark := mark
546            types_marker.mark_reachable_code(mark, conformant_parents)
547            types_marker.mark_reachable_code(mark, non_conformant_parents)
548            from
549               i := parameters.lower
550            until
551               i > parameters.upper
552            loop
553               param := parameters.item(i)
554               if param.is_known and then param.known_type.is_runtime_category_set and then param.known_type.is_expanded then
555                  param.mark_reachable_code(mark)
556               end
557               i := i + 1
558            end
559            if has_manifest_array then
560               mark_manifest_array_features(mark)
561            end
562         end
563      end
564
565feature {LIBERTY_SEMANTICS_BUILDER}
566   set_has_manifest_array is
567      do
568         has_manifest_array := True
569         if reachable_mark > 0 then
570            mark_manifest_array_features(reachable_mark)
571         end
572      ensure
573         has_manifest_array
574      end
575
576feature {LIBERTY_TYPE_MANIFEST_ARRAY_FEATURES_LISTENER}
577   mark_manifest_array_features (mark: like reachable_mark) is
578      local
579         fd_put, fd_make, fd_creation: like feature_definition
580      do
581         if not is_built then
582            add_listener(create {LIBERTY_TYPE_MANIFEST_ARRAY_FEATURES_LISTENER}.make(mark))
583         else
584            -- TODO: should do those lookups in ANY (because of possible renames)
585
586            fd_creation := feature_definition(manifest_creation_feature_name) -- always exists (in ANY)
587            if fd_creation.creation_clients = Void then
588               -- TODO: error, "manifest_creation" feature should belong to the creation clause
589               not_yet_implemented
590            end
591
592            if not has_feature(manifest_put_feature_name) then
593               -- TODO: error, using manifest expressions but missing "manifest_put" feature
594               not_yet_implemented
595            else
596               fd_put := feature_definition(manifest_put_feature_name)
597               if fd_put.result_type /= Void then
598                  -- TODO: error, "manifest_put" feature should be a procedure
599                  not_yet_implemented
600               end
601               fd_put.mark_reachable_code(mark)
602            end
603
604            if not has_feature(manifest_make_feature_name) then
605               -- TODO: error, using manifest expressions but missing "manifest_make" feature
606               not_yet_implemented
607            else
608               fd_make := feature_definition(manifest_make_feature_name)
609               if fd_make.result_type /= Void then
610                  -- TODO: error, "manifest_make" feature should be a procedure
611                  not_yet_implemented
612               end
613               fd_make.mark_reachable_code(mark)
614            end
615         end
616      end
617
618feature {}
619   types_marker: LIBERTY_REACHABLE_COLLECTION_MARKER[LIBERTY_ACTUAL_TYPE]
620
621feature {LIBERTY_UNIVERSE, LIBERTY_ACTUAL_TYPE}
622   descriptor: LIBERTY_TYPE_DESCRIPTOR
623
624feature {LIBERTY_AST_HANDLER}
625   ast: LIBERTY_AST_ONE_CLASS
626
627feature {}
628   make (a_descriptor: like descriptor; a_conformance_checker: like conformance_checker; a_ast: like ast; a_visit: like visit) is
629      require
630         a_descriptor /= Void
631         a_conformance_checker /= Void
632         a_visit /= Void
633      do
634         descriptor := a_descriptor
635         conformance_checker := a_conformance_checker
636         ast := a_ast
637         create {HASHED_DICTIONARY[LIBERTY_FEATURE_DEFINITION, LIBERTY_FEATURE_NAME]} features.with_capacity(50) -- ANY contains 50 features
638         conformant_parents := no_parents
639         non_conformant_parents := no_parents
640         visit := a_visit
641         create current_entity.make(Current, errors.unknown_position)
642         create result_entity.make(Current, errors.unknown_position)
643         create {FAST_ARRAY[LIBERTY_TYPE_LISTENER]} listeners.with_capacity(2)
644         debug ("full_name")
645            debug_full_name := full_name.out
646         end
647      ensure
648         descriptor = a_descriptor
649         conformance_checker = a_conformance_checker
650         ast = a_ast
651         not_yet_reachable: not is_reachable
652      end
653
654   runtime_category: INTEGER_8
655
656   deferred_category: INTEGER_8 is 1
657   expanded_category: INTEGER_8 is 2
658   separate_category: INTEGER_8 is 4
659   reference_category: INTEGER_8 is 8
660
661   errors: LIBERTY_ERRORS
662   builder: LIBERTY_TYPE_BUILDER
663   visit: PROCEDURE[TUPLE[LIBERTY_TYPE_VISITOR, LIBERTY_ACTUAL_TYPE]]
664
665   no_parents: COLLECTION[LIBERTY_ACTUAL_TYPE] is
666      once
667         create {FAST_ARRAY[LIBERTY_ACTUAL_TYPE]} Result.with_capacity(0)
668      end
669
670   conformance_checker: LIBERTY_GENERICS_CONFORMANCE_CHECKER
671
672   converters: DICTIONARY[PROCEDURE[TUPLE[LIBERTY_TYPE_CONVERTER]], LIBERTY_KNOWN_TYPE]
673         -- actually contains only LIBERTY_ACTUAL_TYPE objects but it helps to be able to check against
674         -- LIBERTY_VOID_TYPE
675
676   has_manifest_array: BOOLEAN
677         -- True if some manifest array expression builds an object of this type
678
679   debug_full_name: STRING
680
681invariant
682   descriptor /= Void
683   file /= Void
684   features /= Void
685   features.for_all(agent (fd: LIBERTY_FEATURE_DEFINITION; fn: LIBERTY_FEATURE_NAME): BOOLEAN is
686      do
687         Result := fd.feature_name.is_equal(fn)
688            and then fd.current_type = Current
689      end
690   )
691   parameters /= Void
692   visit /= Void
693   cluster /= Void
694
695   conformant_parents /= Void
696   non_conformant_parents /= Void
697
698   builder /= Void implies builder.type = Current
699
700   current_entity /= Void
701   result_entity /= Void
702
703end -- class LIBERTY_ACTUAL_TYPE