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

Contents of /branches/CAT_mono/Src/Eiffel/API/evaluated_type/cl_type_a.e

Parent Directory Parent Directory | Revision Log Revision Log


Revision 69650 - (show annotations)
Tue Jul 24 17:18:14 2007 UTC (12 years, 4 months ago) by juliant
File size: 17496 byte(s)
Added monomorph mark for class types, either "frozen" or "invariant".
First (simple) conformance check for monomorphic types.
1 indexing
2 description: "Description of an actual class type."
3 legal: "See notice at end of class."
4 status: "See notice at end of class."
5 date: "$Date$"
6 revision: "$Revision$"
7
8 class CL_TYPE_A
9
10 inherit
11 NAMED_TYPE_A
12 redefine
13 is_expanded, is_reference, is_separate, instantiation_in, valid_generic,
14 duplicate, meta_type, same_as, good_generics, error_generics,
15 has_expanded, is_valid, format, convert_to,
16 is_full_named_type, is_external, is_enum, is_conformant_to,
17 is_monomorph
18 end
19
20 DEBUG_OUTPUT
21
22 create
23 make
24
25 feature {NONE} -- Initialization
26
27 make (a_class_id: INTEGER) is
28 require
29 valid_class_id: a_class_id > 0
30 do
31 class_id := a_class_id
32 ensure
33 class_id_set: class_id = a_class_id
34 end
35
36 feature -- Visitor
37
38 process (v: TYPE_A_VISITOR) is
39 -- Process current element.
40 do
41 v.process_cl_type_a (Current)
42 end
43
44 feature -- Properties
45
46 has_no_mark: BOOLEAN is
47 -- Has class type no explicit mark?
48 do
49 Result := declaration_mark = no_mark
50 ensure
51 definition: Result = (declaration_mark = no_mark)
52 end
53
54 has_expanded_mark: BOOLEAN is
55 -- Is class type explicitly marked as expanded?
56 do
57 Result := declaration_mark = expanded_mark
58 ensure
59 definition: Result = (declaration_mark = expanded_mark)
60 end
61
62 has_reference_mark: BOOLEAN is
63 -- Is class type explicitly marked as reference?
64 do
65 Result := declaration_mark = reference_mark
66 ensure
67 definition: Result = (declaration_mark = reference_mark)
68 end
69
70 has_separate_mark: BOOLEAN is
71 -- Is class type explicitly marked as reference?
72 do
73 Result := declaration_mark = separate_mark
74 ensure
75 definition: Result = (declaration_mark = separate_mark)
76 end
77
78 has_monomorph_mark: BOOLEAN is
79 -- Is class type explicitly marked as monomorph?
80 do
81 Result := declaration_mark = monomorph_mark
82 ensure
83 definition: Result = (declaration_mark = monomorph_mark)
84 end
85
86 is_expanded: BOOLEAN is
87 -- Is the type expanded?
88 do
89 Result := has_expanded_mark or else has_no_mark and then associated_class.is_expanded
90 end
91
92 is_reference: BOOLEAN is
93 -- Is the type a reference type?
94 do
95 Result := has_reference_mark or else has_no_mark and then not associated_class.is_expanded
96 end
97
98 is_separate: BOOLEAN is
99 -- Is the type separate?
100 do
101 Result := has_separate_mark
102 end
103
104 is_valid: BOOLEAN is
105 -- Is Current still valid?
106 -- I.e. its `associated_class' is still in system.
107 do
108 Result := associated_class /= Void
109 end
110
111 is_full_named_type: BOOLEAN is
112 -- Current is a full named type.
113 do
114 Result := True
115 end
116
117 is_external: BOOLEAN is
118 -- Is current type based on an external calss?
119 local
120 l_base_class: like associated_class
121 do
122 l_base_class := associated_class
123 Result := is_basic or (not l_base_class.is_basic and l_base_class.is_external)
124 end
125
126 is_enum: BOOLEAN is
127 -- Is the current actual type an external enum one?
128 local
129 l_base_class: like associated_class
130 do
131 l_base_class := associated_class
132 Result := is_expanded and l_base_class.is_external and l_base_class.is_enum
133 end
134
135 is_system_object_or_any: BOOLEAN is
136 -- Does current type represent SYSTEM_OBJECT or ANY?
137 require
138 il_generation: System.il_generation
139 local
140 l_class_id: like class_id
141 l_system: like system
142 do
143 l_class_id := class_id
144 l_system := system
145 Result := l_class_id = l_system.system_object_class.compiled_class.class_id or
146 l_class_id = l_system.any_class.compiled_class.class_id
147 end
148
149 is_monomorph: BOOLEAN is
150 -- Is the current type monomorph?
151 do
152 Result := has_monomorph_mark or is_expanded or associated_class.is_frozen
153 end
154
155 feature -- Comparison
156
157 is_equivalent (other: like Current): BOOLEAN is
158 -- Is `other' equivalent to the current object ?
159 do
160 Result := declaration_mark = other.declaration_mark and then
161 class_declaration_mark = other.class_declaration_mark and then
162 class_id = other.class_id
163 end
164
165 feature -- Access
166
167 hash_code: INTEGER is
168 -- Hash code value.
169 do
170 Result := class_id
171 end
172
173 class_id: INTEGER
174 -- Class id of the associated class
175
176 same_as (other: TYPE_A): BOOLEAN is
177 -- Is the current type the same as `other' ?
178 local
179 other_class_type: CL_TYPE_A
180 do
181 other_class_type ?= other
182 Result := other_class_type /= Void and then class_id = other_class_type.class_id
183 and then is_expanded = other_class_type.is_expanded
184 and then is_separate = other_class_type.is_separate
185 end
186
187 associated_class: CLASS_C is
188 -- Associated class to the type
189 do
190 Result := System.class_of_id (class_id)
191 end
192
193 feature -- Output
194
195 ext_append_to (st: TEXT_FORMATTER; c: CLASS_C) is
196 do
197 if has_expanded_mark then
198 st.process_keyword_text (ti_expanded_keyword, Void)
199 st.add_space
200 elseif has_reference_mark then
201 st.process_keyword_text (ti_reference_keyword, Void)
202 st.add_space
203 elseif has_separate_mark then
204 st.process_keyword_text (ti_separate_keyword, Void)
205 st.add_space
206 elseif has_monomorph_mark then
207 st.process_keyword_text (ti_frozen_keyword, Void)
208 st.add_space
209 end
210 associated_class.append_name (st)
211 end
212
213 dump: STRING is
214 -- Dumped trace
215 local
216 class_name: STRING
217 do
218 class_name := associated_class.name_in_upper
219 if has_expanded_mark then
220 create Result.make (class_name.count + 9)
221 Result.append ("expanded ")
222 elseif has_reference_mark then
223 create Result.make (class_name.count + 10)
224 Result.append ("reference ")
225 elseif has_separate_mark then
226 create Result.make (class_name.count + 9)
227 Result.append ("separate ")
228 elseif has_monomorph_mark then
229 create Result.make (class_name.count + 7)
230 Result.append ("frozen ")
231 else
232 create Result.make (class_name.count)
233 end
234 Result.append (class_name)
235 end
236
237 feature {COMPILER_EXPORTER} -- Settings
238
239 set_expanded_class_mark is
240 -- Mark class declaration as expanded.
241 do
242 class_declaration_mark := expanded_mark
243 ensure
244 has_expanded_class_mark: class_declaration_mark = expanded_mark
245 end
246
247 set_expanded_mark is
248 -- Set class type declaration as expanded.
249 do
250 declaration_mark := expanded_mark
251 ensure
252 has_expanded_mark: has_expanded_mark
253 end
254
255 set_reference_mark is
256 -- Set class type declaration as reference.
257 do
258 declaration_mark := reference_mark
259 ensure
260 has_reference_mark: has_reference_mark
261 end
262
263 set_separate_mark is
264 -- Set class type declaration as separate.
265 do
266 declaration_mark := separate_mark
267 ensure
268 has_separate_mark: has_separate_mark
269 end
270
271 set_monomorph_mark is
272 -- Set class type declaration as monomorph.
273 do
274 declaration_mark := monomorph_mark
275 ensure
276 has_monomorph_mark: has_monomorph_mark
277 end
278
279 type_i: CL_TYPE_I is
280 -- C type
281 do
282 create Result.make (class_id)
283 Result.set_mark (declaration_mark)
284 end
285
286 meta_type: TYPE_I is
287 -- Meta type of the type
288 do
289 if is_expanded then
290 Result := type_i
291 else
292 Result := Reference_c_type
293 end
294 end
295
296 good_generics: BOOLEAN is
297 -- Has the base class exactly the same number of generic
298 -- parameters in its formal generic declarations ?
299 do
300 Result := associated_class.generics = Void
301 end
302
303 error_generics: VTUG is
304 do
305 create {VTUG2} Result
306 Result.set_type (Current)
307 Result.set_base_class (associated_class)
308 end
309
310 has_expanded: BOOLEAN is
311 -- Has the current type some expanded types in its declration ?
312 do
313 Result := is_expanded
314 end
315
316 feature {COMPILER_EXPORTER} -- Conformance
317
318 convert_to (a_context_class: CLASS_C; a_target_type: TYPE_A): BOOLEAN is
319 -- Does current convert to `a_target_type' in `a_context_class'?
320 -- Update `last_conversion_info' of AST_CONTEXT.
321 local
322 l_checker: CONVERTIBILITY_CHECKER
323 do
324 create l_checker
325 l_checker.check_conversion (a_context_class, Current, a_target_type)
326 Result := l_checker.last_conversion_check_successful
327 if Result then
328 context.set_last_conversion_info (l_checker.last_conversion_info)
329 else
330 context.set_last_conversion_info (Void)
331 end
332 end
333
334 conform_to (other: TYPE_A): BOOLEAN is
335 -- Does Current conform to `other'?
336 local
337 other_class_type: CL_TYPE_A
338 l_other_type_set: TYPE_SET_A
339 do
340 other_class_type ?= other.conformance_type
341 l_other_type_set ?= other
342 if other_class_type /= Void then
343 if other_class_type.is_expanded then
344 -- It should be the exact same base class for expanded.
345 if is_expanded and then class_id = other_class_type.class_id then
346 if is_typed_pointer then
347 -- TYPED_POINTER should be exactly the same type.
348 Result := same_as (other)
349 else
350 Result := other_class_type.valid_generic (Current)
351 end
352 end
353 else
354 Result :=
355 associated_class.conform_to (other_class_type.associated_class)
356 and then other_class_type.valid_generic (Current)
357 if not Result and then system.il_generation and then system.system_object_class /= Void then
358 -- Any type in .NET conforms to System.Object
359 check
360 system.system_object_class.is_compiled
361 end
362 Result := other_class_type.class_id = system.system_object_id
363 end
364 end
365 elseif l_other_type_set /= Void then
366 Result := to_type_set.conform_to (l_other_type_set.twin)
367 end
368 if context.current_class.is_cat_call_detection then
369 if Result and other.is_monomorph then
370 Result := is_monomorph and then other.conform_to (Current)
371 end
372 end
373 end
374
375 is_conformant_to (other: TYPE_A): BOOLEAN is
376 -- Does Current inherit from other?
377 -- Most of the time, it is equivalent to `conform_to' except
378 -- when current is an expanded type.
379 local
380 l_is_exp, l_other_is_exp: BOOLEAN
381 l_other_class_type: CL_TYPE_A
382 current_mark: like declaration_mark
383 other_mark: like declaration_mark
384 do
385 l_other_class_type ?= other.actual_type
386 if l_other_class_type /= Void then
387 -- We perform conformance as if the two types were not
388 -- expanded. So, if they are expanded, we remove their
389 -- expanded flag to do the conformance check.
390 l_is_exp := is_expanded
391 l_other_is_exp := l_other_class_type.is_expanded
392 if l_is_exp then
393 current_mark := declaration_mark
394 set_reference_mark
395 end
396 if l_other_is_exp then
397 other_mark := l_other_class_type.declaration_mark
398 l_other_class_type.set_reference_mark
399 end
400
401 Result := conform_to (other)
402
403 if l_is_exp then
404 set_mark (current_mark)
405 end
406 if l_other_is_exp then
407 l_other_class_type.set_mark (other_mark)
408 end
409 end
410 end
411
412 valid_generic (type: CL_TYPE_A): BOOLEAN is
413 -- Do the generic parameter of `type' conform to those
414 -- of Current (none).
415 do
416 Result := True
417 end
418
419 generic_conform_to (gen_type: GEN_TYPE_A): BOOLEAN is
420 -- Does Current conform to `gen_type' ?
421 require
422 good_argument: gen_type /= Void
423 associated_class.conform_to (gen_type.associated_class)
424 local
425 i, count: INTEGER
426 parent_actual_type: TYPE_A
427 parents: FIXED_LIST [CL_TYPE_A]
428 do
429 from
430 parents := associated_class.parents
431 i := 1
432 count := parents.count
433 until
434 i > count or else Result
435 loop
436 parent_actual_type := parent_type (parents.i_th (i))
437 Result := parent_actual_type.conform_to (gen_type)
438 i := i + 1
439 end
440 end
441
442 parent_type (parent: CL_TYPE_A): TYPE_A is
443 -- Parent actual type.
444 require
445 parent_not_void: parent /= Void
446 do
447 Result := parent.duplicate
448 ensure
449 result_not_void: Result /= Void
450 end
451
452 feature {COMPILER_EXPORTER} -- Instantitation of a feature type
453
454 feature_type (f: FEATURE_I): TYPE_A is
455 -- Instantiation of the feature type in the context of
456 -- current
457 require
458 good_argument: f /= Void
459 associated_class.conform_to (f.written_class)
460 feature_type_is_solved: f.type.is_solved
461 local
462 feat_type: TYPE_A
463 do
464 feat_type ?= f.type
465 Result := feat_type.instantiation_in (Current, f.written_in)
466 end
467
468 instantiation_in (type: TYPE_A; written_id: INTEGER): TYPE_A is
469 -- Instantiation of Current in the context of `class_type'
470 -- assuming that Current is written in `written_id'
471 local
472 class_type: CL_TYPE_A
473 do
474 class_type ?= type
475 if class_type /= Void then
476 Result := class_type.instantiation_of (Current, written_id)
477 else
478 Result := Current
479 end
480 end
481
482 feature {COMPILER_EXPORTER} -- Instantiation of a type in the context of a descendant one
483
484 instantiation_of (type: TYPE_A; a_class_id: INTEGER): TYPE_A is
485 -- Instantiation of type `type' written in class of id `a_class_id'
486 -- in the context of Current
487 local
488 instantiation: TYPE_A
489 gen_type: GEN_TYPE_A
490 do
491 if a_class_id = class_id then
492 -- Feature is written in the class associated to the
493 -- current actual class type
494 instantiation := Current
495 else
496 instantiation := find_class_type (System.class_of_id (a_class_id))
497 end
498 Result := type.actual_type
499 if instantiation.generics /= Void and instantiation.generics.count > 0 then
500 -- Does not make sense to instantiate if `instantation' is
501 -- a TUPLE with no arguments.
502 gen_type ?= instantiation
503 Result := gen_type.instantiate (Result)
504 end
505 end
506
507 find_class_type (c: CLASS_C): CL_TYPE_A is
508 -- Actual type of class of id `class_id' in current
509 -- context
510 require
511 good_argument: c /= Void
512 conformance: associated_class.conform_to (c)
513 local
514 parents: FIXED_LIST [CL_TYPE_A]
515 parent: CL_TYPE_A
516 parent_class: CLASS_C
517 i, count: INTEGER
518 parent_class_type: CL_TYPE_A
519 do
520 from
521 parents := associated_class.parents
522 i := 1
523 count := parents.count
524 until
525 i > count or else Result /= Void
526 loop
527 parent := parents.i_th (i)
528 parent_class := parent.associated_class
529 if parent_class = c then
530 -- Class `c' is found
531 Result ?= parent_type (parent)
532 elseif parent_class.conform_to (c) then
533 -- Iterate in the inheritance graph and
534 -- conformance tables help to take the good
535 -- way in the parents
536 parent_class_type ?= parent_type (parent)
537 Result := parent_class_type.find_class_type (c)
538 end
539 i := i + 1
540 end
541 end
542
543 duplicate: like Current is
544 -- Duplication
545 do
546 Result := twin
547 end
548
549 reference_type: CL_TYPE_A is
550 -- Reference counterpart of an expanded type
551 do
552 Result := duplicate
553 Result.set_reference_mark
554 end
555
556 create_info: CREATE_TYPE is
557 -- Byte code information for entity type creation
558 do
559 create Result.make (type_i)
560 end
561
562 format (ctxt: TEXT_FORMATTER_DECORATOR) is
563 -- Format current.
564 do
565 ctxt.put_classi (associated_class.lace_class)
566 end
567
568 feature -- Debugging
569
570 debug_output: STRING is
571 -- Display name of associated class.
572 do
573 if is_valid then
574 Result := dump
575 else
576 Result := "Class not in system anymore"
577 end
578 end
579
580 feature {CL_TYPE_A, CL_TYPE_I, TUPLE_CLASS_B} -- Implementation: class type declaration marks
581
582 declaration_mark: NATURAL_8
583 -- Declaration mark associated with a class type (if any)
584
585 class_declaration_mark: NATURAL_8
586 -- Declaration mark associated with class
587
588 set_mark (mark: like declaration_mark) is
589 -- Set `declaration_mark' to the given value `mark'.
590 require
591 valid_declaration_mark:
592 mark = no_mark or mark = expanded_mark or
593 mark = reference_mark or mark = separate_mark or
594 mark = monomorph_mark
595 do
596 declaration_mark := mark
597 ensure
598 declaration_mark_set: declaration_mark = mark
599 end
600
601 no_mark: NATURAL_8 is 0
602 -- Empty declaration mark
603
604 expanded_mark: NATURAL_8 is 1
605 -- Expanded declaration mark
606
607 reference_mark: NATURAL_8 is 2
608 -- Reference declaration mark
609
610 separate_mark: NATURAL_8 is 3
611 -- Separate declaration mark
612
613 monomorph_mark: NATURAL_8 is 4
614 -- Monomorph declaration mark
615
616 invariant
617 class_id_positive: class_id > 0
618 valid_declaration_mark: declaration_mark = no_mark or declaration_mark = expanded_mark or
619 declaration_mark = reference_mark or declaration_mark = separate_mark or
620 declaration_mark = monomorph_mark
621 valid_class_declaration_mark:
622 class_declaration_mark = no_mark or
623 class_declaration_mark = expanded_mark or
624 class_declaration_mark = reference_mark or
625 class_declaration_mark = separate_mark or
626 class_declaration_mark = monomorph_mark
627
628 indexing
629 copyright: "Copyright (c) 1984-2006, Eiffel Software"
630 license: "GPL version 2 (see http://www.eiffel.com/licensing/gpl.txt)"
631 licensing_options: "http://www.eiffel.com/licensing"
632 copying: "[
633 This file is part of Eiffel Software's Eiffel Development Environment.
634
635 Eiffel Software's Eiffel Development Environment is free
636 software; you can redistribute it and/or modify it under
637 the terms of the GNU General Public License as published
638 by the Free Software Foundation, version 2 of the License
639 (available at the URL listed under "license" above).
640
641 Eiffel Software's Eiffel Development Environment is
642 distributed in the hope that it will be useful, but
643 WITHOUT ANY WARRANTY; without even the implied warranty
644 of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
645 See the GNU General Public License for more details.
646
647 You should have received a copy of the GNU General Public
648 License along with Eiffel Software's Eiffel Development
649 Environment; if not, write to the Free Software Foundation,
650 Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
651 ]"
652 source: "[
653 Eiffel Software
654 356 Storke Road, Goleta, CA 93117 USA
655 Telephone 805-685-1006, Fax 805-685-6869
656 Website http://www.eiffel.com
657 Customer support http://support.eiffel.com
658 ]"
659
660 end

Properties

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

  ViewVC Help
Powered by ViewVC 1.1.23