/[eiffelstudio]/vendor/gobosoft.com/gobo/4.0d/library/tools/src/eiffel/ast/type/et_like_feature.e
ViewVC logotype

Contents of /vendor/gobosoft.com/gobo/4.0d/library/tools/src/eiffel/ast/type/et_like_feature.e

Parent Directory Parent Directory | Revision Log Revision Log


Revision 98698 - (show annotations)
Mon May 9 13:53:54 2016 UTC (3 years, 5 months ago) by manus
File size: 50234 byte(s)
Update 4.0d version with changes in Gobo from 2016/05/09

1 note
2
3 description:
4
5 "Eiffel 'like feature' types"
6
7 library: "Gobo Eiffel Tools Library"
8 copyright: "Copyright (c) 2001-2016, Eric Bezault and others"
9 license: "MIT License"
10 date: "$Date$"
11 revision: "$Revision$"
12
13 class ET_LIKE_FEATURE
14
15 inherit
16
17 ET_LIKE_IDENTIFIER
18 redefine
19 reset,
20 named_type_with_type_mark,
21 shallow_named_type_with_type_mark,
22 named_type_has_class,
23 named_type_is_formal_type,
24 same_syntactical_like_feature_with_type_marks,
25 same_named_class_type_with_type_marks,
26 same_named_formal_parameter_type_with_type_marks,
27 same_named_tuple_type_with_type_marks,
28 same_base_class_type_with_type_marks,
29 same_base_formal_parameter_type_with_type_marks,
30 same_base_tuple_type_with_type_marks,
31 conforms_from_class_type_with_type_marks,
32 conforms_from_formal_parameter_type_with_type_marks,
33 conforms_from_tuple_type_with_type_marks,
34 type_with_type_mark,
35 is_type_reference_with_type_mark,
36 is_type_detachable_with_type_mark,
37 depends_on_qualified_anchored_type
38 end
39
40 create
41
42 make
43
44 feature {NONE} -- Initialization
45
46 make (a_type_mark: like type_mark; a_name: like name)
47 -- Create a new 'like name' type.
48 require
49 a_name_not_void: a_name /= Void
50 do
51 type_mark := a_type_mark
52 like_keyword := tokens.like_keyword
53 name := a_name
54 ensure
55 type_mark_set: type_mark = a_type_mark
56 name_set: name = a_name
57 end
58
59 feature -- Initialization
60
61 reset
62 -- Reset type as it was just after it was last parsed.
63 do
64 if is_like_argument then
65 if attached {ET_IDENTIFIER} name as l_identifier then
66 l_identifier.set_argument (False)
67 end
68 end
69 name.reset
70 is_procedure := False
71 seed := 0
72 end
73
74 feature -- Access
75
76 like_keyword: ET_KEYWORD
77 -- 'like' keyword
78
79 name: ET_FEATURE_NAME
80 -- Name of the feature associated with current type
81
82 seed: INTEGER
83 -- Feature ID of one of the seeds of the feature associated
84 -- with current type or of the feature containing the argument
85 -- in case of 'like argument';
86 -- 0 if not resolved yet
87
88 index: INTEGER
89 -- Index in the argument list of the
90 -- feature associated with current type
91 require
92 is_like_argument: is_like_argument
93 do
94 Result := name.seed
95 ensure
96 definition: Result = name.seed
97 index_positive: Result >= 1
98 end
99
100 named_base_class (a_context: ET_TYPE_CONTEXT): ET_NAMED_CLASS
101 -- Same as `base_class' except that it returns information about this
102 -- class (e.g. its name) as known from the universe it is used from
103 -- (instead of from the universe it is written in).
104 -- Return "*UNKNOWN*" class if unresolved identifier type,
105 -- or unmatched formal generic parameter.
106 local
107 a_class: ET_CLASS
108 l_index: INTEGER
109 do
110 if seed = 0 then
111 -- Anchored type not resolved yet.
112 Result := tokens.unknown_class
113 elseif is_like_argument then
114 a_class := a_context.base_class
115 l_index := index
116 if attached a_class.seeded_feature (seed) as l_feature and then attached l_feature.arguments as l_args and then l_index <= l_args.count then
117 Result := l_args.item (l_index).type.named_base_class (a_context)
118 else
119 -- Internal error: an inconsistency has been
120 -- introduced in the AST since we relsolved
121 -- current anchored type.
122 Result := tokens.unknown_class
123 end
124 else
125 a_class := a_context.base_class
126 if attached a_class.seeded_query (seed) as l_query then
127 Result := l_query.type.named_base_class (a_context)
128 else
129 -- Internal error: an inconsistency has been
130 -- introduced in the AST since we resolved
131 -- current anchored type.
132 Result := tokens.unknown_class
133 end
134 end
135 end
136
137 base_type_with_type_mark (a_type_mark: detachable ET_TYPE_MARK; a_context: ET_TYPE_CONTEXT): ET_BASE_TYPE
138 -- Same as `base_type' except that its type mark status is
139 -- overridden by `a_type_mark', if not Void
140 local
141 a_class: ET_CLASS
142 l_index: INTEGER
143 do
144 if seed = 0 then
145 -- Anchored type not resolved yet.
146 Result := tokens.unknown_class
147 elseif is_like_argument then
148 a_class := a_context.base_class
149 l_index := index
150 if attached a_class.seeded_feature (seed) as l_feature and then attached l_feature.arguments as l_args and then l_index <= l_args.count then
151 Result := l_args.item (l_index).type.base_type_with_type_mark (overridden_type_mark (a_type_mark), a_context)
152 else
153 -- Internal error: an inconsistency has been
154 -- introduced in the AST since we resolved
155 -- current anchored type.
156 Result := tokens.unknown_class
157 end
158 else
159 a_class := a_context.base_class
160 if attached a_class.seeded_query (seed) as l_query then
161 Result := l_query.type.base_type_with_type_mark (overridden_type_mark (a_type_mark), a_context)
162 else
163 -- Internal error: an inconsistency has been
164 -- introduced in the AST since we resolved
165 -- current anchored type.
166 Result := tokens.unknown_class
167 end
168 end
169 end
170
171 shallow_base_type_with_type_mark (a_type_mark: detachable ET_TYPE_MARK; a_context: ET_TYPE_CONTEXT): ET_BASE_TYPE
172 -- Same as `shallow_base_type' except that its type mark status is
173 -- overridden by `a_type_mark', if not Void
174 local
175 a_class: ET_CLASS
176 l_index: INTEGER
177 do
178 if seed = 0 then
179 -- Anchored type not resolved yet.
180 Result := tokens.unknown_class
181 elseif is_like_argument then
182 a_class := a_context.root_context.base_class
183 l_index := index
184 if attached a_class.seeded_feature (seed) as l_feature and then attached l_feature.arguments as l_args and then l_index <= l_args.count then
185 Result := l_args.item (l_index).type.shallow_base_type_with_type_mark (overridden_type_mark (a_type_mark), a_context)
186 else
187 -- Internal error: an inconsistency has been
188 -- introduced in the AST since we resolved
189 -- current anchored type.
190 Result := tokens.unknown_class
191 end
192 else
193 a_class := a_context.root_context.base_class
194 if attached a_class.seeded_query (seed) as l_query then
195 Result := l_query.type.shallow_base_type_with_type_mark (overridden_type_mark (a_type_mark), a_context)
196 else
197 -- Internal error: an inconsistency has been
198 -- introduced in the AST since we resolved
199 -- current anchored type.
200 Result := tokens.unknown_class
201 end
202 end
203 end
204
205 base_type_actual (i: INTEGER; a_context: ET_TYPE_CONTEXT): ET_NAMED_TYPE
206 -- `i'-th actual generic parameter's type of the base type of current
207 -- type when it appears in `a_context'
208 local
209 a_class: ET_CLASS
210 l_index: INTEGER
211 do
212 if seed = 0 then
213 -- Anchored type not resolved yet.
214 Result := tokens.unknown_class
215 elseif is_like_argument then
216 a_class := a_context.base_class
217 l_index := index
218 if attached a_class.seeded_feature (seed) as l_feature and then attached l_feature.arguments as l_args and then l_index <= l_args.count then
219 Result := l_args.item (l_index).type.base_type_actual (i, a_context)
220 else
221 -- Internal error: an inconsistency has been
222 -- introduced in the AST since we resolved
223 -- current anchored type.
224 Result := tokens.unknown_class
225 end
226 else
227 a_class := a_context.base_class
228 if attached a_class.seeded_query (seed) as l_query then
229 Result := l_query.type.base_type_actual (i, a_context)
230 else
231 -- Internal error: an inconsistency has been
232 -- introduced in the AST since we resolved
233 -- current anchored type.
234 Result := tokens.unknown_class
235 end
236 end
237 end
238
239 base_type_actual_parameter (i: INTEGER; a_context: ET_TYPE_CONTEXT): ET_ACTUAL_PARAMETER
240 -- `i'-th actual generic parameter of the base type of current
241 -- type when it appears in `a_context'
242 local
243 a_class: ET_CLASS
244 l_index: INTEGER
245 do
246 if seed = 0 then
247 -- Anchored type not resolved yet.
248 Result := tokens.unknown_class
249 elseif is_like_argument then
250 a_class := a_context.base_class
251 l_index := index
252 if attached a_class.seeded_feature (seed) as l_feature and then attached l_feature.arguments as l_args and then l_index <= l_args.count then
253 Result := l_args.item (l_index).type.base_type_actual_parameter (i, a_context)
254 else
255 -- Internal error: an inconsistency has been
256 -- introduced in the AST since we resolved
257 -- current anchored type.
258 Result := tokens.unknown_class
259 end
260 else
261 a_class := a_context.base_class
262 if attached a_class.seeded_query (seed) as l_query then
263 Result := l_query.type.base_type_actual_parameter (i, a_context)
264 else
265 -- Internal error: an inconsistency has been
266 -- introduced in the AST since we resolved
267 -- current anchored type.
268 Result := tokens.unknown_class
269 end
270 end
271 end
272
273 base_type_index_of_label (a_label: ET_IDENTIFIER; a_context: ET_TYPE_CONTEXT): INTEGER
274 -- Index of actual generic parameter with label `a_label' in
275 -- the base type of current type when it appears in `a_context';
276 -- 0 if it does not exist
277 local
278 a_class: ET_CLASS
279 l_index: INTEGER
280 do
281 if seed = 0 then
282 -- Anchored type not resolved yet.
283 Result := 0
284 elseif is_like_argument then
285 a_class := a_context.base_class
286 l_index := index
287 if attached a_class.seeded_feature (seed) as l_feature and then attached l_feature.arguments as l_args and then l_index <= l_args.count then
288 Result := l_args.item (l_index).type.base_type_index_of_label (a_label, a_context)
289 else
290 -- Internal error: an inconsistency has been
291 -- introduced in the AST since we resolved
292 -- current anchored type.
293 Result := 0
294 end
295 else
296 a_class := a_context.base_class
297 if attached a_class.seeded_query (seed) as l_query then
298 Result := l_query.type.base_type_index_of_label (a_label, a_context)
299 else
300 -- Internal error: an inconsistency has been
301 -- introduced in the AST since we resolved
302 -- current anchored type.
303 Result := 0
304 end
305 end
306 end
307
308 named_type_with_type_mark (a_type_mark: detachable ET_TYPE_MARK; a_context: ET_TYPE_CONTEXT): ET_NAMED_TYPE
309 -- Same as `named_type' except that its type mark status is
310 -- overridden by `a_type_mark', if not Void
311 local
312 a_class: ET_CLASS
313 l_index: INTEGER
314 do
315 if seed = 0 then
316 -- Anchored type not resolved yet.
317 Result := tokens.unknown_class
318 elseif is_like_argument then
319 a_class := a_context.base_class
320 l_index := index
321 if attached a_class.seeded_feature (seed) as l_feature and then attached l_feature.arguments as l_args and then l_index <= l_args.count then
322 Result := l_args.item (l_index).type.named_type_with_type_mark (overridden_type_mark (a_type_mark), a_context)
323 else
324 -- Internal error: an inconsistency has been
325 -- introduced in the AST since we resolved
326 -- current anchored type.
327 Result := tokens.unknown_class
328 end
329 else
330 a_class := a_context.base_class
331 if attached a_class.seeded_query (seed) as l_query then
332 Result := l_query.type.named_type_with_type_mark (overridden_type_mark (a_type_mark), a_context)
333 else
334 -- Internal error: an inconsistency has been
335 -- introduced in the AST since we resolved
336 -- current anchored type.
337 Result := tokens.unknown_class
338 end
339 end
340 end
341
342 shallow_named_type_with_type_mark (a_type_mark: detachable ET_TYPE_MARK; a_context: ET_TYPE_CONTEXT): ET_NAMED_TYPE
343 -- Same as `shallow_named_type' except that its type mark status is
344 -- overridden by `a_type_mark', if not Void
345 local
346 a_class: ET_CLASS
347 l_index: INTEGER
348 do
349 if seed = 0 then
350 -- Anchored type not resolved yet.
351 Result := tokens.unknown_class
352 elseif is_like_argument then
353 a_class := a_context.root_context.base_class
354 l_index := index
355 if attached a_class.seeded_feature (seed) as l_feature and then attached l_feature.arguments as l_args and then l_index <= l_args.count then
356 Result := l_args.item (l_index).type.shallow_named_type_with_type_mark (overridden_type_mark (a_type_mark), a_context)
357 else
358 -- Internal error: an inconsistency has been
359 -- introduced in the AST since we resolved
360 -- current anchored type.
361 Result := tokens.unknown_class
362 end
363 else
364 a_class := a_context.root_context.base_class
365 if attached a_class.seeded_query (seed) as l_query then
366 Result := l_query.type.shallow_named_type_with_type_mark (overridden_type_mark (a_type_mark), a_context)
367 else
368 -- Internal error: an inconsistency has been
369 -- introduced in the AST since we resolved
370 -- current anchored type.
371 Result := tokens.unknown_class
372 end
373 end
374 end
375
376 type_with_type_mark (a_type_mark: detachable ET_TYPE_MARK): ET_LIKE_FEATURE
377 -- Current type whose type mark status is
378 -- overridden by `a_type_mark', if not Void
379 local
380 l_type_mark: detachable ET_TYPE_MARK
381 do
382 l_type_mark := overridden_type_mark (a_type_mark)
383 if l_type_mark = type_mark then
384 Result := Current
385 else
386 Result := twin
387 Result.set_type_mark (a_type_mark)
388 end
389 end
390
391 hash_code: INTEGER
392 -- Hash code
393 do
394 Result := seed
395 end
396
397 position: ET_POSITION
398 -- Position of first character of
399 -- current node in source code
400 do
401 if attached type_mark as l_type_mark and then not l_type_mark.is_implicit_mark and then not l_type_mark.position.is_null then
402 Result := l_type_mark.position
403 else
404 Result := like_keyword.position
405 end
406 if Result.is_null then
407 Result := name.position
408 end
409 end
410
411 last_leaf: ET_AST_LEAF
412 -- Last leaf node in current node
413 do
414 Result := name.last_leaf
415 end
416
417 feature -- Measurement
418
419 base_type_actual_count (a_context: ET_TYPE_CONTEXT): INTEGER
420 -- Number of actual generic parameters of the base type of current type
421 local
422 a_class: ET_CLASS
423 l_index: INTEGER
424 do
425 if seed = 0 then
426 -- Anchored type not resolved yet.
427 Result := 0
428 elseif is_like_argument then
429 a_class := a_context.base_class
430 l_index := index
431 if attached a_class.seeded_feature (seed) as l_feature and then attached l_feature.arguments as l_args and then l_index <= l_args.count then
432 Result := l_args.item (l_index).type.base_type_actual_count (a_context)
433
434 else
435 -- Internal error: an inconsistency has been
436 -- introduced in the AST since we resolved
437 -- current anchored type.
438 Result := 0
439 end
440 else
441 a_class := a_context.base_class
442 if attached a_class.seeded_query (seed) as l_query then
443 Result := l_query.type.base_type_actual_count (a_context)
444 else
445 -- Internal error: an inconsistency has been
446 -- introduced in the AST since we resolved
447 -- current anchored type.
448 Result := 0
449 end
450 end
451 end
452
453 feature -- Setting
454
455 set_like_keyword (a_like: like like_keyword)
456 -- Set `like_keyword' to `a_like'.
457 require
458 a_like_not_void: a_like /= Void
459 do
460 like_keyword := a_like
461 ensure
462 like_keyword_set: like_keyword = a_like
463 end
464
465 set_type_mark (a_type_mark: like type_mark)
466 -- Set `type_mark' to `a_type_mark'.
467 do
468 type_mark := a_type_mark
469 ensure
470 type_mark_set: type_mark = a_type_mark
471 end
472
473 feature -- Status report
474
475 is_like_argument: BOOLEAN
476 -- Is this type a 'like argument' (rather than a 'like feature')?
477 -- Note that 'like argument' is not a valid construct in ECMA Eiffel.
478 -- This is supported here for backward compatibility.
479 do
480 Result := name.is_argument
481 ensure then
482 definition: Result = name.is_argument
483 end
484
485 is_procedure: BOOLEAN
486 -- Is the feature with seed `seed' a procedure?
487 -- Only make sense in case of 'like argument',
488 -- otherwise the feature has to be a query.
489
490 is_type_expanded_with_type_mark (a_type_mark: detachable ET_TYPE_MARK; a_context: ET_TYPE_CONTEXT): BOOLEAN
491 -- Same as `is_type_expanded' except that the type mark status is
492 -- overridden by `a_type_mark', if not Void
493 local
494 a_class: ET_CLASS
495 l_index: INTEGER
496 do
497 if seed = 0 then
498 -- Anchored type not resolved yet.
499 Result := False
500 elseif is_like_argument then
501 a_class := a_context.base_class
502 l_index := index
503 if attached a_class.seeded_feature (seed) as l_feature and then attached l_feature.arguments as l_args and then l_index <= l_args.count then
504 Result := l_args.item (l_index).type.is_type_expanded_with_type_mark (overridden_type_mark (a_type_mark), a_context)
505 else
506 -- Internal error: an inconsistency has been
507 -- introduced in the AST since we resolved
508 -- current anchored type.
509 Result := False
510 end
511 else
512 a_class := a_context.base_class
513 if attached a_class.seeded_query (seed) as l_query then
514 Result := l_query.type.is_type_expanded_with_type_mark (overridden_type_mark (a_type_mark), a_context)
515 else
516 -- Internal error: an inconsistency has been
517 -- introduced in the AST since we resolved
518 -- current anchored type.
519 Result := False
520 end
521 end
522 end
523
524 is_type_reference_with_type_mark (a_type_mark: detachable ET_TYPE_MARK; a_context: ET_TYPE_CONTEXT): BOOLEAN
525 -- Same as `is_type_reference' except that the type mark status is
526 -- overridden by `a_type_mark', if not Void
527 local
528 a_class: ET_CLASS
529 l_index: INTEGER
530 do
531 if seed = 0 then
532 -- Anchored type not resolved yet.
533 Result := False
534 elseif is_like_argument then
535 a_class := a_context.base_class
536 l_index := index
537 if attached a_class.seeded_feature (seed) as l_feature and then attached l_feature.arguments as l_args and then l_index <= l_args.count then
538 Result := l_args.item (l_index).type.is_type_reference_with_type_mark (overridden_type_mark (a_type_mark), a_context)
539 else
540 -- Internal error: an inconsistency has been
541 -- introduced in the AST since we resolved
542 -- current anchored type.
543 Result := False
544 end
545 else
546 a_class := a_context.base_class
547 if attached a_class.seeded_query (seed) as l_query then
548 Result := l_query.type.is_type_reference_with_type_mark (overridden_type_mark (a_type_mark), a_context)
549 else
550 -- Internal error: an inconsistency has been
551 -- introduced in the AST since we resolved
552 -- current anchored type.
553 Result := False
554 end
555 end
556 end
557
558 is_type_attached_with_type_mark (a_type_mark: detachable ET_TYPE_MARK; a_context: ET_TYPE_CONTEXT): BOOLEAN
559 -- Same as `is_type_attached' except that the type mark status is
560 -- overridden by `a_type_mark', if not Void
561 local
562 a_class: ET_CLASS
563 l_index: INTEGER
564 do
565 if seed = 0 then
566 -- Anchored type not resolved yet.
567 Result := False
568 elseif is_like_argument then
569 a_class := a_context.base_class
570 l_index := index
571 if attached a_class.seeded_feature (seed) as l_feature and then attached l_feature.arguments as l_args and then l_index <= l_args.count then
572 Result := l_args.item (l_index).type.is_type_attached_with_type_mark (overridden_type_mark (a_type_mark), a_context)
573 else
574 -- Internal error: an inconsistency has been
575 -- introduced in the AST since we resolved
576 -- current anchored type.
577 Result := False
578 end
579 else
580 a_class := a_context.base_class
581 if attached a_class.seeded_query (seed) as l_query then
582 Result := l_query.type.is_type_attached_with_type_mark (overridden_type_mark (a_type_mark), a_context)
583 else
584 -- Internal error: an inconsistency has been
585 -- introduced in the AST since we resolved
586 -- current anchored type.
587 Result := False
588 end
589 end
590 end
591
592 is_type_detachable_with_type_mark (a_type_mark: detachable ET_TYPE_MARK; a_context: ET_TYPE_CONTEXT): BOOLEAN
593 -- Same as `is_type_detachable' except that the type mark status is
594 -- overridden by `a_type_mark', if not Void
595 local
596 a_class: ET_CLASS
597 l_index: INTEGER
598 do
599 if seed = 0 then
600 -- Anchored type not resolved yet.
601 Result := False
602 elseif is_like_argument then
603 a_class := a_context.base_class
604 l_index := index
605 if attached a_class.seeded_feature (seed) as l_feature and then attached l_feature.arguments as l_args and then l_index <= l_args.count then
606 Result := l_args.item (l_index).type.is_type_detachable_with_type_mark (overridden_type_mark (a_type_mark), a_context)
607 else
608 -- Internal error: an inconsistency has been
609 -- introduced in the AST since we resolved
610 -- current anchored type.
611 Result := False
612 end
613 else
614 a_class := a_context.base_class
615 if attached a_class.seeded_query (seed) as l_query then
616 Result := l_query.type.is_type_detachable_with_type_mark (overridden_type_mark (a_type_mark), a_context)
617 else
618 -- Internal error: an inconsistency has been
619 -- introduced in the AST since we resolved
620 -- current anchored type.
621 Result := False
622 end
623 end
624 end
625
626 depends_on_qualified_anchored_type (a_context: ET_TYPE_CONTEXT): BOOLEAN
627 -- Does current type depend on a qualified anchored type when
628 -- viewed from `a_context' when trying to determine its base type?
629 local
630 a_class: ET_CLASS
631 l_index: INTEGER
632 do
633 if seed = 0 then
634 -- Anchored type not resolved yet.
635 Result := False
636 elseif is_like_argument then
637 a_class := a_context.base_class
638 l_index := index
639 if attached a_class.seeded_feature (seed) as l_feature and then attached l_feature.arguments as l_args and then l_index <= l_args.count then
640 Result := l_args.item (l_index).type.depends_on_qualified_anchored_type (a_context)
641 else
642 -- Internal error: an inconsistency has been
643 -- introduced in the AST since we resolved
644 -- current anchored type.
645 Result := False
646 end
647 else
648 a_class := a_context.base_class
649 if attached a_class.seeded_query (seed) as l_query then
650 Result := l_query.type.depends_on_qualified_anchored_type (a_context)
651 else
652 -- Internal error: an inconsistency has been
653 -- introduced in the AST since we resolved
654 -- current anchored type.
655 Result := False
656 end
657 end
658 end
659
660 named_type_is_formal_type (a_context: ET_TYPE_CONTEXT): BOOLEAN
661 -- Is named type of current type, or if it is a qualified type
662 -- is the named type of its target type (recursively),
663 -- a formal parameter when viewed from `a_context'?
664 local
665 a_class: ET_CLASS
666 l_index: INTEGER
667 do
668 if seed = 0 then
669 -- Anchored type not resolved yet.
670 Result := False
671 elseif is_like_argument then
672 a_class := a_context.base_class
673 l_index := index
674 if attached a_class.seeded_feature (seed) as l_feature and then attached l_feature.arguments as l_args and then l_index <= l_args.count then
675 Result := l_args.item (l_index).type.named_type_is_formal_type (a_context)
676 else
677 -- Internal error: an inconsistency has been
678 -- introduced in the AST since we resolved
679 -- current anchored type.
680 Result := False
681 end
682 else
683 a_class := a_context.base_class
684 if attached a_class.seeded_query (seed) as l_query then
685 Result := l_query.type.named_type_is_formal_type (a_context)
686 else
687 -- Internal error: an inconsistency has been
688 -- introduced in the AST since we resolved
689 -- current anchored type.
690 Result := False
691 end
692 end
693 end
694
695 base_type_has_class (a_class: ET_CLASS; a_context: ET_TYPE_CONTEXT): BOOLEAN
696 -- Does the base type of current type contain `a_class'
697 -- when it appears in `a_context'?
698 local
699 a_base_class: ET_CLASS
700 l_index: INTEGER
701 do
702 if seed = 0 then
703 -- Anchored type not resolved yet.
704 Result := a_class.is_unknown
705 elseif is_like_argument then
706 a_base_class := a_context.base_class
707 l_index := index
708 if attached a_base_class.seeded_feature (seed) as l_feature and then attached l_feature.arguments as l_args and then l_index <= l_args.count then
709 Result := l_args.item (l_index).type.base_type_has_class (a_class, a_context)
710 else
711 -- Internal error: an inconsistency has been
712 -- introduced in the AST since we resolved
713 -- current anchored type.
714 Result := a_class.is_unknown
715 end
716 else
717 a_base_class := a_context.base_class
718 if attached a_base_class.seeded_query (seed) as l_query then
719 Result := l_query.type.base_type_has_class (a_class, a_context)
720 else
721 -- Internal error: an inconsistency has been
722 -- introduced in the AST since we resolved
723 -- current anchored type.
724 Result := a_class.is_unknown
725 end
726 end
727 end
728
729 named_type_has_class (a_class: ET_CLASS; a_context: ET_TYPE_CONTEXT): BOOLEAN
730 -- Does the named type of current type contain `a_class'
731 -- when it appears in `a_context'?
732 local
733 a_base_class: ET_CLASS
734 l_index: INTEGER
735 do
736 if seed = 0 then
737 -- Anchored type not resolved yet.
738 Result := a_class.is_unknown
739 elseif is_like_argument then
740 a_base_class := a_context.base_class
741 l_index := index
742 if attached a_base_class.seeded_feature (seed) as l_feature and then attached l_feature.arguments as l_args and then l_index <= l_args.count then
743 Result := l_args.item (l_index).type.named_type_has_class (a_class, a_context)
744 else
745 -- Internal error: an inconsistency has been
746 -- introduced in the AST since we resolved
747 -- current anchored type.
748 Result := a_class.is_unknown
749 end
750 else
751 a_base_class := a_context.base_class
752 if attached a_base_class.seeded_query (seed) as l_query then
753 Result := l_query.type.named_type_has_class (a_class, a_context)
754 else
755 -- Internal error: an inconsistency has been
756 -- introduced in the AST since we resolved
757 -- current anchored type.
758 Result := a_class.is_unknown
759 end
760 end
761 end
762
763 feature -- Comparison
764
765 same_syntactical_type_with_type_marks (other: ET_TYPE; other_type_mark: detachable ET_TYPE_MARK; other_context: ET_TYPE_CONTEXT; a_type_mark: detachable ET_TYPE_MARK; a_context: ET_TYPE_CONTEXT): BOOLEAN
766 -- Same as `same_syntactical_type' except that the type mark status of `Current'
767 -- and `other' is overridden by `a_type_mark' and `other_type_mark', if not Void
768 do
769 if other = Current and then other_type_mark = a_type_mark and then other_context = a_context then
770 Result := True
771 else
772 Result := other.same_syntactical_like_feature_with_type_marks (Current, a_type_mark, a_context, other_type_mark, other_context)
773 end
774 end
775
776 same_named_type_with_type_marks (other: ET_TYPE; other_type_mark: detachable ET_TYPE_MARK; other_context: ET_TYPE_CONTEXT; a_type_mark: detachable ET_TYPE_MARK; a_context: ET_TYPE_CONTEXT): BOOLEAN
777 -- Same as `same_named_type' except that the type mark status of `Current'
778 -- and `other' is overridden by `a_type_mark' and `other_type_mark', if not Void
779 local
780 a_class: ET_CLASS
781 l_index: INTEGER
782 do
783 if other = Current and then other_type_mark = a_type_mark and then other_context = a_context then
784 Result := True
785 elseif seed = 0 then
786 -- Anchored type not resolved yet.
787 Result := False
788 elseif is_like_argument then
789 a_class := a_context.base_class
790 l_index := index
791 if attached a_class.seeded_feature (seed) as l_feature and then attached l_feature.arguments as l_args and then l_index <= l_args.count then
792 Result := l_args.item (l_index).type.same_named_type_with_type_marks (other, other_type_mark, other_context, overridden_type_mark (a_type_mark), a_context)
793 else
794 -- Internal error: an inconsistency has been
795 -- introduced in the AST since we resolved
796 -- current anchored type.
797 Result := False
798 end
799 else
800 a_class := a_context.base_class
801 if attached a_class.seeded_query (seed) as l_query then
802 Result := l_query.type.same_named_type_with_type_marks (other, other_type_mark, other_context, overridden_type_mark (a_type_mark), a_context)
803 else
804 -- Internal error: an inconsistency has been
805 -- introduced in the AST since we resolved
806 -- current anchored type.
807 Result := False
808 end
809 end
810 end
811
812 same_base_type_with_type_marks (other: ET_TYPE; other_type_mark: detachable ET_TYPE_MARK; other_context: ET_TYPE_CONTEXT; a_type_mark: detachable ET_TYPE_MARK; a_context: ET_TYPE_CONTEXT): BOOLEAN
813 -- Same as `same_base_type' except that the type mark status of `Current'
814 -- and `other' is overridden by `a_type_mark' and `other_type_mark', if not Void
815 local
816 a_class: ET_CLASS
817 l_index: INTEGER
818 do
819 if other = Current and then other_type_mark = a_type_mark and then other_context = a_context then
820 Result := True
821 elseif seed = 0 then
822 -- Anchored type not resolved yet.
823 Result := False
824 elseif is_like_argument then
825 a_class := a_context.base_class
826 l_index := index
827 if attached a_class.seeded_feature (seed) as l_feature and then attached l_feature.arguments as l_args and then l_index <= l_args.count then
828 Result := l_args.item (l_index).type.same_base_type_with_type_marks (other, other_type_mark, other_context, overridden_type_mark (a_type_mark), a_context)
829 else
830 -- Internal error: an inconsistency has been
831 -- introduced in the AST since we resolved
832 -- current anchored type.
833 Result := False
834 end
835 else
836 a_class := a_context.base_class
837 if attached a_class.seeded_query (seed) as l_query then
838 Result := l_query.type.same_base_type_with_type_marks (other, other_type_mark, other_context, overridden_type_mark (a_type_mark), a_context)
839 else
840 -- Internal error: an inconsistency has been
841 -- introduced in the AST since we resolved
842 -- current anchored type.
843 Result := False
844 end
845 end
846 end
847
848 feature {ET_TYPE, ET_TYPE_CONTEXT} -- Comparison
849
850 same_syntactical_like_feature_with_type_marks (other: ET_LIKE_FEATURE; other_type_mark: detachable ET_TYPE_MARK; other_context: ET_TYPE_CONTEXT; a_type_mark: detachable ET_TYPE_MARK; a_context: ET_TYPE_CONTEXT): BOOLEAN
851 -- Are current type appearing in `a_context' and `other'
852 -- type appearing in `other_context' the same type?
853 -- (Note: We are NOT comparing the base types here!
854 -- Therefore anchored types are considered the same
855 -- only if they have the same anchor. An anchor type
856 -- is not considered the same as any other type even
857 -- if they have the same base type.)
858 -- Note that the type mark status of `Current' and `other' is
859 -- overridden by `a_type_mark' and `other_type_mark', if not Void
860 local
861 l_feature: detachable ET_FEATURE
862 l_query: detachable ET_QUERY
863 l_class: ET_CLASS
864 l_other_seed: INTEGER
865 do
866 if other = Current and then other_type_mark = a_type_mark and then other_context = a_context then
867 Result := True
868 elseif seed = 0 then
869 -- Anchored type not resolved yet.
870 -- Result := False
871 elseif a_context.attachment_type_conformance_mode and then not same_attachment_marks_with_default (overridden_type_mark (a_type_mark), other.overridden_type_mark (other_type_mark), Void) then
872 Result := False
873 elseif is_like_argument then
874 -- If they are 'like argument' they should
875 -- refer to the same argument.
876 if other.is_like_argument and then other.index = index then
877 -- They should refer to the same feature.
878 if other.seed = seed then
879 Result := True
880 else
881 l_class := other_context.base_class
882 l_other_seed := other.seed
883 l_feature := l_class.seeded_feature (l_other_seed)
884 Result := l_feature /= Void and then l_feature.has_seed (seed)
885 if not Result then
886 l_class := a_context.base_class
887 l_feature := l_class.seeded_feature (seed)
888 Result := l_feature /= Void and then l_feature.has_seed (l_other_seed)
889 end
890 end
891 end
892 elseif not other.is_like_argument then
893 -- They should refer to the same feature.
894 if other.seed = seed then
895 Result := True
896 else
897 l_query := other_context.base_class.seeded_query (other.seed)
898 Result := l_query /= Void and then l_query.has_seed (seed)
899 if not Result then
900 l_query := a_context.base_class.seeded_query (seed)
901 Result := l_query /= Void and then l_query.has_seed (other.seed)
902 end
903 end
904 else
905 -- Result := False
906 end
907 end
908
909 same_named_class_type_with_type_marks (other: ET_CLASS_TYPE; other_type_mark: detachable ET_TYPE_MARK; other_context: ET_TYPE_CONTEXT; a_type_mark: detachable ET_TYPE_MARK; a_context: ET_TYPE_CONTEXT): BOOLEAN
910 -- Do current type appearing in `a_context' and `other' type
911 -- appearing in `other_context' have the same named type?
912 -- Note that the type mark status of `Current' and `other' is
913 -- overridden by `a_type_mark' and `other_type_mark', if not Void
914 local
915 a_class: ET_CLASS
916 l_index: INTEGER
917 do
918 if seed = 0 then
919 -- Anchored type not resolved yet.
920 Result := False
921 elseif is_like_argument then
922 a_class := a_context.base_class
923 l_index := index
924 if attached a_class.seeded_feature (seed) as l_feature and then attached l_feature.arguments as l_args and then l_index <= l_args.count then
925 Result := l_args.item (l_index).type.same_named_class_type_with_type_marks (other, other_type_mark, other_context, overridden_type_mark (a_type_mark), a_context)
926 else
927 -- Internal error: an inconsistency has been
928 -- introduced in the AST since we resolved
929 -- current anchored type.
930 Result := False
931 end
932 else
933 a_class := a_context.base_class
934 if attached a_class.seeded_query (seed) as l_query then
935 Result := l_query.type.same_named_class_type_with_type_marks (other, other_type_mark, other_context, overridden_type_mark (a_type_mark), a_context)
936 else
937 -- Internal error: an inconsistency has been
938 -- introduced in the AST since we resolved
939 -- current anchored type.
940 Result := False
941 end
942 end
943 end
944
945 same_named_formal_parameter_type_with_type_marks (other: ET_FORMAL_PARAMETER_TYPE; other_type_mark: detachable ET_TYPE_MARK; other_context: ET_TYPE_CONTEXT; a_type_mark: detachable ET_TYPE_MARK; a_context: ET_TYPE_CONTEXT): BOOLEAN
946 -- Do current type appearing in `a_context' and `other' type
947 -- appearing in `other_context' have the same named type?
948 -- Note that the type mark status of `Current' and `other' is
949 -- overridden by `a_type_mark' and `other_type_mark', if not Void
950 local
951 a_class: ET_CLASS
952 l_index: INTEGER
953 do
954 if seed = 0 then
955 -- Anchored type not resolved yet.
956 Result := False
957 elseif is_like_argument then
958 a_class := a_context.base_class
959 l_index := index
960 if attached a_class.seeded_feature (seed) as l_feature and then attached l_feature.arguments as l_args and then l_index <= l_args.count then
961 Result := l_args.item (l_index).type.same_named_formal_parameter_type_with_type_marks (other, other_type_mark, other_context, overridden_type_mark (a_type_mark), a_context)
962 else
963 -- Internal error: an inconsistency has been
964 -- introduced in the AST since we resolved
965 -- current anchored type.
966 Result := False
967 end
968 else
969 a_class := a_context.base_class
970 if attached a_class.seeded_query (seed) as l_query then
971 Result := l_query.type.same_named_formal_parameter_type_with_type_marks (other, other_type_mark, other_context, overridden_type_mark (a_type_mark), a_context)
972 else
973 -- Internal error: an inconsistency has been
974 -- introduced in the AST since we resolved
975 -- current anchored type.
976 Result := False
977 end
978 end
979 end
980
981 same_named_tuple_type_with_type_marks (other: ET_TUPLE_TYPE; other_type_mark: detachable ET_TYPE_MARK; other_context: ET_TYPE_CONTEXT; a_type_mark: detachable ET_TYPE_MARK; a_context: ET_TYPE_CONTEXT): BOOLEAN
982 -- Do current type appearing in `a_context' and `other' type
983 -- appearing in `other_context' have the same named type?
984 -- Note that the type mark status of `Current' and `other' is
985 -- overridden by `a_type_mark' and `other_type_mark', if not Void
986 local
987 a_class: ET_CLASS
988 l_index: INTEGER
989 do
990 if seed = 0 then
991 -- Anchored type not resolved yet.
992 Result := False
993 elseif is_like_argument then
994 a_class := a_context.base_class
995 l_index := index
996 if attached a_class.seeded_feature (seed) as l_feature and then attached l_feature.arguments as l_args and then l_index <= l_args.count then
997 Result := l_args.item (l_index).type.same_named_tuple_type_with_type_marks (other, other_type_mark, other_context, overridden_type_mark (a_type_mark), a_context)
998 else
999 -- Internal error: an inconsistency has been
1000 -- introduced in the AST since we resolved
1001 -- current anchored type.
1002 Result := False
1003 end
1004 else
1005 a_class := a_context.base_class
1006 if attached a_class.seeded_query (seed) as l_query then
1007 Result := l_query.type.same_named_tuple_type_with_type_marks (other, other_type_mark, other_context, overridden_type_mark (a_type_mark), a_context)
1008 else
1009 -- Internal error: an inconsistency has been
1010 -- introduced in the AST since we resolved
1011 -- current anchored type.
1012 Result := False
1013 end
1014 end
1015 end
1016
1017 same_base_class_type_with_type_marks (other: ET_CLASS_TYPE; other_type_mark: detachable ET_TYPE_MARK; other_context: ET_TYPE_CONTEXT; a_type_mark: detachable ET_TYPE_MARK; a_context: ET_TYPE_CONTEXT): BOOLEAN
1018 -- Do current type appearing in `a_context' and `other' type
1019 -- appearing in `other_context' have the same base type?
1020 -- Note that the type mark status of `Current' and `other' is
1021 -- overridden by `a_type_mark' and `other_type_mark', if not Void
1022 local
1023 a_class: ET_CLASS
1024 l_index: INTEGER
1025 do
1026 if seed = 0 then
1027 -- Anchored type not resolved yet.
1028 Result := False
1029 elseif is_like_argument then
1030 a_class := a_context.base_class
1031 l_index := index
1032 if attached a_class.seeded_feature (seed) as l_feature and then attached l_feature.arguments as l_args and then l_index <= l_args.count then
1033 Result := l_args.item (l_index).type.same_base_class_type_with_type_marks (other, other_type_mark, other_context, overridden_type_mark (a_type_mark), a_context)
1034 else
1035 -- Internal error: an inconsistency has been
1036 -- introduced in the AST since we resolved
1037 -- current anchored type.
1038 Result := False
1039 end
1040 else
1041 a_class := a_context.base_class
1042 if attached a_class.seeded_query (seed) as l_query then
1043 Result := l_query.type.same_base_class_type_with_type_marks (other, other_type_mark, other_context, overridden_type_mark (a_type_mark), a_context)
1044 else
1045 -- Internal error: an inconsistency has been
1046 -- introduced in the AST since we resolved
1047 -- current anchored type.
1048 Result := False
1049 end
1050 end
1051 end
1052
1053 same_base_formal_parameter_type_with_type_marks (other: ET_FORMAL_PARAMETER_TYPE; other_type_mark: detachable ET_TYPE_MARK; other_context: ET_TYPE_CONTEXT; a_type_mark: detachable ET_TYPE_MARK; a_context: ET_TYPE_CONTEXT): BOOLEAN
1054 -- Do current type appearing in `a_context' and `other' type
1055 -- appearing in `other_context' have the same base type?
1056 -- Note that the type mark status of `Current' and `other' is
1057 -- overridden by `a_type_mark' and `other_type_mark', if not Void
1058 local
1059 a_class: ET_CLASS
1060 l_index: INTEGER
1061 do
1062 if seed = 0 then
1063 -- Anchored type not resolved yet.
1064 Result := False
1065 elseif is_like_argument then
1066 a_class := a_context.base_class
1067 l_index := index
1068 if attached a_class.seeded_feature (seed) as l_feature and then attached l_feature.arguments as l_args and then l_index <= l_args.count then
1069 Result := l_args.item (l_index).type.same_base_formal_parameter_type_with_type_marks (other, other_type_mark, other_context, overridden_type_mark (a_type_mark), a_context)
1070 else
1071 -- Internal error: an inconsistency has been
1072 -- introduced in the AST since we resolved
1073 -- current anchored type.
1074 Result := False
1075 end
1076 else
1077 a_class := a_context.base_class
1078 if attached a_class.seeded_query (seed) as l_query then
1079 Result := l_query.type.same_base_formal_parameter_type_with_type_marks (other, other_type_mark, other_context, overridden_type_mark (a_type_mark), a_context)
1080 else
1081 -- Internal error: an inconsistency has been
1082 -- introduced in the AST since we resolved
1083 -- current anchored type.
1084 Result := False
1085 end
1086 end
1087 end
1088
1089 same_base_tuple_type_with_type_marks (other: ET_TUPLE_TYPE; other_type_mark: detachable ET_TYPE_MARK; other_context: ET_TYPE_CONTEXT; a_type_mark: detachable ET_TYPE_MARK; a_context: ET_TYPE_CONTEXT): BOOLEAN
1090 -- Do current type appearing in `a_context' and `other' type
1091 -- appearing in `other_context' have the same base type?
1092 -- Note that the type mark status of `Current' and `other' is
1093 -- overridden by `a_type_mark' and `other_type_mark', if not Void
1094 local
1095 a_class: ET_CLASS
1096 l_index: INTEGER
1097 do
1098 if seed = 0 then
1099 -- Anchored type not resolved yet.
1100 Result := False
1101 elseif is_like_argument then
1102 a_class := a_context.base_class
1103 l_index := index
1104 if attached a_class.seeded_feature (seed) as l_feature and then attached l_feature.arguments as l_args and then l_index <= l_args.count then
1105 Result := l_args.item (l_index).type.same_base_tuple_type_with_type_marks (other, other_type_mark, other_context, overridden_type_mark (a_type_mark), a_context)
1106 else
1107 -- Internal error: an inconsistency has been
1108 -- introduced in the AST since we resolved
1109 -- current anchored type.
1110 Result := False
1111 end
1112 else
1113 a_class := a_context.base_class
1114 if attached a_class.seeded_query (seed) as l_query then
1115 Result := l_query.type.same_base_tuple_type_with_type_marks (other, other_type_mark, other_context, overridden_type_mark (a_type_mark), a_context)
1116 else
1117 -- Internal error: an inconsistency has been
1118 -- introduced in the AST since we resolved
1119 -- current anchored type.
1120 Result := False
1121 end
1122 end
1123 end
1124
1125 feature -- Conformance
1126
1127 conforms_to_type_with_type_marks (other: ET_TYPE; other_type_mark: detachable ET_TYPE_MARK; other_context: ET_TYPE_CONTEXT; a_type_mark: detachable ET_TYPE_MARK; a_context: ET_TYPE_CONTEXT): BOOLEAN
1128 -- Same as `conforms_to_type' except that the type mark status of `Current'
1129 -- and `other' is overridden by `a_type_mark' and `other_type_mark', if not Void
1130 local
1131 a_class: ET_CLASS
1132 l_index: INTEGER
1133 do
1134 if other = Current and then other_type_mark = a_type_mark and then other_context = a_context then
1135 Result := True
1136 elseif seed = 0 then
1137 -- Anchored type not resolved yet.
1138 Result := False
1139 elseif is_like_argument then
1140 a_class := a_context.base_class
1141 l_index := index
1142 if attached a_class.seeded_feature (seed) as l_feature and then attached l_feature.arguments as l_args and then l_index <= l_args.count then
1143 Result := l_args.item (l_index).type.conforms_to_type_with_type_marks (other, other_type_mark, other_context, overridden_type_mark (a_type_mark), a_context)
1144 else
1145 -- Internal error: an inconsistency has been
1146 -- introduced in the AST since we resolved
1147 -- current anchored type.
1148 Result := False
1149 end
1150 else
1151 a_class := a_context.base_class
1152 if attached a_class.seeded_query (seed) as l_query then
1153 Result := l_query.type.conforms_to_type_with_type_marks (other, other_type_mark, other_context, overridden_type_mark (a_type_mark), a_context)
1154 else
1155 -- Internal error: an inconsistency has been
1156 -- introduced in the AST since we resolved
1157 -- current anchored type.
1158 Result := False
1159 end
1160 end
1161 end
1162
1163 feature {ET_TYPE, ET_TYPE_CONTEXT} -- Conformance
1164
1165 conforms_from_class_type_with_type_marks (other: ET_CLASS_TYPE; other_type_mark: detachable ET_TYPE_MARK; other_context: ET_TYPE_CONTEXT; a_type_mark: detachable ET_TYPE_MARK; a_context: ET_TYPE_CONTEXT): BOOLEAN
1166 -- Does `other' type appearing in `other_context' conform
1167 -- to current type appearing in `a_context'?
1168 -- Note that the type mark status of `Current' and `other' is
1169 -- overridden by `a_type_mark' and `other_type_mark', if not Void
1170 -- (Note: 'current_system.ancestor_builder' is used on the classes
1171 -- whose ancestors need to be built in order to check for conformance.)
1172 local
1173 a_class: ET_CLASS
1174 l_index: INTEGER
1175 do
1176 if seed = 0 then
1177 -- Anchored type not resolved yet.
1178 Result := False
1179 elseif is_like_argument then
1180 a_class := a_context.base_class
1181 l_index := index
1182 if attached a_class.seeded_feature (seed) as l_feature and then attached l_feature.arguments as l_args and then l_index <= l_args.count then
1183 Result := l_args.item (l_index).type.conforms_from_class_type_with_type_marks (other, other_type_mark, other_context, overridden_type_mark (a_type_mark), a_context)
1184 else
1185 -- Internal error: an inconsistency has been
1186 -- introduced in the AST since we resolved
1187 -- current anchored type.
1188 Result := False
1189 end
1190 else
1191 a_class := a_context.base_class
1192 if attached a_class.seeded_query (seed) as l_query then
1193 Result := l_query.type.conforms_from_class_type_with_type_marks (other, other_type_mark, other_context, overridden_type_mark (a_type_mark), a_context)
1194 else
1195 -- Internal error: an inconsistency has been
1196 -- introduced in the AST since we resolved
1197 -- current anchored type.
1198 Result := False
1199 end
1200 end
1201 end
1202
1203 conforms_from_formal_parameter_type_with_type_marks (other: ET_FORMAL_PARAMETER_TYPE; other_type_mark: detachable ET_TYPE_MARK; other_context: ET_TYPE_CONTEXT; a_type_mark: detachable ET_TYPE_MARK; a_context: ET_TYPE_CONTEXT): BOOLEAN
1204 -- Does `other' type appearing in `other_context' conform
1205 -- to current type appearing in `a_context'?
1206 -- Note that the type mark status of `Current' and `other' is
1207 -- overridden by `a_type_mark' and `other_type_mark', if not Void
1208 -- (Note: 'current_system.ancestor_builder' is used on the classes
1209 -- whose ancestors need to be built in order to check for conformance.)
1210 local
1211 a_class: ET_CLASS
1212 l_index: INTEGER
1213 do
1214 if seed = 0 then
1215 -- Anchored type not resolved yet.
1216 Result := False
1217 elseif is_like_argument then
1218 a_class := a_context.base_class
1219 l_index := index
1220 if attached a_class.seeded_feature (seed) as l_feature and then attached l_feature.arguments as l_args and then l_index <= l_args.count then
1221 Result := l_args.item (l_index).type.conforms_from_formal_parameter_type_with_type_marks (other, other_type_mark, other_context, overridden_type_mark (a_type_mark), a_context)
1222 else
1223 -- Internal error: an inconsistency has been
1224 -- introduced in the AST since we resolved
1225 -- current anchored type.
1226 Result := False
1227 end
1228 else
1229 a_class := a_context.base_class
1230 if attached a_class.seeded_query (seed) as l_query then
1231 Result := l_query.type.conforms_from_formal_parameter_type_with_type_marks (other, other_type_mark, other_context, overridden_type_mark (a_type_mark), a_context)
1232 else
1233 -- Internal error: an inconsistency has been
1234 -- introduced in the AST since we resolved
1235 -- current anchored type.
1236 Result := False
1237 end
1238 end
1239 end
1240
1241 conforms_from_tuple_type_with_type_marks (other: ET_TUPLE_TYPE; other_type_mark: attached ET_TYPE_MARK; other_context: ET_TYPE_CONTEXT; a_type_mark: attached ET_TYPE_MARK; a_context: ET_TYPE_CONTEXT): BOOLEAN
1242 -- Does `other' type appearing in `other_context' conform
1243 -- to current type appearing in `a_context'?
1244 -- Note that the type mark status of `Current' and `other' is
1245 -- overridden by `a_type_mark' and `other_type_mark', if not Void
1246 -- (Note: 'current_system.ancestor_builder' is used on the classes
1247 -- whose ancestors need to be built in order to check for conformance.)
1248 local
1249 a_class: ET_CLASS
1250 l_index: INTEGER
1251 do
1252 if seed = 0 then
1253 -- Anchored type not resolved yet.
1254 Result := False
1255 elseif is_like_argument then
1256 a_class := a_context.base_class
1257 l_index := index
1258 if attached a_class.seeded_feature (seed) as l_feature and then attached l_feature.arguments as l_args and then l_index <= l_args.count then
1259 Result := l_args.item (l_index).type.conforms_from_tuple_type_with_type_marks (other, other_type_mark, other_context, overridden_type_mark (a_type_mark), a_context)
1260 else
1261 -- Internal error: an inconsistency has been
1262 -- introduced in the AST since we resolved
1263 -- current anchored type.
1264 Result := False
1265 end
1266 else
1267 a_class := a_context.base_class
1268 if attached a_class.seeded_query (seed) as l_query then
1269 Result := l_query.type.conforms_from_tuple_type_with_type_marks (other, other_type_mark, other_context, overridden_type_mark (a_type_mark), a_context)
1270 else
1271 -- Internal error: an inconsistency has been
1272 -- introduced in the AST since we resolved
1273 -- current anchored type.
1274 Result := False
1275 end
1276 end
1277 end
1278
1279 feature -- Resolving
1280
1281 resolve_like_feature (a_query: ET_QUERY)
1282 -- Resolve current 'like feature' type where
1283 -- `a_query' if the associated feature.
1284 require
1285 a_query_not_void: a_query /= Void
1286 is_like_feature: not is_like_argument
1287 do
1288 seed := a_query.first_seed
1289 name.set_seed (seed)
1290 ensure
1291 seed_set: seed = a_query.first_seed
1292 end
1293
1294 resolve_like_argument (a_feature: ET_FEATURE)
1295 -- Resolve current 'like argument' type in `a_feature'.
1296 require
1297 a_feature_not_void: a_feature /= Void
1298 is_like_argument: is_like_argument
1299 do
1300 seed := a_feature.first_seed
1301 is_procedure := a_feature.is_procedure
1302 ensure
1303 seed_set: seed = a_feature.first_seed
1304 end
1305
1306 feature -- Output
1307
1308 append_to_string (a_string: STRING)
1309 -- Append textual representation of
1310 -- current type to `a_string'.
1311 do
1312 if attached type_mark as l_type_mark then
1313 if l_type_mark.is_implicit_mark then
1314 a_string.append_character ('[')
1315 end
1316 a_string.append_string (l_type_mark.text)
1317 if l_type_mark.is_implicit_mark then
1318 a_string.append_character (']')
1319 end
1320 a_string.append_character (' ')
1321 end
1322 a_string.append_string (like_space)
1323 a_string.append_string (name.lower_name)
1324 end
1325
1326 feature -- Processing
1327
1328 process (a_processor: ET_AST_PROCESSOR)
1329 -- Process current node.
1330 do
1331 a_processor.process_like_feature (Current)
1332 end
1333
1334 end

Properties

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

  ViewVC Help
Powered by ViewVC 1.1.23