/[eiffelstudio]/vendor/gobosoft.com/gobo/4.0d/library/tools/src/eiffel/parser/et_eiffel_parser_skeleton.e
ViewVC logotype

Contents of /vendor/gobosoft.com/gobo/4.0d/library/tools/src/eiffel/parser/et_eiffel_parser_skeleton.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: 85031 byte(s)
Update 4.0d version with changes in Gobo from 2016/05/09

1 note
2
3 description:
4
5 "Eiffel parser skeletons"
6
7 library: "Gobo Eiffel Tools Library"
8 copyright: "Copyright (c) 1999-2016, Eric Bezault and others"
9 license: "MIT License"
10 date: "$Date$"
11 revision: "$Revision$"
12
13 deferred class ET_EIFFEL_PARSER_SKELETON
14
15 inherit
16
17 YY_PARSER_SKELETON
18 rename
19 make as make_parser_skeleton,
20 parse as yyparse
21 redefine
22 report_error
23 end
24
25 ET_EIFFEL_SCANNER_SKELETON
26 rename
27 make as make_eiffel_scanner
28 redefine
29 reset, set_syntax_error
30 end
31
32 ET_CLASS_PROCESSOR
33 rename
34 process_identifier as process_ast_identifier,
35 process_c1_character_constant as process_ast_c1_character_constant,
36 process_c2_character_constant as process_ast_c2_character_constant,
37 process_regular_manifest_string as process_ast_regular_manifest_string
38 undefine
39 error_handler, current_universe, current_system
40 redefine
41 make
42 end
43
44 ET_AST_NULL_PROCESSOR
45 rename
46 process_identifier as process_ast_identifier,
47 process_c1_character_constant as process_ast_c1_character_constant,
48 process_c2_character_constant as process_ast_c2_character_constant,
49 process_regular_manifest_string as process_ast_regular_manifest_string
50 undefine
51 make
52 redefine
53 process_class, process_cluster
54 end
55
56 ET_SHARED_FEATURE_NAME_TESTER
57 export {NONE} all end
58
59 UT_SHARED_ISE_VERSIONS
60 export {NONE} all end
61
62 feature {NONE} -- Initialization
63
64 make
65 -- Create a new Eiffel parser.
66 do
67 precursor {ET_CLASS_PROCESSOR}
68 create eiffel_buffer.make_with_size (std.input, Initial_eiffel_buffer_size)
69 create counters.make (Initial_counters_capacity)
70 create last_formal_arguments_stack.make (Initial_last_formal_arguments_stack_capacity)
71 create last_local_variables_stack.make (Initial_last_local_variables_stack_capacity)
72 create last_keywords.make (Initial_last_keywords_capacity)
73 create last_symbols.make (Initial_last_symbols_capacity)
74 create last_object_tests_stack.make (Initial_last_object_tests_capacity)
75 create last_object_tests_pool.make (Initial_last_object_tests_capacity)
76 create last_across_components_stack.make (Initial_last_across_components_capacity)
77 create last_across_components_pool.make (Initial_last_across_components_capacity)
78 create assertions.make (Initial_assertions_capacity)
79 create check_assertion_counters.make (Initial_check_assertion_counters_capacity)
80 create queries.make (Initial_queries_capacity)
81 create procedures.make (Initial_procedures_capacity)
82 create constraints.make (Initial_constraints_capacity)
83 create providers.make (Initial_providers_capacity)
84 make_eiffel_scanner ("unknown file")
85 make_parser_skeleton
86 end
87
88 feature -- Initialization
89
90 reset
91 -- Reset parser before parsing next input.
92 do
93 precursor
94 eiffel_buffer.set_end_of_file
95 counters.wipe_out
96 wipe_out_last_formal_arguments_stack
97 wipe_out_last_local_variables_stack
98 wipe_out_last_object_tests_stack
99 wipe_out_last_across_components_stack
100 last_keywords.wipe_out
101 last_symbols.wipe_out
102 providers.wipe_out
103 assertions.wipe_out
104 check_assertion_counters.wipe_out
105 queries.wipe_out
106 procedures.wipe_out
107 constraints.wipe_out
108 last_class := Void
109 last_clients := Void
110 last_export_clients := Void
111 last_feature_clause := Void
112 end
113
114 feature -- Access
115
116 time_stamp: INTEGER
117 -- Time stamp of file being parsed
118
119 feature -- Status report
120
121 providers_enabled: BOOLEAN
122 -- Should providers be built when parsing a class?
123 do
124 Result := current_system.providers_enabled
125 end
126
127 feature -- Parsing
128
129 parse_file (a_file: KI_CHARACTER_INPUT_STREAM; a_filename: STRING; a_time_stamp: INTEGER; a_group: ET_PRIMARY_GROUP)
130 -- Parse all classes in `a_file' within group `a_group'.
131 -- `a_filename' is the filename of `a_file' and `a_time_stamp'
132 -- its time stamp just before it was open.
133 --
134 -- The queries `current_system.preparse_*_mode' govern the way
135 -- parsing works. Read the header comments of these features
136 -- for more details.
137 require
138 a_file_not_void: a_file /= Void
139 a_file_open_read: a_file.is_open_read
140 a_filename_not_void: a_filename /= Void
141 a_filename_not_empty: not a_filename.is_empty
142 a_group_not_void: a_group /= Void
143 local
144 old_group: ET_PRIMARY_GROUP
145 do
146 old_group := group
147 group := a_group
148 debug ("GELINT")
149 std.error.put_string ("Parsing file '")
150 std.error.put_string (a_filename)
151 std.error.put_line ("%'")
152 end
153 filename := a_filename
154 time_stamp := a_time_stamp
155 input_buffer := eiffel_buffer
156 eiffel_buffer.set_file (a_file)
157 yy_load_input_buffer
158 yyparse
159 reset
160 group := old_group
161 rescue
162 reset
163 end
164
165 parse_cluster (a_cluster: ET_CLUSTER)
166 -- Traverse `a_cluster' (recursively) and parse the classes
167 -- it contains. Classes are added to `universe.classes'.
168 --
169 -- The queries `current_system.preparse_*_mode' govern the way
170 -- parsing works. Read the header comments of these features
171 -- for more details.
172 require
173 a_cluster_not_void: a_cluster /= Void
174 local
175 a_filename: STRING
176 a_file: KL_TEXT_INPUT_FILE
177 a_time_stamp: INTEGER
178 dir_name: STRING
179 dir: KL_DIRECTORY
180 s: STRING
181 old_group: ET_PRIMARY_GROUP
182 l_already_preparsed: BOOLEAN
183 l_classes: detachable DS_ARRAYED_LIST [ET_CLASS]
184 l_cell: detachable DS_CELL [detachable ET_CLASS]
185 l_class_name: ET_IDENTIFIER
186 l_class: detachable ET_CLASS
187 i, nb: INTEGER
188 do
189 old_group := group
190 group := a_cluster
191 l_already_preparsed := a_cluster.is_preparsed
192 a_cluster.set_preparsed (True)
193 debug ("GELINT")
194 std.error.put_string ("Parse cluster '")
195 std.error.put_string (a_cluster.full_pathname)
196 std.error.put_line ("%'")
197 end
198 if not a_cluster.is_abstract and then (not l_already_preparsed or else ((current_system.preparse_readonly_mode or else not a_cluster.is_read_only) and then (current_system.preparse_override_mode implies a_cluster.is_override))) then
199 dir_name := Execution_environment.interpreted_string (a_cluster.full_pathname)
200 dir_name := file_system.canonical_pathname (dir_name)
201 dir := tmp_directory
202 dir.reset (dir_name)
203 dir.open_read
204 if dir.is_open_read then
205 from dir.read_entry until dir.end_of_input loop
206 s := dir.last_entry
207 if a_cluster.is_valid_eiffel_filename (s) then
208 a_filename := file_system.pathname (dir_name, s)
209 l_class := Void
210 if l_already_preparsed then
211 -- This cluster has already been traversed. Therefore
212 -- we are only interested in new or modified classes,
213 -- or those which have not been parsed yet.
214 if l_cell = Void then
215 create l_cell.make (Void)
216 else
217 l_cell.put (Void)
218 end
219 create l_class_name.make (s.substring (1, s.count - 2))
220 current_universe.master_class (l_class_name).local_classes_do_if (agent l_cell.put ({ET_CLASS}?), agent {ET_CLASS}.is_in_group (a_cluster))
221 if attached l_cell.item as l_local_class and then attached l_local_class.filename as l_local_class_filename and then file_system.same_pathnames (l_local_class_filename, a_filename) then
222 if l_local_class.is_parsed then
223 l_class := l_local_class
224 else
225 -- Force the parsing.
226 l_local_class.reset
227 end
228 else
229 if l_classes = Void then
230 l_classes := current_universe.classes_in_group (a_cluster)
231 end
232 l_class := Void
233 nb := l_classes.count
234 from i := 1 until i > nb loop
235 l_class := l_classes.item (i)
236 if attached l_class.filename as l_class_filename and then file_system.same_pathnames (l_class_filename, a_filename) then
237 if not l_class.is_parsed then
238 -- Force the parsing.
239 l_class.reset
240 l_class := Void
241 end
242 i := nb + 1
243 else
244 l_class := Void
245 i := i + 1
246 end
247 end
248 end
249 end
250 if l_class = Void then
251 -- This file is either new or has been marked as modified,
252 -- or has not been parsed yet. Let's parse it now.
253 a_file := tmp_file
254 a_file.reset (a_filename)
255 a_time_stamp := a_file.time_stamp
256 a_file.open_read
257 if a_file.is_open_read then
258 parse_file (a_file, a_filename, a_time_stamp, a_cluster)
259 a_file.close
260 else
261 error_handler.report_gcaab_error (a_cluster, a_filename)
262 end
263 end
264 elseif a_cluster.is_recursive and then a_cluster.is_valid_directory_name (s) then
265 if file_system.directory_exists (file_system.pathname (dir_name, s)) then
266 a_cluster.add_recursive_cluster (s)
267 end
268 end
269 dir.read_entry
270 end
271 dir.close
272 else
273 error_handler.report_gcaaa_error (a_cluster, dir_name)
274 end
275 end
276 build_provider_constraint (a_cluster)
277 build_dependant_constraint (a_cluster)
278 if attached a_cluster.subclusters as l_subclusters then
279 parse_clusters (l_subclusters)
280 end
281 group := old_group
282 end
283
284 parse_clusters (a_clusters: ET_CLUSTERS)
285 -- Traverse `a_clusters' (recursively) and parse the classes
286 -- they contain. Classes are added to `universe.classes'.
287 --
288 -- The queries `current_system.preparse_*_mode' govern the way
289 -- parsing works. Read the header comments of these features
290 -- for more details.
291 require
292 a_clusters_not_void: a_clusters /= Void
293 local
294 l_clusters: DS_ARRAYED_LIST [ET_CLUSTER]
295 l_cluster: ET_CLUSTER
296 i, nb: INTEGER
297 l_readonly_mode: BOOLEAN
298 l_override_mode: BOOLEAN
299 l_dir_name: STRING
300 do
301 l_readonly_mode := current_system.preparse_readonly_mode
302 l_override_mode := current_system.preparse_override_mode
303 l_clusters := a_clusters.clusters
304 nb := l_clusters.count
305 from i := 1 until i > nb loop
306 l_cluster := l_clusters.item (i)
307 if l_cluster.is_preparsed and then l_cluster.is_implicit and then (l_readonly_mode or else not l_cluster.is_read_only) and then (l_override_mode implies l_cluster.is_override) then
308 l_dir_name := Execution_environment.interpreted_string (l_cluster.full_pathname)
309 if not file_system.directory_exists (l_dir_name) then
310 l_clusters.remove (i)
311 nb := nb - 1
312 else
313 parse_cluster (l_cluster)
314 i := i + 1
315 end
316 else
317 parse_cluster (l_cluster)
318 i := i + 1
319 end
320 end
321 end
322
323 feature -- AST processing
324
325 process_class (a_class: ET_CLASS)
326 -- Parse `a_class'.
327 -- The class may end up with a syntax error status if its
328 -- `filename' didn't contain this class after all (i.e.
329 -- if the preparsing phase gave errouneous result).
330 --
331 -- The queries `current_system.preparse_*_mode' govern the way
332 -- parsing works. Read the header comments of these features
333 -- for more details.
334 local
335 a_time_stamp: INTEGER
336 a_cluster: ET_CLUSTER
337 a_file: KL_TEXT_INPUT_FILE
338 old_class: ET_CLASS
339 old_group: ET_PRIMARY_GROUP
340 l_class_text: KL_STRING_INPUT_STREAM
341 a_text_filename: STRING
342 l_class_filename: detachable STRING
343 do
344 if a_class.is_none then
345 a_class.set_parsed
346 elseif not current_class.is_unknown then
347 -- Internal error (recursive call)
348 -- This internal error is fatal.
349 set_fatal_error (a_class)
350 error_handler.report_giaaa_error
351 elseif not a_class.is_preparsed then
352 set_fatal_error (a_class)
353 else
354 old_class := current_class
355 current_class := a_class
356 old_group := group
357 group := current_class.group
358 if not current_class.is_parsed then
359 if current_class.is_in_cluster and then attached current_class.filename as a_filename then
360 a_cluster := current_class.group.cluster
361 current_class.reset_after_preparsed
362 a_file := tmp_file
363 a_file.reset (a_filename)
364 a_time_stamp := a_file.time_stamp
365 a_file.open_read
366 if a_file.is_open_read then
367 -- Note that `parse_file' may change the value of `current_class'
368 -- if `a_file' contains a class other than `a_class'.
369 parse_file (a_file, a_filename, a_time_stamp, a_cluster)
370 a_file.close
371 if not a_class.is_preparsed then
372 -- Make sure that `current_class' is as it was
373 -- after it was last preparsed when the file
374 -- does not contain this class anymore.
375 a_class.set_filename (a_filename)
376 a_class.set_group (a_cluster)
377 end
378 if not a_class.is_parsed then
379 if not syntax_error and current_system.preparse_multiple_mode then
380 -- The file contains other classes, but not `current_class'.
381 set_fatal_error (a_class)
382 error_handler.report_gvscn1b_error (a_class, a_filename)
383 end
384 end
385 else
386 -- Make sure that `current_class' is as it was
387 -- after it was last preparsed when the file
388 -- cannot be read.
389 current_class.set_filename (a_filename)
390 current_class.set_group (a_cluster)
391 set_fatal_error (current_class)
392 error_handler.report_gcaab_error (a_cluster, a_filename)
393 end
394 elseif current_class.is_in_dotnet_assembly then
395 current_system.dotnet_assembly_consumer.consume_class (current_class)
396 elseif attached {ET_TEXT_GROUP} current_class.group as l_text_group then
397 l_class_filename := current_class.filename
398 if l_class_filename /= Void and then not l_class_filename.is_empty then
399 a_text_filename := l_class_filename
400 else
401 a_text_filename := current_class.lower_name + ".e"
402 end
403 current_class.reset_after_preparsed
404 if attached l_text_group.class_text (current_class) as l_text then
405 create l_class_text.make (l_text)
406 else
407 create l_class_text.make ("")
408 end
409 -- Note that `parse_file' may change the value of `current_class'
410 -- if `l_class_text' contains a class other than `a_class'.
411 parse_file (l_class_text, a_text_filename, -1, l_text_group)
412 if not a_class.is_preparsed then
413 -- Make sure that `current_class' is as it was
414 -- after it was last preparsed when the file
415 -- does not contain this class anymore.
416 if l_class_filename /= Void and then not l_class_filename.is_empty then
417 a_class.set_filename (l_class_filename)
418 else
419 a_class.reset_preparsed
420 end
421 a_class.set_group (l_text_group)
422 end
423 if not a_class.is_parsed then
424 if not syntax_error and current_system.preparse_multiple_mode then
425 -- The class text contains other classes, but not `current_class'.
426 set_fatal_error (a_class)
427 error_handler.report_gvscn1b_error (a_class, a_text_filename)
428 end
429 end
430 end
431 if not a_class.is_parsed then
432 set_fatal_error (a_class)
433 end
434 end
435 current_class := old_class
436 group := old_group
437 end
438 ensure then
439 is_parsed: a_class.is_parsed
440 end
441
442 process_cluster (a_cluster: ET_CLUSTER)
443 -- Traverse `a_cluster' (recursively) and parse the classes
444 -- it contains. Classes are added to `universe.classes'.
445 --
446 -- The queries `current_system.preparse_*_mode' govern the way
447 -- parsing works. Read the header comments of these features
448 -- for more details.
449 do
450 parse_cluster (a_cluster)
451 end
452
453 feature {NONE} -- Basic operations
454
455 register_query (a_query: detachable ET_QUERY)
456 -- Register `a_query' in `last_class'.
457 do
458 if a_query /= Void then
459 current_system.register_feature (a_query)
460 queries.force_last (a_query)
461 queries.finish
462 if attached last_object_tests as l_last_object_tests then
463 a_query.set_object_tests (l_last_object_tests.cloned_object_test_list)
464 end
465 if attached last_across_components as l_last_across_components then
466 a_query.set_across_components (l_last_across_components.cloned_across_component_list)
467 end
468 end
469 -- Reset local variables, formal arguments, object-tests
470 -- and across components before reading the next feature.
471 wipe_out_last_formal_arguments_stack
472 wipe_out_last_local_variables_stack
473 wipe_out_last_object_tests_stack
474 wipe_out_last_across_components_stack
475 end
476
477 register_query_synonym (a_query: detachable ET_QUERY)
478 -- Register `a_query' in `last_class'.
479 do
480 if a_query /= Void then
481 current_system.register_feature (a_query)
482 if queries.before then
483 queries.forth
484 end
485 queries.force_left (a_query)
486 queries.back
487 end
488 end
489
490 register_procedure (a_procedure: detachable ET_PROCEDURE)
491 -- Register `a_procedure' in `last_class'.
492 do
493 if a_procedure /= Void then
494 current_system.register_feature (a_procedure)
495 procedures.force_last (a_procedure)
496 procedures.finish
497 if attached last_object_tests as l_last_object_tests then
498 a_procedure.set_object_tests (l_last_object_tests.cloned_object_test_list)
499 end
500 if attached last_across_components as l_last_across_components then
501 a_procedure.set_across_components (l_last_across_components.cloned_across_component_list)
502 end
503 end
504 -- Reset local variables, formal arguments, object-tests
505 -- and across components before reading the next feature.
506 wipe_out_last_formal_arguments_stack
507 wipe_out_last_local_variables_stack
508 wipe_out_last_object_tests_stack
509 wipe_out_last_across_components_stack
510 end
511
512 register_procedure_synonym (a_procedure: detachable ET_PROCEDURE)
513 -- Register `a_procedure' in `last_class'.
514 do
515 if a_procedure /= Void then
516 current_system.register_feature (a_procedure)
517 if procedures.before then
518 procedures.forth
519 end
520 procedures.force_left (a_procedure)
521 procedures.back
522 end
523 end
524
525 register_inline_agent (a_inline_agent: detachable ET_INLINE_AGENT)
526 -- Register `a_inline_agent'.
527 do
528 if a_inline_agent /= Void then
529 if attached last_object_tests as l_last_object_tests then
530 a_inline_agent.set_object_tests (l_last_object_tests.cloned_object_test_list)
531 end
532 if attached last_across_components as l_last_across_components then
533 a_inline_agent.set_across_components (l_last_across_components.cloned_across_component_list)
534 end
535 -- Clean up after the inline agent has been parsed.
536 set_end_closure
537 end
538 end
539
540 register_constraint (a_constraint: detachable ET_CONSTRAINT_TYPE)
541 -- Register generic constraint.
542 do
543 constraints.force_last (a_constraint)
544 ensure
545 one_more: constraints.count = old constraints.count + 1
546 registered: constraints.last = a_constraint
547 end
548
549 dummy_constraint (a_constraint: detachable ET_CONSTRAINT_TYPE): detachable ET_TYPE
550 -- Dummy type, or Void if `a_constraint' is Void
551 do
552 if a_constraint /= Void then
553 Result := dummy_type
554 end
555 ensure
556 void_type: a_constraint = Void implies Result = Void
557 non_void_type: a_constraint /= Void implies Result /= Void
558 end
559
560 set_formal_parameters (a_parameters: detachable ET_FORMAL_PARAMETER_LIST)
561 -- Set formal generic parameters of `last_class'.
562 require
563 no_constraint: a_parameters = Void implies constraints.is_empty
564 same_count: a_parameters /= Void implies constraints.count = a_parameters.count
565 local
566 a_class: like last_class
567 a_constraint: detachable ET_CONSTRAINT_TYPE
568 a_type: detachable ET_TYPE
569 i, nb: INTEGER
570 do
571 if a_parameters /= Void then
572 a_class := last_class
573 if a_class /= Void then
574 nb := a_parameters.count
575 from i := nb until i < 1 loop
576 if attached {ET_CONSTRAINED_FORMAL_PARAMETER} a_parameters.formal_parameter (i) as a_constrained_formal then
577 a_constraint := constraints.item (i)
578 if a_constraint /= Void then
579 a_type := a_constraint.resolved_syntactical_constraint (a_parameters, a_class, Current)
580 if a_type /= Void then
581 a_constrained_formal.set_constraint (a_type)
582 else
583 a_parameters.remove (i)
584 end
585 else
586 a_parameters.remove (i)
587 end
588 end
589 i := i - 1
590 end
591 a_class.set_formal_parameters (a_parameters)
592 end
593 end
594 constraints.wipe_out
595 end
596
597 set_class_features
598 -- Set features of `last_class'.
599 local
600 a_class: like last_class
601 l_queries: ET_QUERY_LIST
602 l_procedures: ET_PROCEDURE_LIST
603 i, nb: INTEGER
604 do
605 a_class := last_class
606 if a_class /= Void then
607 nb := queries.count
608 create l_queries.make_with_capacity (nb)
609 from i := nb until i < 1 loop
610 l_queries.put_first (queries.item (i))
611 i := i - 1
612 end
613 l_queries.set_declared_count (nb)
614 a_class.set_queries (l_queries)
615 nb := procedures.count
616 create l_procedures.make_with_capacity (nb)
617 from i := nb until i < 1 loop
618 l_procedures.put_first (procedures.item (i))
619 i := i - 1
620 end
621 l_procedures.set_declared_count (nb)
622 a_class.set_procedures (l_procedures)
623 end
624 queries.wipe_out
625 procedures.wipe_out
626 end
627
628 set_class_providers
629 -- Set providers of `last_class' (when enabled).
630 local
631 l_providers: DS_HASH_SET [ET_NAMED_CLASS]
632 l_class: like last_class
633 do
634 if providers_enabled then
635 l_class := last_class
636 if l_class /= Void then
637 create l_providers.make (providers.count)
638 l_class.set_providers (l_providers)
639 from providers.start until providers.after loop
640 l_providers.put_last (providers.item_for_iteration)
641 providers.forth
642 end
643 end
644 end
645 providers.wipe_out
646 end
647
648 set_class_to_end (a_class: detachable ET_CLASS; an_obsolete: detachable ET_OBSOLETE; a_parents: detachable ET_PARENT_LIST;
649 a_creators: detachable ET_CREATOR_LIST; a_convert_features: detachable ET_CONVERT_FEATURE_LIST;
650 a_feature_clauses: detachable ET_FEATURE_CLAUSE_LIST; an_invariants: detachable ET_INVARIANTS;
651 a_second_indexing: detachable ET_INDEXING_LIST; an_end: detachable ET_KEYWORD)
652 -- Set various elements to `a_class'.
653 do
654 if a_class /= Void then
655 a_class.set_obsolete_message (an_obsolete)
656 a_class.set_parent_clause (a_parents)
657 a_class.set_creators (a_creators)
658 a_class.set_convert_features (a_convert_features)
659 a_class.set_feature_clauses (a_feature_clauses)
660 a_class.set_invariants (an_invariants)
661 a_class.set_second_indexing (a_second_indexing)
662 if an_end /= Void then
663 a_class.set_end_keyword (an_end)
664 end
665 end
666 end
667
668 set_class_to_inheritance_end (a_class: detachable ET_CLASS; an_obsolete: detachable ET_OBSOLETE; a_parents: detachable ET_PARENT_LIST)
669 -- Set various elements to `a_class'.
670 -- Note: This is the case where the following class declaration:
671 -- class FOO inherit BAR end
672 -- produces a grammar ambiguity and where, through shift/reduce
673 -- conflicts, it has been parsed with 'end' being recognized as
674 -- the end of the feature adaptation of BAR instead of as the
675 -- end of the class FOO.
676 local
677 a_parent: ET_PARENT
678 an_end: detachable ET_KEYWORD
679 do
680 if a_class /= Void then
681 if a_parents /= Void and then not a_parents.is_empty then
682 a_parent := a_parents.last.parent
683 an_end := a_parent.end_keyword
684 if an_end /= Void and not a_parent.has_feature_adaptation then
685 a_parent.set_end_keyword (Void)
686 else
687 an_end := Void
688 end
689 end
690 end
691 set_class_to_end (a_class, an_obsolete, a_parents, Void, Void, Void, Void, Void, an_end)
692 end
693
694 set_inline_agent_actual_arguments (a_inline_agent: detachable ET_INLINE_AGENT; a_actual_arguments: detachable ET_AGENT_ARGUMENT_OPERANDS)
695 -- Set actual arguments of inline agent.
696 do
697 if a_inline_agent /= Void and a_actual_arguments /= Void then
698 a_inline_agent.set_actual_arguments (a_actual_arguments)
699 end
700 end
701
702 add_expression_assertion (an_expression: detachable ET_EXPRESSION; a_semicolon: detachable ET_SYMBOL)
703 -- Add `an_expression' assertion, optionally followed
704 -- by `a_semicolon', to `assertions'.
705 local
706 an_assertion: detachable ET_ASSERTION_ITEM
707 done: BOOLEAN
708 do
709 if not assertions.is_empty then
710 if attached {ET_TAGGED_ASSERTION} assertions.last as l_tagged and then l_tagged.expression = Void then
711 if an_expression /= Void then
712 l_tagged.set_expression (an_expression)
713 if a_semicolon /= Void then
714 an_assertion := ast_factory.new_assertion_semicolon (l_tagged, a_semicolon)
715 if an_assertion /= Void then
716 assertions.replace (an_assertion, assertions.count)
717 else
718 assertions.remove_last
719 end
720 end
721 else
722 assertions.remove_last
723 end
724 done := True
725 end
726 end
727 if not done then
728 if a_semicolon /= Void then
729 an_assertion := ast_factory.new_assertion_semicolon (an_expression, a_semicolon)
730 else
731 an_assertion := an_expression
732 end
733 if an_assertion /= Void then
734 assertions.force_last (an_assertion)
735 end
736 end
737 end
738
739 add_tagged_assertion (a_tag: detachable ET_IDENTIFIER; a_colon: detachable ET_SYMBOL; a_semicolon: detachable ET_SYMBOL)
740 -- Add tagged assertion, optionally followed
741 -- by `a_semicolon', to `assertions'.
742 local
743 an_assertion: detachable ET_TAGGED_ASSERTION
744 an_assertion_item: detachable ET_ASSERTION_ITEM
745 l_position: ET_POSITION
746 l_file_position: ET_FILE_POSITION
747 do
748 if current_system.is_ise then
749 -- ISE does not accept assertions of the form:
750 -- a_tag: -- a comment assertion
751 -- when followed by another tagged assertion.
752 if not assertions.is_empty then
753 if attached {ET_TAGGED_ASSERTION} assertions.last as l_tagged and then l_tagged.expression = Void then
754 if a_tag = Void then
755 l_position := current_position
756 else
757 l_position := a_tag.position
758 if not l_position.is_null then
759 create l_file_position.make (filename, l_position.line, l_position.column)
760 l_position := l_file_position
761 else
762 l_position := current_position
763 end
764 end
765 report_syntax_error (l_position)
766 end
767 end
768 end
769 an_assertion := ast_factory.new_tagged_assertion (ast_factory.new_tag (a_tag, a_colon))
770 if a_semicolon /= Void then
771 an_assertion_item := ast_factory.new_assertion_semicolon (an_assertion, a_semicolon)
772 else
773 an_assertion_item := an_assertion
774 end
775 if an_assertion_item /= Void then
776 assertions.force_last (an_assertion_item)
777 end
778 end
779
780 add_to_actual_parameter_list (a_parameter: detachable ET_ACTUAL_PARAMETER_ITEM; a_list: detachable ET_ACTUAL_PARAMETER_LIST)
781 -- Add `a_parameter' at the beginning of `a_list'.
782 do
783 if a_list /= Void and a_parameter /= Void then
784 a_list.put_first (a_parameter)
785 end
786 end
787
788 add_to_constraint_actual_parameter_list (a_parameter: detachable ET_CONSTRAINT_ACTUAL_PARAMETER_ITEM; a_list: detachable ET_CONSTRAINT_ACTUAL_PARAMETER_LIST)
789 -- Add `a_parameter' at the beginning of `a_list'.
790 do
791 if a_list /= Void and a_parameter /= Void then
792 a_list.put_first (a_parameter)
793 end
794 end
795
796 set_start_closure (a_formal_arguments: detachable ET_FORMAL_ARGUMENT_LIST)
797 -- Indicate the we just parsed the formal arguments of a
798 -- new closure (i.e. feature, invariant or inline agent).
799 -- Keep track of the values of `last_formal_arguments',
800 -- `last_local_variables', `last_object_tests' and
801 -- `last_across_components' for the enclosing closure.
802 -- They will be restored when we reach the end of the
803 -- closure by `set_end_closure'.
804 do
805 if not last_formal_arguments_stack.is_empty or last_formal_arguments /= Void then
806 last_formal_arguments_stack.force (last_formal_arguments)
807 end
808 last_formal_arguments := a_formal_arguments
809 if not last_local_variables_stack.is_empty or last_local_variables /= Void then
810 last_local_variables_stack.force (last_local_variables)
811 end
812 last_local_variables := Void
813 if not last_object_tests_stack.is_empty or last_object_tests /= Void then
814 last_object_tests_stack.force (last_object_tests)
815 end
816 last_object_tests := Void
817 if not last_across_components_stack.is_empty or last_across_components /= Void then
818 last_across_components_stack.force (last_across_components)
819 end
820 last_across_components := Void
821 end
822
823 set_end_closure
824 -- Indicate that the end of the closure (i.e. feature, invariant
825 -- or inline agent) being parsed has been reached. Restore
826 -- `last_formal_arguments', `last_local_variables',
827 -- `last_object_tests' and `last_across_components'
828 -- for the enclosing closure if any.
829 do
830 if not last_formal_arguments_stack.is_empty then
831 last_formal_arguments := last_formal_arguments_stack.item
832 last_formal_arguments_stack.remove
833 else
834 last_formal_arguments := Void
835 end
836 if not last_local_variables_stack.is_empty then
837 last_local_variables := last_local_variables_stack.item
838 last_local_variables_stack.remove
839 else
840 last_local_variables := Void
841 end
842 if not last_object_tests_stack.is_empty then
843 last_object_tests := last_object_tests_stack.item
844 last_object_tests_stack.remove
845 else
846 last_object_tests := Void
847 end
848 if not last_across_components_stack.is_empty then
849 last_across_components := last_across_components_stack.item
850 last_across_components_stack.remove
851 else
852 last_across_components := Void
853 end
854 end
855
856 start_check_instruction
857 -- Indicate that we start parsing a check-instruction.
858 do
859 check_assertion_counters.force_last (assertions.count)
860 end
861
862 feature {ET_CONSTRAINT_ACTUAL_PARAMETER_ITEM, ET_CONSTRAINT_ACTUAL_PARAMETER_LIST} -- Generic constraints
863
864 resolved_constraint_named_type (a_constraint: ET_CONSTRAINT_NAMED_TYPE;
865 a_formals: ET_FORMAL_PARAMETER_LIST; a_class: ET_CLASS): detachable ET_TYPE
866 -- Version of `a_constraint', appearing in the constraint of one
867 -- of the formal generic parameters in `a_formals' of `a_class',
868 -- where class names and formal generic parameter names have been
869 -- resolved (i.e. replaced by the corresponding Class_type,
870 -- Tuple_type and Formal_parameter_type)
871 require
872 a_constraint_not_void: a_constraint /= Void
873 a_formals_not_void: a_formals /= Void
874 a_class_not_void: a_class /= Void
875 local
876 a_name: ET_IDENTIFIER
877 a_formal: detachable ET_FORMAL_PARAMETER
878 a_type_mark: detachable ET_TYPE_MARK
879 a_base_class: ET_MASTER_CLASS
880 l_type_mark: detachable ET_TYPE_MARK
881 do
882 a_name := a_constraint.name
883 a_type_mark := a_constraint.type_mark
884 a_formal := a_formals.formal_parameter_by_name (a_name)
885 if a_formal /= Void then
886 if a_type_mark /= Void and then not a_type_mark.is_attachment_mark then
887 -- A formal parameter type is not a class type.
888 -- It cannot be prefixed by 'expanded' or 'reference'.
889 -- But it can be prefixed by 'attached', 'detachable', '!' or '?'.
890 report_syntax_error (a_type_mark.position)
891 Result := ast_factory.new_formal_parameter_type (Void, a_name, a_formal.index, a_class)
892 else
893 Result := ast_factory.new_formal_parameter_type (a_type_mark, a_name, a_formal.index, a_class)
894 end
895 else
896 a_base_class := current_universe.master_class (a_name)
897 if providers_enabled then
898 providers.force_last (a_base_class)
899 end
900 a_base_class.set_in_system (True)
901 l_type_mark := a_type_mark
902 if l_type_mark = Void then
903 l_type_mark := current_universe.implicit_attachment_type_mark
904 end
905 if a_base_class.name.same_class_name (tokens.tuple_class_name) then
906 if a_type_mark /= Void and then not a_type_mark.is_attachment_mark then
907 -- A TUPLE type is not a class type. It cannot
908 -- be prefixed by 'expanded' or 'reference'.
909 -- But it can be prefixed by 'attached', 'detachable', '!' or '?'.
910 report_syntax_error (a_type_mark.position)
911 Result := ast_factory.new_tuple_type (Void, a_name, Void, a_base_class)
912 else
913 Result := ast_factory.new_tuple_type (l_type_mark, a_name, Void, a_base_class)
914 end
915 else
916 Result := ast_factory.new_class_type (l_type_mark, a_name, a_base_class)
917 end
918 end
919 end
920
921 resolved_constraint_generic_named_type (a_constraint: ET_CONSTRAINT_GENERIC_NAMED_TYPE;
922 a_formals: ET_FORMAL_PARAMETER_LIST; a_class: ET_CLASS): detachable ET_TYPE
923 -- Version `a_constraint', appearing in the constraint of one
924 -- of the formal generic parameters in `a_formals' of `a_class',
925 -- where class names and formal generic parameter names have been
926 -- resolved (i.e. replaced by the corresponding Class_type,
927 -- Tuple_type and Formal_parameter_type)
928 require
929 a_constraint_not_void: a_constraint /= Void
930 a_formals_not_void: a_formals /= Void
931 a_class_not_void: a_class /= Void
932 local
933 a_name: ET_IDENTIFIER
934 a_type_mark: detachable ET_TYPE_MARK
935 a_formal: detachable ET_FORMAL_PARAMETER
936 a_base_class: ET_MASTER_CLASS
937 a_parameters: detachable ET_ACTUAL_PARAMETER_LIST
938 l_type_mark: detachable ET_TYPE_MARK
939 do
940 a_name := a_constraint.name
941 a_type_mark := a_constraint.type_mark
942 a_formal := a_formals.formal_parameter_by_name (a_name)
943 if a_formal /= Void then
944 if a_type_mark /= Void and then not a_type_mark.is_attachment_mark then
945 -- A formal parameter type is not a class type.
946 -- It cannot be prefixed by 'expanded' or 'reference'.
947 -- But it can be prefixed by 'attached', 'detachable', '!' or '?'.
948 report_syntax_error (a_type_mark.position)
949 end
950 -- A formal parameter cannot have actual generic parameters.
951 report_syntax_error (a_constraint.actual_parameters.position)
952 Result := ast_factory.new_formal_parameter_type (a_type_mark, a_name, a_formal.index, a_class)
953 else
954 a_base_class := current_universe.master_class (a_name)
955 a_parameters := a_constraint.actual_parameters.resolved_syntactical_constraint (a_formals, a_class, Current)
956 if a_parameters /= Void then
957 if providers_enabled then
958 providers.force_last (a_base_class)
959 end
960 a_base_class.set_in_system (True)
961 l_type_mark := a_type_mark
962 if l_type_mark = Void then
963 l_type_mark := current_universe.implicit_attachment_type_mark
964 end
965 if a_base_class.name.same_class_name (tokens.tuple_class_name) then
966 if a_type_mark /= Void and then not a_type_mark.is_attachment_mark then
967 -- A TUPLE type is not a class type. It cannot
968 -- be prefixed by 'expanded' or 'reference'.
969 -- But it can be prefixed by 'attached', 'detachable', '!' or '?'.
970 report_syntax_error (a_type_mark.position)
971 Result := ast_factory.new_tuple_type (Void, a_name, a_parameters, a_base_class)
972 else
973 Result := ast_factory.new_tuple_type (l_type_mark, a_name, a_parameters, a_base_class)
974 end
975 else
976 Result := ast_factory.new_generic_class_type (l_type_mark, a_name, a_parameters, a_base_class)
977 end
978 end
979 end
980 end
981
982 resolved_constraint_actual_parameter_list (a_constraint: ET_CONSTRAINT_ACTUAL_PARAMETER_LIST;
983 a_formals: ET_FORMAL_PARAMETER_LIST; a_class: ET_CLASS): detachable ET_ACTUAL_PARAMETER_LIST
984 -- Version of `a_constraint', appearing in the constraint of one
985 -- of the formal generic parameters in `a_formals' of `a_class',
986 -- where class names and formal generic parameter names have been
987 -- resolved (i.e. replaced by the corresponding Class_type,
988 -- Tuple_type and Formal_parameter_type)
989 require
990 a_constraint_not_void: a_constraint /= Void
991 a_formals_not_void: a_formals /= Void
992 a_class_not_void: a_class /= Void
993 local
994 i, nb: INTEGER
995 l_type: ET_CONSTRAINT_TYPE
996 l_other_type: detachable ET_CONSTRAINT_TYPE
997 l_resolved_type: detachable ET_TYPE
998 l_parameter: detachable ET_ACTUAL_PARAMETER_ITEM
999 l_actual: ET_CONSTRAINT_ACTUAL_PARAMETER_ITEM
1000 do
1001 nb := a_constraint.count
1002 Result := ast_factory.new_actual_parameters (a_constraint.left_bracket, a_constraint.right_bracket, nb)
1003 if Result /= Void then
1004 from i := nb until i < 1 loop
1005 l_actual := a_constraint.item (i)
1006 l_type := l_actual.type
1007 if l_type /= l_other_type then
1008 l_resolved_type := l_type.resolved_syntactical_constraint (a_formals, a_class, Current)
1009 l_other_type := l_type
1010 end
1011 l_parameter := l_actual.resolved_syntactical_constraint_with_type (l_resolved_type, Current)
1012 if l_parameter /= Void then
1013 Result.put_first (l_parameter)
1014 end
1015 i := i - 1
1016 end
1017 end
1018 end
1019
1020 resolved_constraint_actual_parameter_comma (a_constraint: ET_CONSTRAINT_ACTUAL_PARAMETER_COMMA;
1021 a_type: detachable ET_TYPE): detachable ET_ACTUAL_PARAMETER_ITEM
1022 -- Version of `a_constraint', where its type has been replaced by `a_type'
1023 require
1024 a_constraint_not_void: a_constraint /= Void
1025 local
1026 a_parameter: detachable ET_ACTUAL_PARAMETER
1027 do
1028 a_parameter := a_constraint.actual_parameter.resolved_syntactical_constraint_with_type (a_type, Current)
1029 Result := ast_factory.new_actual_parameter_comma (a_parameter, a_constraint.comma)
1030 end
1031
1032 resolved_constraint_labeled_actual_parameter (a_constraint: ET_CONSTRAINT_LABELED_ACTUAL_PARAMETER;
1033 a_type: detachable ET_TYPE): detachable ET_LABELED_ACTUAL_PARAMETER
1034 -- Version of `a_constraint', where its type has been replaced by `a_type'
1035 require
1036 a_constraint_not_void: a_constraint /= Void
1037 do
1038 Result := ast_factory.new_labeled_actual_parameter (a_constraint.label, ast_factory.new_colon_type (a_constraint.colon, a_type))
1039 end
1040
1041 resolved_constraint_labeled_comma_actual_parameter (a_constraint: ET_CONSTRAINT_LABELED_COMMA_ACTUAL_PARAMETER;
1042 a_type: detachable ET_TYPE): detachable ET_LABELED_ACTUAL_PARAMETER
1043 -- Version of `a_constraint', where its type has been replaced by `a_type'
1044 require
1045 a_constraint_not_void: a_constraint /= Void
1046 do
1047 Result := ast_factory.new_labeled_comma_actual_parameter (ast_factory.new_label_comma (a_constraint.label, a_constraint.comma), a_type)
1048 end
1049
1050 resolved_constraint_labeled_actual_parameter_semicolon (a_constraint: ET_CONSTRAINT_LABELED_ACTUAL_PARAMETER_SEMICOLON;
1051 a_type: detachable ET_TYPE): detachable ET_ACTUAL_PARAMETER_ITEM
1052 -- Version of `a_constraint', where its type has been replaced by `a_type'
1053 require
1054 a_constraint_not_void: a_constraint /= Void
1055 local
1056 l_parameter: detachable ET_LABELED_ACTUAL_PARAMETER
1057 do
1058 l_parameter := a_constraint.actual_parameter.resolved_syntactical_constraint_with_type (a_type, Current)
1059 Result := ast_factory.new_labeled_actual_parameter_semicolon (l_parameter, a_constraint.semicolon)
1060 end
1061
1062 feature {NONE} -- AST factory
1063
1064 new_across_all_expression (a_across_header: detachable ET_ACROSS_EXPRESSION; an_invariant: detachable ET_LOOP_INVARIANTS;
1065 an_until_conditional: detachable ET_CONDITIONAL; a_all_conditional: detachable ET_CONDITIONAL;
1066 a_variant: detachable ET_VARIANT; an_end: detachable ET_KEYWORD): detachable ET_ACROSS_EXPRESSION
1067 -- New across all expression
1068 do
1069 if a_across_header /= Void and a_all_conditional /= Void then
1070 Result := a_across_header
1071 Result.set_until_conditional (an_until_conditional)
1072 Result.set_iteration_conditional (a_all_conditional)
1073 Result.set_all (True)
1074 Result.set_invariant_part (an_invariant)
1075 Result.set_variant_part (a_variant)
1076 if an_end /= Void then
1077 Result.set_end_keyword (an_end)
1078 end
1079 -- We set 'cursor_name.is_across_cursor' to False when
1080 -- parsing within its scope.
1081 Result.cursor_name.set_across_cursor (True)
1082 end
1083 end
1084
1085 new_across_expression_header (a_across: detachable ET_KEYWORD; a_iterable_expression: detachable ET_EXPRESSION;
1086 a_as: detachable ET_KEYWORD; a_cursor_name: detachable ET_IDENTIFIER): detachable ET_ACROSS_EXPRESSION
1087 -- New across expression header
1088 local
1089 l_last_across_components: like last_across_components
1090 l_cursor_name: ET_IDENTIFIER
1091 do
1092 Result := ast_factory.new_across_all_expression (a_across, a_iterable_expression, a_as, a_cursor_name, Void, Void, tokens.true_keyword, Void, Void)
1093 if Result /= Void then
1094 l_last_across_components := last_across_components
1095 if l_last_across_components = Void then
1096 l_last_across_components := new_across_component_list
1097 last_across_components := l_last_across_components
1098 end
1099 l_last_across_components.force_last (Result)
1100 -- We set 'cursor_name.is_across_cursor' to False when
1101 -- parsing within its scope.
1102 l_cursor_name := Result.cursor_name
1103 l_cursor_name.set_across_cursor (False)
1104 l_cursor_name.set_seed (l_last_across_components.count)
1105 end
1106 end
1107
1108 new_across_instruction (a_across_header: detachable ET_ACROSS_INSTRUCTION;
1109 a_from_compound: detachable ET_COMPOUND; an_invariant: detachable ET_LOOP_INVARIANTS;
1110 an_until_conditional: detachable ET_CONDITIONAL; a_loop_compound: detachable ET_COMPOUND;
1111 a_variant: detachable ET_VARIANT; an_end: detachable ET_KEYWORD): detachable ET_ACROSS_INSTRUCTION
1112 -- New across instruction
1113 do
1114 if a_across_header /= Void then
1115 Result := a_across_header
1116 Result.set_from_compound (a_from_compound)
1117 Result.set_until_conditional (an_until_conditional)
1118 Result.set_loop_compound (a_loop_compound)
1119 Result.set_invariant_part (an_invariant)
1120 Result.set_variant_part (a_variant)
1121 if an_end /= Void then
1122 Result.set_end_keyword (an_end)
1123 end
1124 -- We set 'cursor_name.is_across_cursor' to False when
1125 -- parsing within its scope.
1126 Result.cursor_name.set_across_cursor (True)
1127 end
1128 end
1129
1130 new_across_instruction_header (a_across: detachable ET_KEYWORD;
1131 a_iterable_expression: detachable ET_EXPRESSION; a_as: detachable ET_KEYWORD;
1132 a_cursor_name: detachable ET_IDENTIFIER): detachable ET_ACROSS_INSTRUCTION
1133 -- New across instruction header
1134 local
1135 l_last_across_components: like last_across_components
1136 l_cursor_name: ET_IDENTIFIER
1137 do
1138 Result := ast_factory.new_across_instruction (a_across, a_iterable_expression, a_as, a_cursor_name, Void, Void, Void, Void, Void, Void)
1139 if Result /= Void then
1140 l_last_across_components := last_across_components
1141 if l_last_across_components = Void then
1142 l_last_across_components := new_across_component_list
1143 last_across_components := l_last_across_components
1144 end
1145 l_last_across_components.force_last (Result)
1146 -- We set 'cursor_name.is_across_cursor' to False when
1147 -- parsing within its scope.
1148 l_cursor_name := Result.cursor_name
1149 l_cursor_name.set_across_cursor (False)
1150 l_cursor_name.set_seed (l_last_across_components.count)
1151 end
1152 end
1153
1154 new_across_some_expression (a_across_header: detachable ET_ACROSS_EXPRESSION;
1155 an_invariant: detachable ET_LOOP_INVARIANTS;
1156 an_until_conditional: detachable ET_CONDITIONAL;
1157 a_some_conditional: detachable ET_CONDITIONAL;
1158 a_variant: detachable ET_VARIANT;
1159 an_end: detachable ET_KEYWORD): detachable ET_ACROSS_EXPRESSION
1160 -- New across some expression
1161 do
1162 if a_across_header /= Void and a_some_conditional /= Void then
1163 Result := a_across_header
1164 Result.set_until_conditional (an_until_conditional)
1165 Result.set_iteration_conditional (a_some_conditional)
1166 Result.set_some (True)
1167 Result.set_invariant_part (an_invariant)
1168 Result.set_variant_part (a_variant)
1169 if an_end /= Void then
1170 Result.set_end_keyword (an_end)
1171 end
1172 -- We set 'cursor_name.is_across_cursor' to False when
1173 -- parsing within its scope.
1174 Result.cursor_name.set_across_cursor (True)
1175 end
1176 end
1177
1178 new_agent_identifier_target (an_identifier: detachable ET_IDENTIFIER): detachable ET_IDENTIFIER
1179 -- New agent identifier target
1180 local
1181 a_seed: INTEGER
1182 do
1183 if an_identifier /= Void then
1184 Result := an_identifier
1185 if attached last_formal_arguments as l_last_formal_arguments then
1186 a_seed := l_last_formal_arguments.index_of (an_identifier)
1187 if a_seed /= 0 then
1188 an_identifier.set_seed (a_seed)
1189 an_identifier.set_argument (True)
1190 l_last_formal_arguments.formal_argument (a_seed).set_used (True)
1191 end
1192 end
1193 if a_seed = 0 and then attached last_local_variables as l_last_local_variables then
1194 a_seed := l_last_local_variables.index_of (an_identifier)
1195 if a_seed /= 0 then
1196 an_identifier.set_seed (a_seed)
1197 an_identifier.set_local (True)
1198 l_last_local_variables.local_variable (a_seed).set_used (True)
1199 end
1200 end
1201 if a_seed = 0 then
1202 if attached last_object_tests as l_last_object_tests then
1203 a_seed := l_last_object_tests.index_of_name (an_identifier)
1204 if a_seed /= 0 then
1205 an_identifier.set_object_test_local (True)
1206 end
1207 end
1208 if attached last_across_components as l_last_across_components then
1209 a_seed := l_last_across_components.index_of_name (an_identifier)
1210 if a_seed /= 0 and then not l_last_across_components.across_component (a_seed).cursor_name.is_across_cursor then
1211 -- We set 'cursor_name.is_across_cursor' to False when
1212 -- parsing withing its scope.
1213 an_identifier.set_across_cursor (True)
1214 end
1215 end
1216 end
1217 end
1218 end
1219
1220 new_alias_free_name (an_alias: detachable ET_KEYWORD;
1221 a_string: detachable ET_MANIFEST_STRING): detachable ET_ALIAS_FREE_NAME
1222 -- New alias free feature name
1223 do
1224 if a_string /= Void then
1225 if a_string.value.count > 0 then
1226 Result := ast_factory.new_alias_free_name (an_alias, a_string)
1227 else
1228 -- TODO: error.
1229 end
1230 else
1231 Result := ast_factory.new_alias_free_name (an_alias, a_string)
1232 end
1233 end
1234
1235 new_any_clients (a_keyword: detachable ET_KEYWORD): detachable ET_CLIENT_LIST
1236 -- Implicit client list (when preceded by `a_keyword')
1237 -- with only one client: "ANY"
1238 local
1239 l_name: ET_IDENTIFIER
1240 l_position: ET_POSITION
1241 l_client: detachable ET_CLIENT
1242 do
1243 if a_keyword = Void or else a_keyword.position.is_null then
1244 Result := current_system.any_clients
1245 else
1246 create Result.make_with_capacity (1)
1247 create l_name.make (tokens.any_class_name.name)
1248 l_position := a_keyword.position
1249 l_name.set_position (l_position.line, l_position.column)
1250 l_client := new_client (l_name)
1251 if l_client /= Void then
1252 Result.put_first (l_client)
1253 end
1254 end
1255 end
1256
1257 new_check_instruction (a_check: detachable ET_KEYWORD; a_then_compound: detachable ET_COMPOUND;
1258 an_end: detachable ET_KEYWORD): detachable ET_CHECK_INSTRUCTION
1259 -- New check instruction
1260 local
1261 i, nb: INTEGER
1262 l_old_count: INTEGER
1263 l_first: INTEGER
1264 do
1265 if not check_assertion_counters.is_empty then
1266 l_old_count := check_assertion_counters.last
1267 check_assertion_counters.remove_last
1268 end
1269 i := assertions.count
1270 nb := i - l_old_count
1271 if nb <= 0 then
1272 Result := ast_factory.new_check_instruction (a_check, a_then_compound, an_end, 0)
1273 else
1274 Result := ast_factory.new_check_instruction (a_check, a_then_compound, an_end, nb)
1275 if Result /= Void then
1276 l_first := l_old_count + 1
1277 from until i < l_first loop
1278 Result.put_first (assertions.item (i))
1279 assertions.remove_last
1280 i := i - 1
1281 end
1282 else
1283 l_first := l_old_count + 1
1284 from until i < l_first loop
1285 assertions.remove_last
1286 i := i - 1
1287 end
1288 end
1289 end
1290 end
1291
1292 new_choice_attribute_constant (a_name: detachable ET_IDENTIFIER): detachable ET_IDENTIFIER
1293 -- New choice constant which is supposed to be the name of
1294 -- a constant attribute or unique attribute
1295 local
1296 a_seed: INTEGER
1297 do
1298 if a_name /= Void then
1299 Result := a_name
1300 if attached last_formal_arguments as l_last_formal_arguments then
1301 a_seed := l_last_formal_arguments.index_of (a_name)
1302 if a_seed /= 0 then
1303 a_name.set_seed (a_seed)
1304 a_name.set_argument (True)
1305 l_last_formal_arguments.formal_argument (a_seed).set_used (True)
1306 end
1307 end
1308 if a_seed = 0 and then attached last_local_variables as l_last_local_variables then
1309 a_seed := l_last_local_variables.index_of (a_name)
1310 if a_seed /= 0 then
1311 a_name.set_seed (a_seed)
1312 a_name.set_local (True)
1313 l_last_local_variables.local_variable (a_seed).set_used (True)
1314 end
1315 end
1316 if a_seed = 0 then
1317 if attached last_object_tests as l_last_object_tests then
1318 a_seed := l_last_object_tests.index_of_name (a_name)
1319 if a_seed /= 0 then
1320 a_name.set_object_test_local (True)
1321 end
1322 end
1323 if attached last_across_components as l_last_across_components then
1324 a_seed := l_last_across_components.index_of_name (a_name)
1325 if a_seed /= 0 and then not l_last_across_components.across_component (a_seed).cursor_name.is_across_cursor then
1326 -- We set 'cursor_name.is_across_cursor' to False when
1327 -- parsing within its scope.
1328 a_name.set_across_cursor (True)
1329 end
1330 end
1331 end
1332 end
1333 end
1334
1335 new_client (a_name: detachable ET_CLASS_NAME): detachable ET_CLIENT
1336 -- New client
1337 local
1338 l_base_class: ET_MASTER_CLASS
1339 do
1340 if a_name /= Void then
1341 l_base_class := current_universe.master_class (a_name)
1342 Result := ast_factory.new_client (a_name, l_base_class)
1343 end
1344 end
1345
1346 new_client_comma (a_name: detachable ET_CLASS_NAME; a_comma: detachable ET_SYMBOL): detachable ET_CLIENT_ITEM
1347 -- New client followed by a comma
1348 local
1349 l_base_class: ET_MASTER_CLASS
1350 do
1351 if a_name /= Void then
1352 l_base_class := current_universe.master_class (a_name)
1353 Result := ast_factory.new_client_comma (a_name, l_base_class, a_comma)
1354 end
1355 end
1356
1357 new_constraint_named_type (a_type_mark: detachable ET_TYPE_MARK; a_name: detachable ET_IDENTIFIER;
1358 a_parameters: detachable ET_CONSTRAINT_ACTUAL_PARAMETER_LIST): detachable ET_CONSTRAINT_NAMED_TYPE
1359 -- New Eiffel class type or formal generic paramater
1360 -- appearing in a generic constraint
1361 do
1362 if a_parameters /= Void then
1363 Result := ast_factory.new_constraint_generic_named_type (a_type_mark, a_name, a_parameters)
1364 else
1365 Result := ast_factory.new_constraint_named_type (a_type_mark, a_name)
1366 end
1367 end
1368
1369 new_external_function (a_name: detachable ET_EXTENDED_FEATURE_NAME; args: detachable ET_FORMAL_ARGUMENT_LIST;
1370 a_type: detachable ET_DECLARED_TYPE; an_assigner: detachable ET_ASSIGNER;
1371 an_is: detachable ET_KEYWORD; a_first_indexing: detachable ET_INDEXING_LIST;
1372 an_obsolete: detachable ET_OBSOLETE; a_preconditions: detachable ET_PRECONDITIONS;
1373 a_language: detachable ET_EXTERNAL_LANGUAGE;
1374 an_alias: detachable ET_EXTERNAL_ALIAS; a_postconditions: detachable ET_POSTCONDITIONS;
1375 an_end: detachable ET_KEYWORD; a_semicolon: detachable ET_SEMICOLON_SYMBOL;
1376 a_clients: detachable ET_CLIENT_LIST;
1377 a_feature_clause: detachable ET_FEATURE_CLAUSE;
1378 a_class: detachable ET_CLASS): detachable ET_EXTERNAL_FUNCTION
1379 -- New external function
1380 do
1381 Result := ast_factory.new_external_function (a_name, args, a_type, an_assigner, an_is, a_first_indexing,
1382 an_obsolete, a_preconditions, a_language, an_alias, a_postconditions,
1383 an_end, a_semicolon, a_clients, a_feature_clause, a_class)
1384 end
1385
1386 new_external_procedure (a_name: detachable ET_EXTENDED_FEATURE_NAME; args: detachable ET_FORMAL_ARGUMENT_LIST;
1387 an_is: detachable ET_KEYWORD; a_first_indexing: detachable ET_INDEXING_LIST; an_obsolete: detachable ET_OBSOLETE;
1388 a_preconditions: detachable ET_PRECONDITIONS; a_language: detachable ET_EXTERNAL_LANGUAGE; an_alias: detachable ET_EXTERNAL_ALIAS;
1389 a_postconditions: detachable ET_POSTCONDITIONS; an_end: detachable ET_KEYWORD;
1390 a_semicolon: detachable ET_SEMICOLON_SYMBOL; a_clients: detachable ET_CLIENT_LIST;
1391 a_feature_clause: detachable ET_FEATURE_CLAUSE; a_class: detachable ET_CLASS): detachable ET_EXTERNAL_PROCEDURE
1392 -- New external procedure
1393 do
1394 Result := ast_factory.new_external_procedure (a_name, args, an_is, a_first_indexing,
1395 an_obsolete, a_preconditions, a_language, an_alias, a_postconditions,
1396 an_end, a_semicolon, a_clients, a_feature_clause, a_class)
1397 end
1398
1399 new_feature_address (d: detachable ET_SYMBOL; a_name: detachable ET_FEATURE_NAME): detachable ET_FEATURE_ADDRESS
1400 -- New feature address
1401 local
1402 l_seed: INTEGER
1403 do
1404 if attached {ET_IDENTIFIER} a_name as l_identifier then
1405 if attached last_formal_arguments as l_last_formal_arguments then
1406 l_seed := l_last_formal_arguments.index_of (l_identifier)
1407 if l_seed /= 0 then
1408 l_identifier.set_seed (l_seed)
1409 l_identifier.set_argument (True)
1410 l_last_formal_arguments.formal_argument (l_seed).set_used (True)
1411 end
1412 end
1413 if l_seed = 0 and then attached last_local_variables as l_last_local_variables then
1414 l_seed := l_last_local_variables.index_of (l_identifier)
1415 if l_seed /= 0 then
1416 l_identifier.set_seed (l_seed)
1417 l_identifier.set_local (True)
1418 l_last_local_variables.local_variable (l_seed).set_used (True)
1419 end
1420 end
1421 if l_seed = 0 then
1422 if attached last_object_tests as l_last_object_tests then
1423 l_seed := l_last_object_tests.index_of_name (l_identifier)
1424 if l_seed /= 0 then
1425 l_identifier.set_object_test_local (True)
1426 end
1427 end
1428 if attached last_across_components as l_last_across_components then
1429 l_seed := l_last_across_components.index_of_name (l_identifier)
1430 if l_seed /= 0 and then not l_last_across_components.across_component (l_seed).cursor_name.is_across_cursor then
1431 -- We set 'cursor_name.is_across_cursor' to False when
1432 -- parsing within its scope.
1433 l_identifier.set_across_cursor (True)
1434 end
1435 end
1436 end
1437 end
1438 Result := ast_factory.new_feature_address (d, a_name)
1439 end
1440
1441 new_formal_arguments (a_left, a_right: detachable ET_SYMBOL; nb: INTEGER): detachable ET_FORMAL_ARGUMENT_LIST
1442 -- New formal argument list with given capacity
1443 require
1444 nb_positive: nb >= 0
1445 do
1446 Result := ast_factory.new_formal_arguments (a_left, a_right, nb)
1447 end
1448
1449 new_invalid_alias_name (an_alias: detachable ET_KEYWORD; a_string: detachable ET_MANIFEST_STRING): detachable ET_ALIAS_FREE_NAME
1450 -- New invalid alias feature name
1451 do
1452 -- ERROR
1453 Result := new_alias_free_name (an_alias, a_string)
1454 end
1455
1456 new_invalid_infix_name (an_infix: detachable ET_KEYWORD; an_operator: detachable ET_MANIFEST_STRING): detachable ET_INFIX_FREE_NAME
1457 -- New invalid infix feature name
1458 do
1459 -- ERROR
1460 Result := new_infix_free_name (an_infix, an_operator)
1461 end
1462
1463 new_invalid_prefix_name (a_prefix: detachable ET_KEYWORD; an_operator: detachable ET_MANIFEST_STRING): detachable ET_PREFIX_FREE_NAME
1464 -- New invalid prefix feature name
1465 do
1466 -- ERROR
1467 Result := new_prefix_free_name (a_prefix, an_operator)
1468 end
1469
1470 new_infix_free_name (an_infix: detachable ET_KEYWORD; an_operator: detachable ET_MANIFEST_STRING): detachable ET_INFIX_FREE_NAME
1471 -- New infix free feature name
1472 do
1473 if an_operator /= Void then
1474 if an_operator.value.count > 0 then
1475 Result := ast_factory.new_infix_free_name (an_infix, an_operator)
1476 else
1477 -- TODO: error.
1478 end
1479 else
1480 Result := ast_factory.new_infix_free_name (an_infix, an_operator)
1481 end
1482 end
1483
1484 new_invariants (an_invariant: detachable ET_KEYWORD): detachable ET_INVARIANTS
1485 -- New class invariants
1486 local
1487 i: INTEGER
1488 do
1489 i := assertions.count
1490 if i = 0 then
1491 Result := ast_factory.new_invariants (an_invariant, last_class, 0)
1492 else
1493 Result := ast_factory.new_invariants (an_invariant, last_class, i)
1494 if Result /= Void then
1495 from until i < 1 loop
1496 Result.put_first (assertions.item (i))
1497 i := i - 1
1498 end
1499 end
1500 assertions.wipe_out
1501 end
1502 if Result /= Void then
1503 if attached last_object_tests as l_last_object_tests then
1504 Result.set_object_tests (l_last_object_tests.cloned_object_test_list)
1505 end
1506 if attached last_across_components as l_last_across_components then
1507 Result.set_across_components (l_last_across_components.cloned_across_component_list)
1508 end
1509 end
1510 -- Reset local variables, formal arguments, object-tests
1511 -- and across components before reading the next closure.
1512 wipe_out_last_formal_arguments_stack
1513 wipe_out_last_local_variables_stack
1514 wipe_out_last_object_tests_stack
1515 wipe_out_last_across_components_stack
1516 end
1517
1518 new_local_variables (a_local: detachable ET_KEYWORD; nb: INTEGER): detachable ET_LOCAL_VARIABLE_LIST
1519 -- New local variable list with given capacity
1520 require
1521 nb_positive: nb >= 0
1522 do
1523 Result := ast_factory.new_local_variables (a_local, nb)
1524 last_local_variables := Result
1525 end
1526
1527 new_loop_invariants (an_invariant: detachable ET_KEYWORD): detachable ET_LOOP_INVARIANTS
1528 -- New loop invariants
1529 local
1530 i: INTEGER
1531 do
1532 i := assertions.count
1533 if i = 0 then
1534 Result := ast_factory.new_loop_invariants (an_invariant, 0)
1535 else
1536 Result := ast_factory.new_loop_invariants (an_invariant, i)
1537 if Result /= Void then
1538 from until i < 1 loop
1539 Result.put_first (assertions.item (i))
1540 i := i - 1
1541 end
1542 end
1543 assertions.wipe_out
1544 end
1545 end
1546
1547 new_named_object_test (a_attached: detachable ET_KEYWORD; a_type: detachable ET_TARGET_TYPE;
1548 a_expression: detachable ET_EXPRESSION; a_as: detachable ET_KEYWORD;
1549 a_name: detachable ET_IDENTIFIER): detachable ET_NAMED_OBJECT_TEST
1550 -- New named object-test expression
1551 local
1552 l_name: ET_IDENTIFIER
1553 l_last_object_tests: like last_object_tests
1554 do
1555 Result := ast_factory.new_named_object_test (a_attached, a_type, a_expression, a_as, a_name)
1556 if Result /= Void then
1557 l_last_object_tests := last_object_tests
1558 if l_last_object_tests = Void then
1559 l_last_object_tests := new_object_test_list
1560 last_object_tests := l_last_object_tests
1561 end
1562 l_last_object_tests.force_last (Result)
1563 l_name := Result.name
1564 l_name.set_object_test_local (True)
1565 l_name.set_seed (l_last_object_tests.count)
1566 end
1567 end
1568
1569 new_named_type (a_type_mark: detachable ET_TYPE_MARK; a_name: detachable ET_IDENTIFIER;
1570 a_generics: detachable ET_ACTUAL_PARAMETER_LIST): detachable ET_TYPE
1571 -- New Eiffel class type or formal generic paramater
1572 local
1573 a_parameter: detachable ET_FORMAL_PARAMETER
1574 a_last_class: like last_class
1575 l_class: ET_MASTER_CLASS
1576 l_type_mark: detachable ET_TYPE_MARK
1577 do
1578 a_last_class := last_class
1579 if a_last_class /= Void and a_name /= Void then
1580 a_parameter := a_last_class.formal_parameter (a_name)
1581 if a_parameter /= Void then
1582 if a_generics /= Void then
1583 -- TODO: Error
1584 end
1585 if a_type_mark /= Void and then not a_type_mark.is_attachment_mark then
1586 -- TODO: Error
1587 end
1588 Result := ast_factory.new_formal_parameter_type (a_type_mark, a_name, a_parameter.index, a_last_class)
1589 else
1590 l_class := current_universe.master_class (a_name)
1591 if providers_enabled then
1592 providers.force_last (l_class)
1593 end
1594 l_class.set_in_system (True)
1595 l_type_mark := a_type_mark
1596 if l_type_mark = Void then
1597 l_type_mark := current_universe.implicit_attachment_type_mark
1598 end
1599 if a_generics /= Void then
1600 Result := ast_factory.new_generic_class_type (l_type_mark, a_name, a_generics, l_class)
1601 else
1602 Result := ast_factory.new_class_type (l_type_mark, a_name, l_class)
1603 end
1604 end
1605 end
1606 end
1607
1608 new_parent (a_name: detachable ET_IDENTIFIER; a_generic_parameters: detachable ET_ACTUAL_PARAMETER_LIST;
1609 a_renames: detachable ET_RENAME_LIST; an_exports: detachable ET_EXPORT_LIST; an_undefines, a_redefines,
1610 a_selects: detachable ET_KEYWORD_FEATURE_NAME_LIST; an_end: detachable ET_KEYWORD): detachable ET_PARENT
1611 -- New parent
1612 local
1613 a_type: detachable ET_CLASS_TYPE
1614 a_last_class: like last_class
1615 l_class: ET_MASTER_CLASS
1616 do
1617 a_last_class := last_class
1618 if a_last_class /= Void and a_name /= Void then
1619 if a_last_class.has_formal_parameter (a_name) then
1620 -- Error
1621 end
1622 l_class := current_universe.master_class (a_name)
1623 if providers_enabled then
1624 providers.force_last (l_class)
1625 end
1626 l_class.set_in_system (True)
1627 if a_generic_parameters /= Void then
1628 a_type := ast_factory.new_generic_class_type (Void, a_name, a_generic_parameters, l_class)
1629 else
1630 a_type := ast_factory.new_class_type (Void, a_name, l_class)
1631 end
1632 Result := ast_factory.new_parent (a_type, a_renames, an_exports,
1633 an_undefines, a_redefines, a_selects, an_end)
1634 end
1635 end
1636
1637 new_old_object_test (a_left_brace: detachable ET_SYMBOL; a_name: detachable ET_IDENTIFIER;
1638 a_colon: detachable ET_SYMBOL; a_type: detachable ET_TYPE; a_right_brace: detachable ET_SYMBOL;
1639 a_expression: detachable ET_EXPRESSION): detachable ET_OLD_OBJECT_TEST
1640 -- New object-test expression
1641 local
1642 l_name: ET_IDENTIFIER
1643 l_last_object_tests: like last_object_tests
1644 do
1645 Result := ast_factory.new_old_object_test (a_left_brace, a_name, a_colon, a_type, a_right_brace, a_expression)
1646 if Result /= Void then
1647 l_last_object_tests := last_object_tests
1648 if l_last_object_tests = Void then
1649 l_last_object_tests := new_object_test_list
1650 last_object_tests := l_last_object_tests
1651 end
1652 l_last_object_tests.force_last (Result)
1653 l_name := Result.name
1654 l_name.set_object_test_local (True)
1655 l_name.set_seed (l_last_object_tests.count)
1656 end
1657 end
1658
1659 new_once_manifest_string (a_once: detachable ET_KEYWORD; a_string: detachable ET_MANIFEST_STRING): detachable ET_ONCE_MANIFEST_STRING
1660 -- New once manifest string
1661 do
1662 Result := ast_factory.new_once_manifest_string (a_once, a_string)
1663 if Result /= Void then
1664 current_system.register_inline_constant (Result)
1665 end
1666 end
1667
1668 new_postconditions (an_ensure: detachable ET_KEYWORD; a_then: detachable ET_KEYWORD): detachable ET_POSTCONDITIONS
1669 -- New postconditions
1670 local
1671 i: INTEGER
1672 do
1673 i := assertions.count
1674 if i = 0 then
1675 Result := ast_factory.new_postconditions (an_ensure, a_then, 0)
1676 else
1677 Result := ast_factory.new_postconditions (an_ensure, a_then, i)
1678 if Result /= Void then
1679 from until i < 1 loop
1680 Result.put_first (assertions.item (i))
1681 i := i - 1
1682 end
1683 end
1684 assertions.wipe_out
1685 end
1686 end
1687
1688 new_preconditions (a_require: detachable ET_KEYWORD; an_else: detachable ET_KEYWORD): detachable ET_PRECONDITIONS
1689 -- New preconditions
1690 local
1691 i: INTEGER
1692 do
1693 i := assertions.count
1694 if i = 0 then
1695 Result := ast_factory.new_preconditions (a_require, an_else, 0)
1696 else
1697 Result := ast_factory.new_preconditions (a_require, an_else, i)
1698 if Result /= Void then
1699 from until i < 1 loop
1700 Result.put_first (assertions.item (i))
1701 i := i - 1
1702 end
1703 end
1704 assertions.wipe_out
1705 end
1706 end
1707
1708 new_prefix_free_name (a_prefix: detachable ET_KEYWORD; an_operator: detachable ET_MANIFEST_STRING): detachable ET_PREFIX_FREE_NAME
1709 -- New prefix free feature name
1710 do
1711 if an_operator /= Void then
1712 if an_operator.value.count > 0 then
1713 Result := ast_factory.new_prefix_free_name (a_prefix, an_operator)
1714 else
1715 -- TODO: error.
1716 end
1717 else
1718 Result := ast_factory.new_prefix_free_name (a_prefix, an_operator)
1719 end
1720 end
1721
1722 new_prefix_minus_expression (a_sign: detachable ET_SYMBOL_OPERATOR; an_expression: detachable ET_EXPRESSION): detachable ET_EXPRESSION
1723 -- New prefix minus expression
1724 do
1725 if a_sign /= Void and an_expression /= Void then
1726 if attached {ET_INTEGER_CONSTANT} an_expression as l_integer then
1727 if l_integer.sign = Void then
1728 l_integer.set_sign (a_sign)
1729 Result := l_integer
1730 end
1731 elseif attached {ET_REAL_CONSTANT} an_expression as l_real then
1732 if l_real.sign = Void then
1733 l_real.set_sign (a_sign)
1734 Result := l_real
1735 end
1736 end
1737 end
1738 if Result = Void then
1739 Result := ast_factory.new_prefix_expression (ast_factory.new_prefix_minus_operator (a_sign), an_expression)
1740 end
1741 end
1742
1743 new_prefix_plus_expression (a_sign: detachable ET_SYMBOL_OPERATOR; an_expression: detachable ET_EXPRESSION): detachable ET_EXPRESSION
1744 -- New prefix plus expression
1745 do
1746 if a_sign /= Void and an_expression /= Void then
1747 if attached {ET_INTEGER_CONSTANT} an_expression as l_integer then
1748 if l_integer.sign = Void then
1749 l_integer.set_sign (a_sign)
1750 Result := l_integer
1751 end
1752 elseif attached {ET_REAL_CONSTANT} an_expression as l_real then
1753 if l_real.sign = Void then
1754 l_real.set_sign (a_sign)
1755 Result := l_real
1756 end
1757 end
1758 end
1759 if Result = Void then
1760 Result := ast_factory.new_prefix_expression (ast_factory.new_prefix_plus_operator (a_sign), an_expression)
1761 end
1762 end
1763
1764 new_tuple_type (a_type_mark: detachable ET_TYPE_MARK; a_tuple: detachable ET_IDENTIFIER;
1765 a_generics: detachable ET_ACTUAL_PARAMETER_LIST): detachable ET_TUPLE_TYPE
1766 -- New 'TUPLE' type
1767 local
1768 a_class: ET_NAMED_CLASS
1769 l_type_mark: detachable ET_TYPE_MARK
1770 do
1771 if a_tuple /= Void then
1772 a_class := current_universe.master_class (a_tuple)
1773 if providers_enabled then
1774 providers.force_last (a_class)
1775 end
1776 a_class.set_in_system (True)
1777 l_type_mark := a_type_mark
1778 if l_type_mark = Void then
1779 l_type_mark := current_universe.implicit_attachment_type_mark
1780 end
1781 Result := ast_factory.new_tuple_type (l_type_mark, a_tuple, a_generics, a_class)
1782 end
1783 end
1784
1785 new_unqualified_call_expression (a_name: detachable ET_IDENTIFIER; args: detachable ET_ACTUAL_ARGUMENT_LIST): detachable ET_EXPRESSION
1786 -- New unqualified call expression
1787 local
1788 a_seed: INTEGER
1789 do
1790 if args /= Void then
1791 Result := ast_factory.new_unqualified_call_expression (a_name, args)
1792 else
1793 Result := a_name
1794 end
1795 if a_name /= Void then
1796 if attached last_formal_arguments as l_last_formal_arguments then
1797 a_seed := l_last_formal_arguments.index_of (a_name)
1798 if a_seed /= 0 then
1799 a_name.set_seed (a_seed)
1800 a_name.set_argument (True)
1801 l_last_formal_arguments.formal_argument (a_seed).set_used (True)
1802 end
1803 end
1804 if a_seed = 0 and then attached last_local_variables as l_last_local_variables then
1805 a_seed := l_last_local_variables.index_of (a_name)
1806 if a_seed /= 0 then
1807 a_name.set_seed (a_seed)
1808 a_name.set_local (True)
1809 l_last_local_variables.local_variable (a_seed).set_used (True)
1810 end
1811 end
1812 if a_seed = 0 and then attached last_across_components as l_last_across_components then
1813 a_seed := l_last_across_components.index_of_name (a_name)
1814 if a_seed /= 0 and then not l_last_across_components.across_component (a_seed).cursor_name.is_across_cursor then
1815 -- We set 'cursor_name.is_across_cursor' to False when
1816 -- parsing within its scope.
1817 a_name.set_across_cursor (True)
1818 end
1819 end
1820 if a_seed = 0 and then attached last_object_tests as l_last_object_tests then
1821 a_seed := l_last_object_tests.index_of_name (a_name)
1822 if a_seed /= 0 then
1823 a_name.set_object_test_local (True)
1824 end
1825 end
1826 end
1827 end
1828
1829 new_unqualified_call_instruction (a_name: detachable ET_IDENTIFIER; args: detachable ET_ACTUAL_ARGUMENT_LIST): detachable ET_INSTRUCTION
1830 -- New unqualified call instruction
1831 local
1832 a_seed: INTEGER
1833 do
1834 if args /= Void then
1835 Result := ast_factory.new_unqualified_call_instruction (a_name, args)
1836 else
1837 Result := a_name
1838 end
1839 if a_name /= Void then
1840 if attached last_formal_arguments as l_last_formal_arguments then
1841 a_seed := l_last_formal_arguments.index_of (a_name)
1842 if a_seed /= 0 then
1843 a_name.set_seed (a_seed)
1844 a_name.set_argument (True)
1845 l_last_formal_arguments.formal_argument (a_seed).set_used (True)
1846 end
1847 end
1848 if a_seed = 0 and then attached last_local_variables as l_last_local_variables then
1849 a_seed := l_last_local_variables.index_of (a_name)
1850 if a_seed /= 0 then
1851 a_name.set_seed (a_seed)
1852 a_name.set_local (True)
1853 l_last_local_variables.local_variable (a_seed).set_used (True)
1854 end
1855 end
1856 if a_seed = 0 and then attached last_across_components as l_last_across_components then
1857 a_seed := l_last_across_components.index_of_name (a_name)
1858 if a_seed /= 0 and then not l_last_across_components.across_component (a_seed).cursor_name.is_across_cursor then
1859 -- We set 'cursor_name.is_across_cursor' to False when
1860 -- parsing within its scope.
1861 a_name.set_across_cursor (True)
1862 end
1863 end
1864 if a_seed = 0 and then attached last_object_tests as l_last_object_tests then
1865 a_seed := l_last_object_tests.index_of_name (a_name)
1866 if a_seed /= 0 then
1867 a_name.set_object_test_local (True)
1868 end
1869 end
1870 if a_seed = 0 and args = Void then
1871 a_name.set_instruction (True)
1872 end
1873 end
1874 end
1875
1876 new_writable (a_name: detachable ET_IDENTIFIER): detachable ET_WRITABLE
1877 -- New writable
1878 local
1879 a_seed: INTEGER
1880 do
1881 if a_name /= Void then
1882 Result := a_name
1883 if attached last_local_variables as l_last_local_variables then
1884 a_seed := l_last_local_variables.index_of (a_name)
1885 if a_seed /= 0 then
1886 a_name.set_seed (a_seed)
1887 a_name.set_local (True)
1888 l_last_local_variables.local_variable (a_seed).set_used (True)
1889 end
1890 end
1891 end
1892 end
1893
1894 new_class (a_name: detachable ET_IDENTIFIER): detachable ET_CLASS
1895 -- New Eiffel class
1896 local
1897 old_current_class: ET_CLASS
1898 l_basename: STRING
1899 l_class_name: ET_IDENTIFIER
1900 l_master_class: ET_MASTER_CLASS
1901 l_new_class: ET_CLASS
1902 do
1903 if a_name /= Void then
1904 l_master_class := current_universe.master_class (a_name)
1905 if current_class.name.same_class_name (a_name) then
1906 Result := current_class
1907 elseif l_master_class.has_local_class (current_class) then
1908 Result := current_class
1909 elseif attached l_master_class.first_local_class as l_first_local_class then
1910 Result := l_first_local_class
1911 else
1912 Result := tokens.unknown_class
1913 end
1914 if not current_system.preparse_multiple_mode and then not current_class.is_unknown and then Result /= current_class then
1915 -- We are parsing another class than the one we want to parse.
1916 set_fatal_error (current_class)
1917 error_handler.report_gvscn1a_error (current_class, a_name, filename)
1918 -- Stop the parsing.
1919 accept
1920 elseif current_system.preparse_shallow_mode and then current_class.is_unknown and then not file_system.basename (filename).as_lower.same_string (a_name.lower_name + ".e") then
1921 -- The file does not contain the expected class
1922 -- (whose name is supposed to match the filename).
1923 l_basename := file_system.basename (filename).as_lower
1924 if l_basename.ends_with (".e") then
1925 l_basename := l_basename.substring (1, l_basename.count - 2)
1926 end
1927 create l_class_name.make (l_basename)
1928 create l_new_class.make (l_class_name)
1929 l_new_class.set_filename (filename)
1930 l_new_class.set_group (group)
1931 set_fatal_error (l_new_class)
1932 error_handler.report_gvscn1a_error (l_new_class, a_name, filename)
1933 -- Stop the parsing.
1934 accept
1935 else
1936 if not Result.is_unknown and then ((Result = current_class) or (Result.is_in_cluster and then (Result.group = group and attached Result.filename as l_result_filename and then file_system.same_pathnames (l_result_filename, filename)))) then
1937 -- This is the class we want to parse.
1938 if Result.is_parsed then
1939 -- TODO: find a way to check whether two classes in the same file don't have the same name.
1940 if Result = l_master_class.actual_class then
1941 l_master_class.set_modified (True)
1942 end
1943 Result.reset
1944 end
1945 Result.set_name (a_name)
1946 Result.set_group (group)
1947 else
1948 create Result.make (a_name)
1949 current_system.register_class (Result)
1950 Result.set_group (group)
1951 if group.is_cluster then
1952 l_master_class.add_last_local_class (Result)
1953 end
1954 end
1955 Result.set_filename (filename)
1956 Result.set_parsed
1957 Result.set_time_stamp (time_stamp)
1958 Result.set_in_system (True)
1959 old_current_class := current_class
1960 current_class := Result
1961 error_handler.report_compilation_status (Current, current_class)
1962 current_class := old_current_class
1963 queries.wipe_out
1964 procedures.wipe_out
1965 end
1966 end
1967 end
1968
1969 new_query_synonym (a_name: detachable ET_EXTENDED_FEATURE_NAME; a_query: detachable ET_QUERY): detachable ET_QUERY
1970 -- New synomym for feature `a_query'
1971 do
1972 if a_name /= Void and a_query /= Void then
1973 Result := a_query.new_synonym (a_name)
1974 end
1975 end
1976
1977 new_procedure_synonym (a_name: detachable ET_EXTENDED_FEATURE_NAME; a_procedure: detachable ET_PROCEDURE): detachable ET_PROCEDURE
1978 -- New synomym for feature `a_procedure'
1979 do
1980 if a_name /= Void and a_procedure /= Void then
1981 Result := a_procedure.new_synonym (a_name)
1982 end
1983 end
1984
1985 feature -- Error handling
1986
1987 report_error (a_message: STRING)
1988 -- Print error message.
1989 do
1990 report_syntax_error (current_position)
1991 end
1992
1993 set_syntax_error
1994 -- Set syntax error flag in class being parsed, if already known.
1995 do
1996 if attached last_class as l_last_class then
1997 set_fatal_error (l_last_class)
1998 end
1999 end
2000
2001 set_fatal_error (a_class: ET_CLASS)
2002 -- Report a fatal error to `a_class'.
2003 require
2004 a_class_not_void: a_class /= Void
2005 do
2006 a_class.set_parsed
2007 a_class.set_syntax_error
2008 ensure
2009 is_parsed: a_class.is_parsed
2010 has_syntax_error: a_class.has_syntax_error
2011 end
2012
2013 feature {NONE} -- Access
2014
2015 last_clients: detachable ET_CLIENT_LIST
2016 -- Last clients read
2017
2018 last_export_clients: detachable ET_CLIENTS
2019 -- Last clients read in New_export clauses
2020
2021 last_feature_clause: detachable ET_FEATURE_CLAUSE
2022 -- Last feature clause read
2023
2024 last_class: detachable ET_CLASS
2025 -- Class being parsed
2026
2027 assertions: DS_ARRAYED_LIST [ET_ASSERTION_ITEM]
2028 -- List of assertions currently being parsed
2029
2030 check_assertion_counters: DS_ARRAYED_LIST [INTEGER]
2031 -- List of counters when parsing nested check-instructions
2032
2033 queries: DS_ARRAYED_LIST [ET_QUERY]
2034 -- List of queries currently being parsed
2035
2036 procedures: DS_ARRAYED_LIST [ET_PROCEDURE]
2037 -- List of procedures currently being parsed
2038
2039 constraints: DS_ARRAYED_LIST [detachable ET_CONSTRAINT_TYPE]
2040 -- List of generic constraints currently being parsed
2041
2042 providers: DS_HASH_SET [ET_NAMED_CLASS]
2043 -- Provider classes already read (when enabled)
2044
2045 feature {NONE} -- Local variables
2046
2047 last_local_variables: detachable ET_LOCAL_VARIABLE_LIST
2048 -- Last local variable clause read for the closure
2049 -- (i.e. feature or inline agent) being parsed
2050
2051 last_local_variables_stack: DS_ARRAYED_STACK [detachable ET_LOCAL_VARIABLE_LIST]
2052 -- Stack of last local variable clauses read
2053 -- for the enclosing closures (i.e. feature or
2054 -- inline agents) of the closure being parsed
2055
2056 wipe_out_last_local_variables_stack
2057 -- Wipe out `last_local_variables_stack' and
2058 -- set `last_local_variables' to Void.
2059 do
2060 last_local_variables_stack.wipe_out
2061 last_local_variables := Void
2062 ensure
2063 last_local_variables_stack_wiped_out: last_local_variables_stack.is_empty
2064 last_local_variables_void: last_local_variables = Void
2065 end
2066
2067 feature {NONE} -- Object-tests
2068
2069 last_object_tests: detachable ET_OBJECT_TEST_LIST
2070 -- Object-tests already found in the closure (i.e. feature,
2071 -- invariant or inline agent) being parsed
2072
2073 last_object_tests_stack: DS_ARRAYED_STACK [detachable ET_OBJECT_TEST_LIST]
2074 -- Stack of object-tests already found in the enclosing
2075 -- closures (i.e. feature, invariant or inline agents)
2076 -- of the closure being parsed
2077
2078 last_object_tests_pool: DS_ARRAYED_STACK [ET_OBJECT_TEST_LIST]
2079 -- Pool of object-test lists available for usage
2080 -- whenever needed
2081
2082 new_object_test_list: ET_OBJECT_TEST_LIST
2083 -- New object-test list;
2084 -- Reuse items from `last_object_tests_pool' if available.
2085 do
2086 if not last_object_tests_pool.is_empty then
2087 Result := last_object_tests_pool.item
2088 last_object_tests_pool.remove
2089 else
2090 create Result.make_with_capacity (Initial_last_object_tests_capacity)
2091 end
2092 ensure
2093 new_object_test_list_not_void: Result /= Void
2094 end
2095
2096 wipe_out_last_object_tests_stack
2097 -- Wipe out `last_object_tests_stack' and
2098 -- set `last_object_tests' to Void.
2099 local
2100 l_object_test_list: detachable ET_OBJECT_TEST_LIST
2101 i, nb: INTEGER
2102 do
2103 if attached last_object_tests as l_last_object_tests then
2104 l_last_object_tests.wipe_out
2105 last_object_tests_pool.force (l_last_object_tests)
2106 last_object_tests := Void
2107 end
2108 nb := last_object_tests_stack.count
2109 from i := 1 until i > nb loop
2110 l_object_test_list := last_object_tests_stack.i_th (i)
2111 if l_object_test_list /= Void then
2112 l_object_test_list.wipe_out
2113 last_object_tests_pool.force (l_object_test_list)
2114 end
2115 i := i + 1
2116 end
2117 last_object_tests_stack.wipe_out
2118 ensure
2119 last_object_tests_stack_wiped_out: last_object_tests_stack.is_empty
2120 last_object_tests_void: last_object_tests = Void
2121 end
2122
2123 feature {NONE} -- Across components
2124
2125 last_across_components: detachable ET_ACROSS_COMPONENT_LIST
2126 -- Across components already found in the closure (i.e. feature,
2127 -- invariant or inline agent) being parsed
2128
2129 last_across_components_stack: DS_ARRAYED_STACK [detachable ET_ACROSS_COMPONENT_LIST]
2130 -- Stack of across components already found in the enclosing
2131 -- closures (i.e. feature, invariant or inline agents)
2132 -- of the closure being parsed
2133
2134 last_across_components_pool: DS_ARRAYED_STACK [ET_ACROSS_COMPONENT_LIST]
2135 -- Pool of across component lists available for usage
2136 -- whenever needed
2137
2138 new_across_component_list: ET_ACROSS_COMPONENT_LIST
2139 -- New across component list;
2140 -- Reuse items from `last_across_components_pool' if available.
2141 do
2142 if not last_across_components_pool.is_empty then
2143 Result := last_across_components_pool.item
2144 last_across_components_pool.remove
2145 else
2146 create Result.make_with_capacity (Initial_last_across_components_capacity)
2147 end
2148 ensure
2149 new_across_component_list_not_void: Result /= Void
2150 end
2151
2152 wipe_out_last_across_components_stack
2153 -- Wipe out `last_across_components_stack' and
2154 -- set `last_across_components' to Void.
2155 local
2156 l_across_component_list: detachable ET_ACROSS_COMPONENT_LIST
2157 i, nb: INTEGER
2158 do
2159 if attached last_across_components as l_last_across_components then
2160 l_last_across_components.wipe_out
2161 last_across_components_pool.force (l_last_across_components)
2162 last_across_components := Void
2163 end
2164 nb := last_across_components_stack.count
2165 from i := 1 until i > nb loop
2166 l_across_component_list := last_across_components_stack.i_th (i)
2167 if l_across_component_list /= Void then
2168 l_across_component_list.wipe_out
2169 last_across_components_pool.force (l_across_component_list)
2170 end
2171 i := i + 1
2172 end
2173 last_across_components_stack.wipe_out
2174 ensure
2175 last_across_components_stack_wiped_out: last_across_components_stack.is_empty
2176 last_across_components_void: last_across_components = Void
2177 end
2178
2179 feature {NONE} -- Formal arguments
2180
2181 last_formal_arguments: detachable ET_FORMAL_ARGUMENT_LIST
2182 -- Last formal argument clause read for the closure
2183 -- (i.e. feature or inline agent) being parsed
2184
2185 last_formal_arguments_stack: DS_ARRAYED_STACK [detachable ET_FORMAL_ARGUMENT_LIST]
2186 -- Stack of last formal argument clauses read
2187 -- for the enclosing closures (i.e. feature or
2188 -- inline agents) of the closure being parsed
2189
2190 wipe_out_last_formal_arguments_stack
2191 -- Wipe out `last_formal_arguments_stack' and
2192 -- set `last_formal_arguments' to Void.
2193 do
2194 last_formal_arguments_stack.wipe_out
2195 last_formal_arguments := Void
2196 ensure
2197 last_formal_arguments_stack_wiped_out: last_formal_arguments_stack.is_empty
2198 last_formal_arguments_void: last_formal_arguments = Void
2199 end
2200
2201 feature {NONE} -- Last keyword
2202
2203 last_keyword: detachable ET_KEYWORD
2204 -- Last keyword read
2205 require
2206 last_keywords_not_empty: not last_keywords.is_empty
2207 do
2208 Result := last_keywords.item
2209 end
2210
2211 add_keyword (a_keyword: detachable ET_KEYWORD)
2212 -- Add `a_keyword' to `last_keywords'.
2213 do
2214 last_keywords.force (a_keyword)
2215 ensure
2216 one_more: last_keywords.count = old last_keywords.count + 1
2217 keyword_added: last_keyword = a_keyword
2218 end
2219
2220 remove_keyword
2221 -- Remove `last_keyword' from `last_keywords'.
2222 require
2223 last_keywords_not_empty: not last_keywords.is_empty
2224 do
2225 last_keywords.remove
2226 ensure
2227 one_less: last_keywords.count = old last_keywords.count - 1
2228 end
2229
2230 last_keywords: DS_ARRAYED_STACK [detachable ET_KEYWORD]
2231 -- Last keywords read
2232
2233 feature {NONE} -- Last symbol
2234
2235 last_symbol: detachable ET_SYMBOL
2236 -- Last symbol read
2237 require
2238 last_symbols_not_empty: not last_symbols.is_empty
2239 do
2240 Result := last_symbols.item
2241 end
2242
2243 add_symbol (a_symbol: detachable ET_SYMBOL)
2244 -- Add `a_symbol' to `last_symbols'.
2245 do
2246 last_symbols.force (a_symbol)
2247 ensure
2248 one_more: last_symbols.count = old last_symbols.count + 1
2249 keyword_added: last_symbol = a_symbol
2250 end
2251
2252 remove_symbol
2253 -- Remove `last_symbol' from `last_symbols'.
2254 require
2255 last_symbols_not_empty: not last_symbols.is_empty
2256 do
2257 last_symbols.remove
2258 ensure
2259 one_less: last_symbols.count = old last_symbols.count - 1
2260 end
2261
2262 last_symbols: DS_ARRAYED_STACK [detachable ET_SYMBOL]
2263 -- Last symbols read
2264
2265 feature {NONE} -- Counters
2266
2267 counter_value: INTEGER
2268 -- Value of the last counter registered
2269 require
2270 counters_not_empty: not counters.is_empty
2271 do
2272 Result := counters.item
2273 ensure
2274 value_positive: Result >= 0
2275 end
2276
2277 add_counter
2278 -- Register a new counter.
2279 do
2280 counters.force (0)
2281 ensure
2282 one_more: counters.count = old counters.count + 1
2283 value_zero: counter_value = 0
2284 end
2285
2286 remove_counter
2287 -- Unregister last registered counter.
2288 require
2289 counters_not_empty: not counters.is_empty
2290 do
2291 counters.remove
2292 ensure
2293 one_less: counters.count = old counters.count - 1
2294 end
2295
2296 increment_counter
2297 -- Increment `counter_value'.
2298 require
2299 counters_not_empty: not counters.is_empty
2300 local
2301 a_value: INTEGER
2302 do
2303 a_value := counters.item
2304 counters.replace (a_value + 1)
2305 ensure
2306 same_counters_count: counters.count = old counters.count
2307 one_more: counter_value = old counter_value + 1
2308 end
2309
2310 counters: DS_ARRAYED_STACK [INTEGER]
2311 -- Counters currently in use by the parser
2312 -- to build lists of AST nodes
2313
2314 feature {NONE} -- Input buffer
2315
2316 eiffel_buffer: YY_FILE_BUFFER
2317 -- Eiffel file input buffer
2318
2319 feature {NONE} -- Constants
2320
2321 Initial_eiffel_buffer_size: INTEGER = 50000
2322 -- Initial size for `eiffel_buffer'
2323
2324 Initial_counters_capacity: INTEGER = 10
2325 -- Initial capacity for `counters'
2326
2327 Initial_last_formal_arguments_stack_capacity: INTEGER = 5
2328 -- Initial capacity for `last_formal_arguments_stack'
2329
2330 Initial_last_local_variables_stack_capacity: INTEGER = 5
2331 -- Initial capacity for `last_local_variables_stack'
2332
2333 Initial_last_keywords_capacity: INTEGER = 5
2334 -- Initial capacity for `last_keywords'
2335
2336 Initial_last_symbols_capacity: INTEGER = 5
2337 -- Initial capacity for `last_symbols'
2338
2339 Initial_last_object_tests_capacity: INTEGER = 50
2340 -- Initial capacity for `last_object_tests'
2341
2342 Initial_last_across_components_capacity: INTEGER = 50
2343 -- Initial capacity for `last_across_components'
2344
2345 Initial_assertions_capacity: INTEGER = 20
2346 -- Initial capacity for `assertions'
2347
2348 Initial_check_assertion_counters_capacity: INTEGER = 10
2349 -- Initial capacity for `check_assertion_counters'
2350
2351 Initial_queries_capacity: INTEGER = 100
2352 -- Initial capacity for `queries'
2353
2354 Initial_procedures_capacity: INTEGER = 100
2355 -- Initial capacity for `procedures'
2356
2357 Initial_constraints_capacity: INTEGER = 10
2358 -- Initial capacity for `constraints'
2359
2360 Initial_providers_capacity: INTEGER = 100
2361 -- Initial capacity for `providers'
2362
2363 dummy_type: ET_TYPE
2364 -- Dummy type
2365 once
2366 Result := tokens.unknown_class
2367 ensure
2368 dummy_type_not_void: Result /= Void
2369 end
2370
2371 feature {NONE} -- Implementation
2372
2373 tmp_directory: KL_DIRECTORY
2374 -- Temporary directory object
2375 do
2376 Result := shared_directory
2377 if not Result.is_closed then
2378 create Result.make (dummy_name)
2379 end
2380 ensure
2381 directory_not_void: Result /= Void
2382 directory_closed: Result.is_closed
2383 end
2384
2385 shared_directory: KL_DIRECTORY
2386 -- Shared directory object
2387 once
2388 create Result.make (dummy_name)
2389 ensure
2390 directory_not_void: Result /= Void
2391 end
2392
2393 invariant
2394
2395 counters_not_void: counters /= Void
2396 last_formal_arguments_stack_not_void: last_formal_arguments_stack /= Void
2397 last_local_variables_stack_not_void: last_local_variables_stack /= Void
2398 last_keywords_not_void: last_keywords /= Void
2399 last_symbols_not_void: last_symbols /= Void
2400 assertions_not_void: assertions /= Void
2401 no_void_assertion: not assertions.has_void
2402 check_assertion_counters_not_void: check_assertion_counters /= Void
2403 queries_not_void: queries /= Void
2404 no_void_query: not queries.has_void
2405 -- queries_registered: forall f in queries, f.is_registered
2406 procedures_not_void: procedures /= Void
2407 no_void_procedure: not procedures.has_void
2408 -- procedures_registered: forall f in procedures, f.is_registered
2409 constraints_not_void: constraints /= Void
2410 providers_not_void: providers /= Void
2411 no_void_provider: not providers.has_void
2412 -- Object-tests.
2413 last_object_tests_stack_not_void: last_object_tests_stack /= Void
2414 last_object_tests_pool_not_void: last_object_tests_pool /= Void
2415 no_void_last_object_tests_in_pool: not last_object_tests_pool.has_void
2416 -- Across components.
2417 last_across_components_stack_not_void: last_across_components_stack /= Void
2418 last_across_components_pool_not_void: last_across_components_pool /= Void
2419 no_void_last_across_components_in_pool: not last_across_components_pool.has_void
2420 -- Input buffer.
2421 eiffel_buffer_not_void: eiffel_buffer /= Void
2422
2423 end

Properties

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

  ViewVC Help
Powered by ViewVC 1.1.23