source: trunk/ada-2012/src/asis/asis-extensions-flat_kinds.adb@ 391

Last change on this file since 391 was 391, checked in by Maxim Reznik, 6 years ago

Resolve selector_name in discriminant constraint

Add Symbol interpretation to pass information about selector_name.
Add Interpretation_Manager.Get_Defining_Name_Index procedure to register
resolved defining name of discriminants.
Add Type_View.Get_Discriminant to retrive discriminant name from type view.
Rewrite Gela.Resolve.Constraints

File size: 79.0 KB
Line 
1with Gela.Compilations;
2with Gela.Lexical_Types;
3
4with Gela.Element_Visiters;
5with Gela.Elements.Abort_Statements;
6with Gela.Elements.Accept_Statements;
7with Gela.Elements.Access_To_Function_Definitions;
8with Gela.Elements.Access_To_Object_Definitions;
9with Gela.Elements.Access_To_Procedure_Definitions;
10with Gela.Elements.Allocators;
11with Gela.Elements.Anonymous_Access_To_Function_Definitions;
12with Gela.Elements.Anonymous_Access_To_Object_Definitions;
13with Gela.Elements.Anonymous_Access_To_Procedure_Definitions;
14with Gela.Elements.Aspect_Specifications;
15with Gela.Elements.Assignment_Statements;
16with Gela.Elements.Associations;
17with Gela.Elements.Asynchronous_Selects;
18with Gela.Elements.At_Clauses;
19with Gela.Elements.Attribute_Definition_Clauses;
20with Gela.Elements.Attribute_References;
21with Gela.Elements.Auxiliary_Applies;
22with Gela.Elements.Block_Statements;
23with Gela.Elements.Boxes;
24with Gela.Elements.Case_Expression_Paths;
25with Gela.Elements.Case_Expressions;
26with Gela.Elements.Case_Paths;
27with Gela.Elements.Case_Statements;
28with Gela.Elements.Character_Literals;
29with Gela.Elements.Choice_Parameter_Specifications;
30with Gela.Elements.Compilation_Unit_Bodies;
31with Gela.Elements.Compilation_Unit_Declarations;
32with Gela.Elements.Compilations;
33with Gela.Elements.Component_Clauses;
34with Gela.Elements.Component_Declarations;
35with Gela.Elements.Component_Definitions;
36with Gela.Elements.Composite_Constraints;
37with Gela.Elements.Constrained_Array_Definitions;
38with Gela.Elements.Decimal_Fixed_Point_Definitions;
39with Gela.Elements.Defining_Character_Literals;
40with Gela.Elements.Defining_Enumeration_Literals;
41with Gela.Elements.Defining_Expanded_Unit_Names;
42with Gela.Elements.Defining_Identifiers;
43with Gela.Elements.Defining_Operator_Symbols;
44with Gela.Elements.Delay_Statements;
45with Gela.Elements.Delta_Constraints;
46with Gela.Elements.Derived_Record_Definitions;
47with Gela.Elements.Derived_Type_Definitions;
48with Gela.Elements.Digits_Constraints;
49with Gela.Elements.Discrete_Range_Attribute_References;
50with Gela.Elements.Discrete_Simple_Expression_Ranges;
51with Gela.Elements.Discrete_Subtype_Indication_Drs;
52with Gela.Elements.Discrete_Subtype_Indications;
53with Gela.Elements.Discriminant_Specifications;
54with Gela.Elements.Element_Iterator_Specifications;
55with Gela.Elements.Else_Expression_Paths;
56with Gela.Elements.Else_Paths;
57with Gela.Elements.Elsif_Expression_Paths;
58with Gela.Elements.Elsif_Paths;
59with Gela.Elements.Entry_Bodies;
60with Gela.Elements.Entry_Declarations;
61with Gela.Elements.Entry_Index_Specifications;
62with Gela.Elements.Enumeration_Literal_Specifications;
63with Gela.Elements.Enumeration_Literals;
64with Gela.Elements.Enumeration_Type_Definitions;
65with Gela.Elements.Exception_Declarations;
66with Gela.Elements.Exception_Handlers;
67with Gela.Elements.Exception_Renaming_Declarations;
68with Gela.Elements.Exit_Statements;
69with Gela.Elements.Explicit_Dereferences;
70with Gela.Elements.Extended_Return_Statements;
71with Gela.Elements.Extension_Aggregates;
72with Gela.Elements.Floating_Point_Definitions;
73with Gela.Elements.For_Loop_Statements;
74with Gela.Elements.Formal_Access_To_Function_Definitions;
75with Gela.Elements.Formal_Access_To_Object_Definitions;
76with Gela.Elements.Formal_Access_To_Procedure_Definitions;
77with Gela.Elements.Formal_Constrained_Array_Definitions;
78with Gela.Elements.Formal_Decimal_Fixed_Point_Definitions;
79with Gela.Elements.Formal_Derived_Type_Definitions;
80with Gela.Elements.Formal_Discrete_Type_Definitions;
81with Gela.Elements.Formal_Floating_Point_Definitions;
82with Gela.Elements.Formal_Function_Declarations;
83with Gela.Elements.Formal_Incomplete_Type_Declarations;
84with Gela.Elements.Formal_Interface_Type_Definitions;
85with Gela.Elements.Formal_Modular_Type_Definitions;
86with Gela.Elements.Formal_Object_Declarations;
87with Gela.Elements.Formal_Ordinary_Fixed_Point_Definitions;
88with Gela.Elements.Formal_Package_Declarations;
89with Gela.Elements.Formal_Private_Type_Definitions;
90with Gela.Elements.Formal_Procedure_Declarations;
91with Gela.Elements.Formal_Signed_Integer_Type_Definitions;
92with Gela.Elements.Formal_Type_Declarations;
93with Gela.Elements.Formal_Unconstrained_Array_Definitions;
94with Gela.Elements.Full_Type_Declarations;
95with Gela.Elements.Function_Bodies;
96with Gela.Elements.Function_Declarations;
97with Gela.Elements.Function_Instantiations;
98with Gela.Elements.Generalized_Iterator_Specifications;
99with Gela.Elements.Generic_Associations;
100with Gela.Elements.Generic_Function_Declarations;
101with Gela.Elements.Generic_Function_Renamings;
102with Gela.Elements.Generic_Package_Declarations;
103with Gela.Elements.Generic_Package_Renamings;
104with Gela.Elements.Generic_Procedure_Declarations;
105with Gela.Elements.Generic_Procedure_Renamings;
106with Gela.Elements.Goto_Statements;
107with Gela.Elements.Identifiers;
108with Gela.Elements.If_Expression_Paths;
109with Gela.Elements.If_Expressions;
110with Gela.Elements.If_Paths;
111with Gela.Elements.If_Statements;
112with Gela.Elements.Incomplete_Type_Declarations;
113with Gela.Elements.Incomplete_Type_Definitions;
114with Gela.Elements.Interface_Type_Definitions;
115with Gela.Elements.Known_Discriminant_Parts;
116with Gela.Elements.Label_Decorators;
117with Gela.Elements.Loop_Parameter_Specifications;
118with Gela.Elements.Loop_Statements;
119with Gela.Elements.Membership_Tests;
120with Gela.Elements.Modular_Type_Definitions;
121with Gela.Elements.Null_Components;
122with Gela.Elements.Null_Literals;
123with Gela.Elements.Null_Record_Definitions;
124with Gela.Elements.Null_Statements;
125with Gela.Elements.Number_Declarations;
126with Gela.Elements.Numeric_Literals;
127with Gela.Elements.Object_Declarations;
128with Gela.Elements.Object_Renaming_Declarations;
129with Gela.Elements.Operator_Symbols;
130with Gela.Elements.Ordinary_Fixed_Point_Definitions;
131with Gela.Elements.Others_Choices;
132with Gela.Elements.Package_Bodies;
133with Gela.Elements.Package_Body_Stubs;
134with Gela.Elements.Package_Declarations;
135with Gela.Elements.Package_Instantiations;
136with Gela.Elements.Package_Renaming_Declarations;
137with Gela.Elements.Parameter_Associations;
138with Gela.Elements.Parameter_Specifications;
139with Gela.Elements.Pragma_Argument_Associations;
140with Gela.Elements.Pragma_Nodes;
141with Gela.Elements.Private_Extension_Declarations;
142with Gela.Elements.Private_Extension_Definitions;
143with Gela.Elements.Private_Type_Declarations;
144with Gela.Elements.Private_Type_Definitions;
145with Gela.Elements.Procedure_Bodies;
146with Gela.Elements.Procedure_Call_Statements;
147with Gela.Elements.Procedure_Declarations;
148with Gela.Elements.Procedure_Instantiations;
149with Gela.Elements.Protected_Bodies;
150with Gela.Elements.Protected_Body_Stubs;
151with Gela.Elements.Protected_Definitions;
152with Gela.Elements.Protected_Type_Declarations;
153with Gela.Elements.Qualified_Expressions;
154with Gela.Elements.Quantified_Expressions;
155with Gela.Elements.Raise_Statements;
156with Gela.Elements.Range_Attribute_Reference_Drs;
157with Gela.Elements.Range_Attribute_References;
158with Gela.Elements.Record_Aggregates;
159with Gela.Elements.Record_Definitions;
160with Gela.Elements.Record_Representation_Clauses;
161with Gela.Elements.Record_Type_Definitions;
162with Gela.Elements.Requeue_Statements;
163with Gela.Elements.Return_Object_Specifications;
164with Gela.Elements.Select_Or_Paths;
165with Gela.Elements.Selected_Components;
166with Gela.Elements.Selected_Identifiers;
167with Gela.Elements.Selective_Accepts;
168with Gela.Elements.Short_Circuits;
169with Gela.Elements.Signed_Integer_Type_Definitions;
170with Gela.Elements.Simple_Expression_Range_Drs;
171with Gela.Elements.Simple_Expression_Ranges;
172with Gela.Elements.Simple_Return_Statements;
173with Gela.Elements.Single_Protected_Declarations;
174with Gela.Elements.Single_Task_Declarations;
175with Gela.Elements.String_Literals;
176with Gela.Elements.Subtype_Declarations;
177with Gela.Elements.Subtype_Indications;
178with Gela.Elements.Subunits;
179with Gela.Elements.Task_Bodies;
180with Gela.Elements.Task_Body_Stubs;
181with Gela.Elements.Task_Definitions;
182with Gela.Elements.Task_Type_Declarations;
183with Gela.Elements.Terminate_Alternative_Statements;
184with Gela.Elements.Then_Abort_Paths;
185with Gela.Elements.Unconstrained_Array_Definitions;
186with Gela.Elements.Unknown_Discriminant_Parts;
187with Gela.Elements.Use_Package_Clauses;
188with Gela.Elements.Use_Type_Clauses;
189with Gela.Elements.Variant_Parts;
190with Gela.Elements.Variants;
191with Gela.Elements.While_Loop_Statements;
192with Gela.Elements.With_Clauses;
193
194package body Asis.Extensions.Flat_Kinds is
195
196 type Visiter is new Gela.Element_Visiters.Visiter with record
197 Result : Element_Flat_Kind;
198 end record;
199
200 overriding procedure Compilation
201 (Self : in out Visiter;
202 Node : not null Gela.Elements.Compilations.Compilation_Access)
203 is null;
204
205 overriding procedure Abort_Statement
206 (Self : in out Visiter;
207 Node : not null Gela.Elements.Abort_Statements.Abort_Statement_Access)
208 is null;
209
210 overriding procedure Accept_Statement
211 (Self : in out Visiter;
212 Node : not null Gela.Elements.Accept_Statements.Accept_Statement_Access);
213
214 overriding procedure Access_To_Function_Definition
215 (Self : in out Visiter;
216 Node : not null Gela.Elements.Access_To_Function_Definitions.
217 Access_To_Function_Definition_Access)
218 is null;
219
220 overriding procedure Access_To_Object_Definition
221 (Self : in out Visiter;
222 Node : not null Gela.Elements.Access_To_Object_Definitions.
223 Access_To_Object_Definition_Access);
224
225 overriding procedure Access_To_Procedure_Definition
226 (Self : in out Visiter;
227 Node : not null Gela.Elements.Access_To_Procedure_Definitions.
228 Access_To_Procedure_Definition_Access)
229 is null;
230
231 overriding procedure Allocator
232 (Self : in out Visiter;
233 Node : not null Gela.Elements.Allocators.Allocator_Access)
234 is null;
235
236 overriding procedure Anonymous_Access_To_Function_Definition
237 (Self : in out Visiter;
238 Node : not null Gela.Elements.Anonymous_Access_To_Function_Definitions.
239 Anonymous_Access_To_Function_Definition_Access)
240 is null;
241
242 overriding procedure Anonymous_Access_To_Object_Definition
243 (Self : in out Visiter;
244 Node : not null Gela.Elements.Anonymous_Access_To_Object_Definitions.
245 Anonymous_Access_To_Object_Definition_Access);
246
247 overriding procedure Anonymous_Access_To_Procedure_Definition
248 (Self : in out Visiter;
249 Node : not null Gela.Elements.Anonymous_Access_To_Procedure_Definitions.
250 Anonymous_Access_To_Procedure_Definition_Access)
251 is null;
252
253 overriding procedure Aspect_Specification
254 (Self : in out Visiter;
255 Node : not null Gela.Elements.Aspect_Specifications.
256 Aspect_Specification_Access)
257 is null;
258
259 overriding procedure Assignment_Statement
260 (Self : in out Visiter;
261 Node : not null Gela.Elements.Assignment_Statements.
262 Assignment_Statement_Access);
263
264 overriding procedure Association
265 (Self : in out Visiter;
266 Node : not null Gela.Elements.Associations.Association_Access);
267
268 overriding procedure Asynchronous_Select
269 (Self : in out Visiter;
270 Node : not null Gela.Elements.Asynchronous_Selects.
271 Asynchronous_Select_Access)
272 is null;
273
274 overriding procedure At_Clause
275 (Self : in out Visiter;
276 Node : not null Gela.Elements.At_Clauses.At_Clause_Access)
277 is null;
278
279 overriding procedure Attribute_Definition_Clause
280 (Self : in out Visiter;
281 Node : not null Gela.Elements.Attribute_Definition_Clauses.
282 Attribute_Definition_Clause_Access)
283 is null;
284
285 overriding procedure Attribute_Reference
286 (Self : in out Visiter;
287 Node : not null Gela.Elements.Attribute_References.
288 Attribute_Reference_Access);
289
290 overriding procedure Auxiliary_Apply
291 (Self : in out Visiter;
292 Node : not null Gela.Elements.Auxiliary_Applies.Auxiliary_Apply_Access);
293
294 overriding procedure Block_Statement
295 (Self : in out Visiter;
296 Node : not null Gela.Elements.Block_Statements.Block_Statement_Access);
297
298 overriding procedure Box
299 (Self : in out Visiter;
300 Node : not null Gela.Elements.Boxes.Box_Access)
301 is null;
302
303 overriding procedure Case_Expression
304 (Self : in out Visiter;
305 Node : not null Gela.Elements.Case_Expressions.Case_Expression_Access)
306 is null;
307
308 overriding procedure Case_Expression_Path
309 (Self : in out Visiter;
310 Node : not null Gela.Elements.Case_Expression_Paths.
311 Case_Expression_Path_Access)
312 is null;
313
314 overriding procedure Case_Path
315 (Self : in out Visiter;
316 Node : not null Gela.Elements.Case_Paths.Case_Path_Access);
317
318 overriding procedure Case_Statement
319 (Self : in out Visiter;
320 Node : not null Gela.Elements.Case_Statements.Case_Statement_Access);
321
322 overriding procedure Character_Literal
323 (Self : in out Visiter;
324 Node : not null Gela.Elements.Character_Literals.
325 Character_Literal_Access)
326 is null;
327
328 overriding procedure Choice_Parameter_Specification
329 (Self : in out Visiter;
330 Node : not null Gela.Elements.Choice_Parameter_Specifications.
331 Choice_Parameter_Specification_Access)
332 is null;
333
334 overriding procedure Compilation_Unit_Body
335 (Self : in out Visiter;
336 Node : not null Gela.Elements.Compilation_Unit_Bodies.
337 Compilation_Unit_Body_Access)
338 is null;
339
340 overriding procedure Compilation_Unit_Declaration
341 (Self : in out Visiter;
342 Node : not null Gela.Elements.Compilation_Unit_Declarations.
343 Compilation_Unit_Declaration_Access)
344 is null;
345
346 overriding procedure Component_Clause
347 (Self : in out Visiter;
348 Node : not null Gela.Elements.Component_Clauses.Component_Clause_Access)
349 is null;
350
351 overriding procedure Component_Declaration
352 (Self : in out Visiter;
353 Node : not null Gela.Elements.Component_Declarations.
354 Component_Declaration_Access);
355
356 overriding procedure Component_Definition
357 (Self : in out Visiter;
358 Node : not null Gela.Elements.Component_Definitions.
359 Component_Definition_Access);
360
361 overriding procedure Composite_Constraint
362 (Self : in out Visiter;
363 Node : not null Gela.Elements.Composite_Constraints.
364 Composite_Constraint_Access);
365
366 overriding procedure Constrained_Array_Definition
367 (Self : in out Visiter;
368 Node : not null Gela.Elements.Constrained_Array_Definitions.
369 Constrained_Array_Definition_Access);
370
371 overriding procedure Decimal_Fixed_Point_Definition
372 (Self : in out Visiter;
373 Node : not null Gela.Elements.Decimal_Fixed_Point_Definitions.
374 Decimal_Fixed_Point_Definition_Access)
375 is null;
376
377 overriding procedure Defining_Character_Literal
378 (Self : in out Visiter;
379 Node : not null Gela.Elements.Defining_Character_Literals.
380 Defining_Character_Literal_Access)
381 is null;
382
383 overriding procedure Defining_Enumeration_Literal
384 (Self : in out Visiter;
385 Node : not null Gela.Elements.Defining_Enumeration_Literals.
386 Defining_Enumeration_Literal_Access);
387
388 overriding procedure Defining_Expanded_Unit_Name
389 (Self : in out Visiter;
390 Node : not null Gela.Elements.Defining_Expanded_Unit_Names.
391 Defining_Expanded_Unit_Name_Access);
392
393 overriding procedure Defining_Identifier
394 (Self : in out Visiter;
395 Node : not null Gela.Elements.Defining_Identifiers.
396 Defining_Identifier_Access);
397
398 overriding procedure Defining_Operator_Symbol
399 (Self : in out Visiter;
400 Node : not null Gela.Elements.Defining_Operator_Symbols.
401 Defining_Operator_Symbol_Access);
402
403 overriding procedure Delay_Statement
404 (Self : in out Visiter;
405 Node : not null Gela.Elements.Delay_Statements.Delay_Statement_Access);
406
407 overriding procedure Delta_Constraint
408 (Self : in out Visiter;
409 Node : not null Gela.Elements.Delta_Constraints.Delta_Constraint_Access)
410 is null;
411
412 overriding procedure Derived_Record_Definition
413 (Self : in out Visiter;
414 Node : not null Gela.Elements.Derived_Record_Definitions.
415 Derived_Record_Definition_Access)
416 is null;
417
418 overriding procedure Derived_Type_Definition
419 (Self : in out Visiter;
420 Node : not null Gela.Elements.Derived_Type_Definitions.
421 Derived_Type_Definition_Access);
422
423 overriding procedure Digits_Constraint
424 (Self : in out Visiter;
425 Node : not null Gela.Elements.Digits_Constraints.
426 Digits_Constraint_Access)
427 is null;
428
429 overriding procedure Discrete_Range_Attribute_Reference
430 (Self : in out Visiter;
431 Node : not null Gela.Elements.Discrete_Range_Attribute_References.
432 Discrete_Range_Attribute_Reference_Access)
433 is null;
434
435 overriding procedure Discrete_Simple_Expression_Range
436 (Self : in out Visiter;
437 Node : not null Gela.Elements.Discrete_Simple_Expression_Ranges.
438 Discrete_Simple_Expression_Range_Access);
439
440 overriding procedure Discrete_Subtype_Indication
441 (Self : in out Visiter;
442 Node : not null Gela.Elements.Discrete_Subtype_Indications.
443 Discrete_Subtype_Indication_Access);
444
445 overriding procedure Discrete_Subtype_Indication_Dr
446 (Self : in out Visiter;
447 Node : not null Gela.Elements.Discrete_Subtype_Indication_Drs.
448 Discrete_Subtype_Indication_Dr_Access)
449 is null;
450
451 overriding procedure Discriminant_Specification
452 (Self : in out Visiter;
453 Node : not null Gela.Elements.Discriminant_Specifications.
454 Discriminant_Specification_Access);
455
456 overriding procedure Element_Iterator_Specification
457 (Self : in out Visiter;
458 Node : not null Gela.Elements.Element_Iterator_Specifications.
459 Element_Iterator_Specification_Access)
460 is null;
461
462 overriding procedure Else_Expression_Path
463 (Self : in out Visiter;
464 Node : not null Gela.Elements.Else_Expression_Paths.
465 Else_Expression_Path_Access)
466 is null;
467
468 overriding procedure Else_Path
469 (Self : in out Visiter;
470 Node : not null Gela.Elements.Else_Paths.Else_Path_Access);
471
472 overriding procedure Elsif_Expression_Path
473 (Self : in out Visiter;
474 Node : not null Gela.Elements.Elsif_Expression_Paths.
475 Elsif_Expression_Path_Access)
476 is null;
477
478 overriding procedure Elsif_Path
479 (Self : in out Visiter;
480 Node : not null Gela.Elements.Elsif_Paths.Elsif_Path_Access)
481 is null;
482
483 overriding procedure Entry_Body
484 (Self : in out Visiter;
485 Node : not null Gela.Elements.Entry_Bodies.Entry_Body_Access);
486
487 overriding procedure Entry_Declaration
488 (Self : in out Visiter;
489 Node : not null Gela.Elements.Entry_Declarations.
490 Entry_Declaration_Access);
491
492 overriding procedure Entry_Index_Specification
493 (Self : in out Visiter;
494 Node : not null Gela.Elements.Entry_Index_Specifications.
495 Entry_Index_Specification_Access)
496 is null;
497
498 overriding procedure Enumeration_Literal
499 (Self : in out Visiter;
500 Node : not null Gela.Elements.Enumeration_Literals.
501 Enumeration_Literal_Access)
502 is null;
503
504 overriding procedure Enumeration_Literal_Specification
505 (Self : in out Visiter;
506 Node : not null Gela.Elements.Enumeration_Literal_Specifications.
507 Enumeration_Literal_Specification_Access);
508
509 overriding procedure Enumeration_Type_Definition
510 (Self : in out Visiter;
511 Node : not null Gela.Elements.Enumeration_Type_Definitions.
512 Enumeration_Type_Definition_Access);
513
514 overriding procedure Exception_Declaration
515 (Self : in out Visiter;
516 Node : not null Gela.Elements.Exception_Declarations.
517 Exception_Declaration_Access);
518
519 overriding procedure Exception_Handler
520 (Self : in out Visiter;
521 Node : not null Gela.Elements.Exception_Handlers.
522 Exception_Handler_Access);
523
524 overriding procedure Exception_Renaming_Declaration
525 (Self : in out Visiter;
526 Node : not null Gela.Elements.Exception_Renaming_Declarations.
527 Exception_Renaming_Declaration_Access);
528
529 overriding procedure Exit_Statement
530 (Self : in out Visiter;
531 Node : not null Gela.Elements.Exit_Statements.Exit_Statement_Access);
532
533 overriding procedure Explicit_Dereference
534 (Self : in out Visiter;
535 Node : not null Gela.Elements.Explicit_Dereferences.
536 Explicit_Dereference_Access);
537
538 overriding procedure Extended_Return_Statement
539 (Self : in out Visiter;
540 Node : not null Gela.Elements.Extended_Return_Statements.
541 Extended_Return_Statement_Access)
542 is null;
543
544 overriding procedure Extension_Aggregate
545 (Self : in out Visiter;
546 Node : not null Gela.Elements.Extension_Aggregates.
547 Extension_Aggregate_Access)
548 is null;
549
550 overriding procedure Floating_Point_Definition
551 (Self : in out Visiter;
552 Node : not null Gela.Elements.Floating_Point_Definitions.
553 Floating_Point_Definition_Access)
554 is null;
555
556 overriding procedure For_Loop_Statement
557 (Self : in out Visiter;
558 Node : not null Gela.Elements.For_Loop_Statements.
559 For_Loop_Statement_Access)
560 is null;
561
562 overriding procedure Formal_Access_To_Function_Definition
563 (Self : in out Visiter;
564 Node : not null Gela.Elements.Formal_Access_To_Function_Definitions.
565 Formal_Access_To_Function_Definition_Access)
566 is null;
567
568 overriding procedure Formal_Access_To_Object_Definition
569 (Self : in out Visiter;
570 Node : not null Gela.Elements.Formal_Access_To_Object_Definitions.
571 Formal_Access_To_Object_Definition_Access)
572 is null;
573
574 overriding procedure Formal_Access_To_Procedure_Definition
575 (Self : in out Visiter;
576 Node : not null Gela.Elements.Formal_Access_To_Procedure_Definitions.
577 Formal_Access_To_Procedure_Definition_Access)
578 is null;
579
580 overriding procedure Formal_Constrained_Array_Definition
581 (Self : in out Visiter;
582 Node : not null Gela.Elements.Formal_Constrained_Array_Definitions.
583 Formal_Constrained_Array_Definition_Access)
584 is null;
585
586 overriding procedure Formal_Decimal_Fixed_Point_Definition
587 (Self : in out Visiter;
588 Node : not null Gela.Elements.Formal_Decimal_Fixed_Point_Definitions.
589 Formal_Decimal_Fixed_Point_Definition_Access)
590 is null;
591
592 overriding procedure Formal_Derived_Type_Definition
593 (Self : in out Visiter;
594 Node : not null Gela.Elements.Formal_Derived_Type_Definitions.
595 Formal_Derived_Type_Definition_Access);
596
597 overriding procedure Formal_Discrete_Type_Definition
598 (Self : in out Visiter;
599 Node : not null Gela.Elements.Formal_Discrete_Type_Definitions.
600 Formal_Discrete_Type_Definition_Access)
601 is null;
602
603 overriding procedure Formal_Floating_Point_Definition
604 (Self : in out Visiter;
605 Node : not null Gela.Elements.Formal_Floating_Point_Definitions.
606 Formal_Floating_Point_Definition_Access)
607 is null;
608
609 overriding procedure Formal_Function_Declaration
610 (Self : in out Visiter;
611 Node : not null Gela.Elements.Formal_Function_Declarations.
612 Formal_Function_Declaration_Access)
613 is null;
614
615 overriding procedure Formal_Incomplete_Type_Declaration
616 (Self : in out Visiter;
617 Node : not null Gela.Elements.Formal_Incomplete_Type_Declarations.
618 Formal_Incomplete_Type_Declaration_Access)
619 is null;
620
621 overriding procedure Formal_Interface_Type_Definition
622 (Self : in out Visiter;
623 Node : not null Gela.Elements.Formal_Interface_Type_Definitions.
624 Formal_Interface_Type_Definition_Access)
625 is null;
626
627 overriding procedure Formal_Modular_Type_Definition
628 (Self : in out Visiter;
629 Node : not null Gela.Elements.Formal_Modular_Type_Definitions.
630 Formal_Modular_Type_Definition_Access)
631 is null;
632
633 overriding procedure Formal_Object_Declaration
634 (Self : in out Visiter;
635 Node : not null Gela.Elements.Formal_Object_Declarations.
636 Formal_Object_Declaration_Access)
637 is null;
638
639 overriding procedure Formal_Ordinary_Fixed_Point_Definition
640 (Self : in out Visiter;
641 Node : not null Gela.Elements.Formal_Ordinary_Fixed_Point_Definitions.
642 Formal_Ordinary_Fixed_Point_Definition_Access)
643 is null;
644
645 overriding procedure Formal_Package_Declaration
646 (Self : in out Visiter;
647 Node : not null Gela.Elements.Formal_Package_Declarations.
648 Formal_Package_Declaration_Access)
649 is null;
650
651 overriding procedure Formal_Private_Type_Definition
652 (Self : in out Visiter;
653 Node : not null Gela.Elements.Formal_Private_Type_Definitions.
654 Formal_Private_Type_Definition_Access)
655 is null;
656
657 overriding procedure Formal_Procedure_Declaration
658 (Self : in out Visiter;
659 Node : not null Gela.Elements.Formal_Procedure_Declarations.
660 Formal_Procedure_Declaration_Access)
661 is null;
662
663 overriding procedure Formal_Signed_Integer_Type_Definition
664 (Self : in out Visiter;
665 Node : not null Gela.Elements.Formal_Signed_Integer_Type_Definitions.
666 Formal_Signed_Integer_Type_Definition_Access)
667 is null;
668
669 overriding procedure Formal_Type_Declaration
670 (Self : in out Visiter;
671 Node : not null Gela.Elements.Formal_Type_Declarations.
672 Formal_Type_Declaration_Access);
673
674 overriding procedure Formal_Unconstrained_Array_Definition
675 (Self : in out Visiter;
676 Node : not null Gela.Elements.Formal_Unconstrained_Array_Definitions.
677 Formal_Unconstrained_Array_Definition_Access)
678 is null;
679
680 overriding procedure Full_Type_Declaration
681 (Self : in out Visiter;
682 Node : not null Gela.Elements.Full_Type_Declarations.
683 Full_Type_Declaration_Access);
684
685 overriding procedure Function_Body
686 (Self : in out Visiter;
687 Node : not null Gela.Elements.Function_Bodies.Function_Body_Access);
688
689 overriding procedure Function_Declaration
690 (Self : in out Visiter;
691 Node : not null Gela.Elements.Function_Declarations.
692 Function_Declaration_Access);
693
694 overriding procedure Function_Instantiation
695 (Self : in out Visiter;
696 Node : not null Gela.Elements.Function_Instantiations.
697 Function_Instantiation_Access)
698 is null;
699
700 overriding procedure Generalized_Iterator_Specification
701 (Self : in out Visiter;
702 Node : not null Gela.Elements.Generalized_Iterator_Specifications.
703 Generalized_Iterator_Specification_Access)
704 is null;
705
706 overriding procedure Generic_Association
707 (Self : in out Visiter;
708 Node : not null Gela.Elements.Generic_Associations.
709 Generic_Association_Access);
710
711 overriding procedure Generic_Function_Declaration
712 (Self : in out Visiter;
713 Node : not null Gela.Elements.Generic_Function_Declarations.
714 Generic_Function_Declaration_Access)
715 is null;
716
717 overriding procedure Generic_Function_Renaming
718 (Self : in out Visiter;
719 Node : not null Gela.Elements.Generic_Function_Renamings.
720 Generic_Function_Renaming_Access)
721 is null;
722
723 overriding procedure Generic_Package_Declaration
724 (Self : in out Visiter;
725 Node : not null Gela.Elements.Generic_Package_Declarations.
726 Generic_Package_Declaration_Access);
727
728 overriding procedure Generic_Package_Renaming
729 (Self : in out Visiter;
730 Node : not null Gela.Elements.Generic_Package_Renamings.
731 Generic_Package_Renaming_Access)
732 is null;
733
734 overriding procedure Generic_Procedure_Declaration
735 (Self : in out Visiter;
736 Node : not null Gela.Elements.Generic_Procedure_Declarations.
737 Generic_Procedure_Declaration_Access)
738 is null;
739
740 overriding procedure Generic_Procedure_Renaming
741 (Self : in out Visiter;
742 Node : not null Gela.Elements.Generic_Procedure_Renamings.
743 Generic_Procedure_Renaming_Access)
744 is null;
745
746 overriding procedure Goto_Statement
747 (Self : in out Visiter;
748 Node : not null Gela.Elements.Goto_Statements.Goto_Statement_Access)
749 is null;
750
751 overriding procedure Identifier
752 (Self : in out Visiter;
753 Node : not null Gela.Elements.Identifiers.Identifier_Access);
754
755 overriding procedure If_Expression
756 (Self : in out Visiter;
757 Node : not null Gela.Elements.If_Expressions.If_Expression_Access)
758 is null;
759
760 overriding procedure If_Expression_Path
761 (Self : in out Visiter;
762 Node : not null Gela.Elements.If_Expression_Paths.
763 If_Expression_Path_Access)
764 is null;
765
766 overriding procedure If_Path
767 (Self : in out Visiter;
768 Node : not null Gela.Elements.If_Paths.If_Path_Access);
769
770 overriding procedure If_Statement
771 (Self : in out Visiter;
772 Node : not null Gela.Elements.If_Statements.If_Statement_Access);
773
774 overriding procedure Incomplete_Type_Declaration
775 (Self : in out Visiter;
776 Node : not null Gela.Elements.Incomplete_Type_Declarations.
777 Incomplete_Type_Declaration_Access)
778 is null;
779
780 overriding procedure Incomplete_Type_Definition
781 (Self : in out Visiter;
782 Node : not null Gela.Elements.Incomplete_Type_Definitions.
783 Incomplete_Type_Definition_Access)
784 is null;
785
786 overriding procedure Interface_Type_Definition
787 (Self : in out Visiter;
788 Node : not null Gela.Elements.Interface_Type_Definitions.
789 Interface_Type_Definition_Access)
790 is null;
791
792 overriding procedure Known_Discriminant_Part
793 (Self : in out Visiter;
794 Node : not null Gela.Elements.Known_Discriminant_Parts.
795 Known_Discriminant_Part_Access);
796
797 overriding procedure Label_Decorator
798 (Self : in out Visiter;
799 Node : not null Gela.Elements.Label_Decorators.Label_Decorator_Access)
800 is null;
801
802 overriding procedure Loop_Parameter_Specification
803 (Self : in out Visiter;
804 Node : not null Gela.Elements.Loop_Parameter_Specifications.
805 Loop_Parameter_Specification_Access)
806 is null;
807
808 overriding procedure Loop_Statement
809 (Self : in out Visiter;
810 Node : not null Gela.Elements.Loop_Statements.Loop_Statement_Access);
811
812 overriding procedure Membership_Test
813 (Self : in out Visiter;
814 Node : not null Gela.Elements.Membership_Tests.Membership_Test_Access)
815 is null;
816
817 overriding procedure Modular_Type_Definition
818 (Self : in out Visiter;
819 Node : not null Gela.Elements.Modular_Type_Definitions.
820 Modular_Type_Definition_Access)
821 is null;
822
823 overriding procedure Null_Component
824 (Self : in out Visiter;
825 Node : not null Gela.Elements.Null_Components.Null_Component_Access);
826
827 overriding procedure Null_Literal
828 (Self : in out Visiter;
829 Node : not null Gela.Elements.Null_Literals.Null_Literal_Access)
830 is null;
831
832 overriding procedure Null_Record_Definition
833 (Self : in out Visiter;
834 Node : not null Gela.Elements.Null_Record_Definitions.
835 Null_Record_Definition_Access)
836 is null;
837
838 overriding procedure Null_Statement
839 (Self : in out Visiter;
840 Node : not null Gela.Elements.Null_Statements.Null_Statement_Access);
841
842 overriding procedure Number_Declaration
843 (Self : in out Visiter;
844 Node : not null Gela.Elements.Number_Declarations.
845 Number_Declaration_Access);
846
847 overriding procedure Numeric_Literal
848 (Self : in out Visiter;
849 Node : not null Gela.Elements.Numeric_Literals.Numeric_Literal_Access);
850
851 overriding procedure Object_Declaration
852 (Self : in out Visiter;
853 Node : not null Gela.Elements.Object_Declarations.
854 Object_Declaration_Access);
855
856 overriding procedure Object_Renaming_Declaration
857 (Self : in out Visiter;
858 Node : not null Gela.Elements.Object_Renaming_Declarations.
859 Object_Renaming_Declaration_Access);
860
861 overriding procedure Operator_Symbol
862 (Self : in out Visiter;
863 Node : not null Gela.Elements.Operator_Symbols.Operator_Symbol_Access);
864
865 overriding procedure Ordinary_Fixed_Point_Definition
866 (Self : in out Visiter;
867 Node : not null Gela.Elements.Ordinary_Fixed_Point_Definitions.
868 Ordinary_Fixed_Point_Definition_Access)
869 is null;
870
871 overriding procedure Others_Choice
872 (Self : in out Visiter;
873 Node : not null Gela.Elements.Others_Choices.Others_Choice_Access);
874
875 overriding procedure Package_Body
876 (Self : in out Visiter;
877 Node : not null Gela.Elements.Package_Bodies.Package_Body_Access);
878
879 overriding procedure Package_Body_Stub
880 (Self : in out Visiter;
881 Node : not null Gela.Elements.Package_Body_Stubs.
882 Package_Body_Stub_Access)
883 is null;
884
885 overriding procedure Package_Declaration
886 (Self : in out Visiter;
887 Node : not null Gela.Elements.Package_Declarations.
888 Package_Declaration_Access);
889
890 overriding procedure Package_Instantiation
891 (Self : in out Visiter;
892 Node : not null Gela.Elements.Package_Instantiations.
893 Package_Instantiation_Access);
894
895 overriding procedure Package_Renaming_Declaration
896 (Self : in out Visiter;
897 Node : not null Gela.Elements.Package_Renaming_Declarations.
898 Package_Renaming_Declaration_Access);
899
900 overriding procedure Parameter_Association
901 (Self : in out Visiter;
902 Node : not null Gela.Elements.Parameter_Associations.
903 Parameter_Association_Access)
904 is null;
905
906 overriding procedure Parameter_Specification
907 (Self : in out Visiter;
908 Node : not null Gela.Elements.Parameter_Specifications.
909 Parameter_Specification_Access);
910
911 overriding procedure Pragma_Argument_Association
912 (Self : in out Visiter;
913 Node : not null Gela.Elements.Pragma_Argument_Associations.
914 Pragma_Argument_Association_Access)
915 is null;
916
917 overriding procedure Pragma_Node
918 (Self : in out Visiter;
919 Node : not null Gela.Elements.Pragma_Nodes.Pragma_Node_Access);
920
921 overriding procedure Private_Extension_Declaration
922 (Self : in out Visiter;
923 Node : not null Gela.Elements.Private_Extension_Declarations.
924 Private_Extension_Declaration_Access)
925 is null;
926
927 overriding procedure Private_Extension_Definition
928 (Self : in out Visiter;
929 Node : not null Gela.Elements.Private_Extension_Definitions.
930 Private_Extension_Definition_Access)
931 is null;
932
933 overriding procedure Private_Type_Declaration
934 (Self : in out Visiter;
935 Node : not null Gela.Elements.Private_Type_Declarations.
936 Private_Type_Declaration_Access);
937
938 overriding procedure Private_Type_Definition
939 (Self : in out Visiter;
940 Node : not null Gela.Elements.Private_Type_Definitions.
941 Private_Type_Definition_Access);
942
943 overriding procedure Procedure_Body
944 (Self : in out Visiter;
945 Node : not null Gela.Elements.Procedure_Bodies.Procedure_Body_Access);
946
947 overriding procedure Procedure_Call_Statement
948 (Self : in out Visiter;
949 Node : not null Gela.Elements.Procedure_Call_Statements.
950 Procedure_Call_Statement_Access);
951
952 overriding procedure Procedure_Declaration
953 (Self : in out Visiter;
954 Node : not null Gela.Elements.Procedure_Declarations.
955 Procedure_Declaration_Access);
956
957 overriding procedure Procedure_Instantiation
958 (Self : in out Visiter;
959 Node : not null Gela.Elements.Procedure_Instantiations.
960 Procedure_Instantiation_Access)
961 is null;
962
963 overriding procedure Protected_Body
964 (Self : in out Visiter;
965 Node : not null Gela.Elements.Protected_Bodies.Protected_Body_Access);
966
967 overriding procedure Protected_Body_Stub
968 (Self : in out Visiter;
969 Node : not null Gela.Elements.Protected_Body_Stubs.
970 Protected_Body_Stub_Access)
971 is null;
972
973 overriding procedure Protected_Definition
974 (Self : in out Visiter;
975 Node : not null Gela.Elements.Protected_Definitions.
976 Protected_Definition_Access);
977
978 overriding procedure Protected_Type_Declaration
979 (Self : in out Visiter;
980 Node : not null Gela.Elements.Protected_Type_Declarations.
981 Protected_Type_Declaration_Access)
982 is null;
983
984 overriding procedure Qualified_Expression
985 (Self : in out Visiter;
986 Node : not null Gela.Elements.Qualified_Expressions.
987 Qualified_Expression_Access)
988 is null;
989
990 overriding procedure Quantified_Expression
991 (Self : in out Visiter;
992 Node : not null Gela.Elements.Quantified_Expressions.
993 Quantified_Expression_Access)
994 is null;
995
996 overriding procedure Raise_Statement
997 (Self : in out Visiter;
998 Node : not null Gela.Elements.Raise_Statements.Raise_Statement_Access)
999 is null;
1000
1001 overriding procedure Range_Attribute_Reference
1002 (Self : in out Visiter;
1003 Node : not null Gela.Elements.Range_Attribute_References.
1004 Range_Attribute_Reference_Access)
1005 is null;
1006
1007 overriding procedure Range_Attribute_Reference_Dr
1008 (Self : in out Visiter;
1009 Node : not null Gela.Elements.Range_Attribute_Reference_Drs.
1010 Range_Attribute_Reference_Dr_Access)
1011 is null;
1012
1013 overriding procedure Record_Aggregate
1014 (Self : in out Visiter;
1015 Node : not null Gela.Elements.Record_Aggregates.
1016 Record_Aggregate_Access);
1017
1018 overriding procedure Record_Definition
1019 (Self : in out Visiter;
1020 Node : not null Gela.Elements.Record_Definitions.
1021 Record_Definition_Access);
1022
1023 overriding procedure Record_Representation_Clause
1024 (Self : in out Visiter;
1025 Node : not null Gela.Elements.Record_Representation_Clauses.
1026 Record_Representation_Clause_Access)
1027 is null;
1028
1029 overriding procedure Record_Type_Definition
1030 (Self : in out Visiter;
1031 Node : not null Gela.Elements.Record_Type_Definitions.
1032 Record_Type_Definition_Access);
1033
1034 overriding procedure Requeue_Statement
1035 (Self : in out Visiter;
1036 Node : not null Gela.Elements.Requeue_Statements.
1037 Requeue_Statement_Access);
1038
1039 overriding procedure Return_Object_Specification
1040 (Self : in out Visiter;
1041 Node : not null Gela.Elements.Return_Object_Specifications.
1042 Return_Object_Specification_Access)
1043 is null;
1044
1045 overriding procedure Select_Or_Path
1046 (Self : in out Visiter;
1047 Node : not null Gela.Elements.Select_Or_Paths.Select_Or_Path_Access);
1048
1049 overriding procedure Selected_Component
1050 (Self : in out Visiter;
1051 Node : not null Gela.Elements.Selected_Components.
1052 Selected_Component_Access);
1053
1054 overriding procedure Selected_Identifier
1055 (Self : in out Visiter;
1056 Node : not null Gela.Elements.Selected_Identifiers.
1057 Selected_Identifier_Access);
1058
1059 overriding procedure Selective_Accept
1060 (Self : in out Visiter;
1061 Node : not null Gela.Elements.Selective_Accepts.Selective_Accept_Access);
1062
1063 overriding procedure Short_Circuit
1064 (Self : in out Visiter;
1065 Node : not null Gela.Elements.Short_Circuits.Short_Circuit_Access)
1066 is null;
1067
1068 overriding procedure Signed_Integer_Type_Definition
1069 (Self : in out Visiter;
1070 Node : not null Gela.Elements.Signed_Integer_Type_Definitions.
1071 Signed_Integer_Type_Definition_Access);
1072
1073 overriding procedure Simple_Expression_Range
1074 (Self : in out Visiter;
1075 Node : not null Gela.Elements.Simple_Expression_Ranges.
1076 Simple_Expression_Range_Access);
1077
1078 overriding procedure Simple_Expression_Range_Dr
1079 (Self : in out Visiter;
1080 Node : not null Gela.Elements.Simple_Expression_Range_Drs.
1081 Simple_Expression_Range_Dr_Access);
1082
1083 overriding procedure Simple_Return_Statement
1084 (Self : in out Visiter;
1085 Node : not null Gela.Elements.Simple_Return_Statements.
1086 Simple_Return_Statement_Access);
1087
1088 overriding procedure Single_Protected_Declaration
1089 (Self : in out Visiter;
1090 Node : not null Gela.Elements.Single_Protected_Declarations.
1091 Single_Protected_Declaration_Access);
1092
1093 overriding procedure Single_Task_Declaration
1094 (Self : in out Visiter;
1095 Node : not null Gela.Elements.Single_Task_Declarations.
1096 Single_Task_Declaration_Access);
1097
1098 overriding procedure String_Literal
1099 (Self : in out Visiter;
1100 Node : not null Gela.Elements.String_Literals.String_Literal_Access);
1101
1102 overriding procedure Subtype_Declaration
1103 (Self : in out Visiter;
1104 Node : not null Gela.Elements.Subtype_Declarations.
1105 Subtype_Declaration_Access);
1106
1107 overriding procedure Subtype_Indication
1108 (Self : in out Visiter;
1109 Node : not null Gela.Elements.Subtype_Indications.
1110 Subtype_Indication_Access);
1111
1112 overriding procedure Subunit
1113 (Self : in out Visiter;
1114 Node : not null Gela.Elements.Subunits.Subunit_Access)
1115 is null;
1116
1117 overriding procedure Task_Body
1118 (Self : in out Visiter;
1119 Node : not null Gela.Elements.Task_Bodies.Task_Body_Access);
1120
1121 overriding procedure Task_Body_Stub
1122 (Self : in out Visiter;
1123 Node : not null Gela.Elements.Task_Body_Stubs.Task_Body_Stub_Access)
1124 is null;
1125
1126 overriding procedure Task_Definition
1127 (Self : in out Visiter;
1128 Node : not null Gela.Elements.Task_Definitions.Task_Definition_Access);
1129
1130 overriding procedure Task_Type_Declaration
1131 (Self : in out Visiter;
1132 Node : not null Gela.Elements.Task_Type_Declarations.
1133 Task_Type_Declaration_Access)
1134 is null;
1135
1136 overriding procedure Terminate_Alternative_Statement
1137 (Self : in out Visiter;
1138 Node : not null Gela.Elements.Terminate_Alternative_Statements.
1139 Terminate_Alternative_Statement_Access);
1140
1141 overriding procedure Then_Abort_Path
1142 (Self : in out Visiter;
1143 Node : not null Gela.Elements.Then_Abort_Paths.Then_Abort_Path_Access)
1144 is null;
1145
1146 overriding procedure Unconstrained_Array_Definition
1147 (Self : in out Visiter;
1148 Node : not null Gela.Elements.Unconstrained_Array_Definitions.
1149 Unconstrained_Array_Definition_Access);
1150
1151 overriding procedure Unknown_Discriminant_Part
1152 (Self : in out Visiter;
1153 Node : not null Gela.Elements.Unknown_Discriminant_Parts.
1154 Unknown_Discriminant_Part_Access)
1155 is null;
1156
1157 overriding procedure Use_Package_Clause
1158 (Self : in out Visiter;
1159 Node : not null Gela.Elements.Use_Package_Clauses.
1160 Use_Package_Clause_Access);
1161
1162 overriding procedure Use_Type_Clause
1163 (Self : in out Visiter;
1164 Node : not null Gela.Elements.Use_Type_Clauses.Use_Type_Clause_Access);
1165
1166 overriding procedure Variant
1167 (Self : in out Visiter;
1168 Node : not null Gela.Elements.Variants.Variant_Access);
1169
1170 overriding procedure Variant_Part
1171 (Self : in out Visiter;
1172 Node : not null Gela.Elements.Variant_Parts.Variant_Part_Access);
1173
1174 overriding procedure While_Loop_Statement
1175 (Self : in out Visiter;
1176 Node : not null Gela.Elements.While_Loop_Statements.
1177 While_Loop_Statement_Access)
1178 is null;
1179
1180 overriding procedure With_Clause
1181 (Self : in out Visiter;
1182 Node : not null Gela.Elements.With_Clauses.With_Clause_Access);
1183
1184 overriding procedure Accept_Statement
1185 (Self : in out Visiter;
1186 Node : not null Gela.Elements.Accept_Statements.Accept_Statement_Access)
1187 is
1188 pragma Unreferenced (Node);
1189 begin
1190 Self.Result := An_Accept_Statement;
1191 end Accept_Statement;
1192
1193 overriding procedure Access_To_Object_Definition
1194 (Self : in out Visiter;
1195 Node : not null Gela.Elements.Access_To_Object_Definitions.
1196 Access_To_Object_Definition_Access)
1197 is
1198 use type Gela.Lexical_Types.Token_Count;
1199 begin
1200 if Node.Constant_Token = 0 then
1201 Self.Result := An_Anonymous_Access_To_Variable;
1202 else
1203 Self.Result := An_Anonymous_Access_To_Constant;
1204 end if;
1205 end Access_To_Object_Definition;
1206
1207 overriding procedure Anonymous_Access_To_Object_Definition
1208 (Self : in out Visiter;
1209 Node : not null Gela.Elements.Anonymous_Access_To_Object_Definitions.
1210 Anonymous_Access_To_Object_Definition_Access)
1211 is
1212 use type Gela.Lexical_Types.Token_Count;
1213 begin
1214 if Node.Constant_Token = 0 then
1215 Self.Result := An_Anonymous_Access_To_Variable;
1216 else
1217 Self.Result := An_Anonymous_Access_To_Constant;
1218 end if;
1219 end Anonymous_Access_To_Object_Definition;
1220
1221 overriding procedure Assignment_Statement
1222 (Self : in out Visiter;
1223 Node : not null Gela.Elements.Assignment_Statements.
1224 Assignment_Statement_Access)
1225 is
1226 pragma Unreferenced (Node);
1227 begin
1228 Self.Result := An_Assignment_Statement;
1229 end Assignment_Statement;
1230
1231 overriding procedure Association
1232 (Self : in out Visiter;
1233 Node : not null Gela.Elements.Associations.Association_Access)
1234 is
1235 pragma Unreferenced (Node);
1236 begin
1237 Self.Result := A_Parameter_Association;
1238 end Association;
1239
1240 overriding procedure Attribute_Reference
1241 (Self : in out Visiter;
1242 Node : not null Gela.Elements.Attribute_References.
1243 Attribute_Reference_Access)
1244 is
1245 package X renames Gela.Lexical_Types.Predefined_Symbols;
1246
1247 Id : constant Gela.Elements.Identifiers.Identifier_Access :=
1248 Node.Attribute_Designator_Identifier;
1249 Comp : constant Gela.Compilations.Compilation_Access :=
1250 Node.Enclosing_Compilation;
1251 Token : constant Gela.Lexical_Types.Token :=
1252 Comp.Get_Token (Id.Identifier_Token);
1253 Map : constant array (Gela.Lexical_Types.Symbol range
1254 X.Access_Symbol .. X.Write) of Element_Flat_Kind
1255 :=
1256 (
1257 X.Access_Symbol => An_Access_Attribute,
1258 X.Address => An_Address_Attribute,
1259 X.Adjacent => An_Adjacent_Attribute,
1260 X.Aft => An_Aft_Attribute,
1261 X.Alignment => An_Alignment_Attribute,
1262 X.Base => A_Base_Attribute,
1263 X.Bit_Order => A_Bit_Order_Attribute,
1264 X.Body_Version => A_Body_Version_Attribute,
1265 X.Callable => A_Callable_Attribute,
1266 X.Caller => A_Caller_Attribute,
1267 X.Ceiling => A_Ceiling_Attribute,
1268 X.Class => A_Class_Attribute,
1269 X.Component_Size => A_Component_Size_Attribute,
1270 X.Compose => A_Compose_Attribute,
1271 X.Constrained => A_Constrained_Attribute,
1272 X.Copy_Sign => A_Copy_Sign_Attribute,
1273 X.Count => A_Count_Attribute,
1274 X.Definite => A_Definite_Attribute,
1275 X.Delta_Symbol => A_Delta_Attribute,
1276 X.Denorm => A_Denorm_Attribute,
1277 X.Digits_Symbol => A_Digits_Attribute,
1278 X.Exponent => An_Exponent_Attribute,
1279 X.External_Tag => An_External_Tag_Attribute,
1280 X.First => A_First_Attribute,
1281 X.First_Bit => A_First_Bit_Attribute,
1282 X.Floor => A_Floor_Attribute,
1283 X.Fore => A_Fore_Attribute,
1284 X.Fraction => A_Fraction_Attribute,
1285 X.Identity => An_Identity_Attribute,
1286 X.Image => An_Image_Attribute,
1287 X.Input => An_Input_Attribute,
1288 X.Last => A_Last_Attribute,
1289 X.Last_Bit => A_Last_Bit_Attribute,
1290 X.Leading_Part => A_Leading_Part_Attribute,
1291 X.Length => A_Length_Attribute,
1292 X.Machine => A_Machine_Attribute,
1293 X.Machine_Emax => A_Machine_Emax_Attribute,
1294 X.Machine_Emin => A_Machine_Emin_Attribute,
1295 X.Machine_Mantissa => A_Machine_Mantissa_Attribute,
1296 X.Machine_Overflows => A_Machine_Overflows_Attribute,
1297 X.Machine_Radix => A_Machine_Radix_Attribute,
1298 X.Machine_Rounding => A_Machine_Rounding_Attribute,
1299 X.Machine_Rounds => A_Machine_Rounds_Attribute,
1300 X.Max => A_Max_Attribute,
1301 X.Max_Size_In_Storage_Elements =>
1302 A_Max_Size_In_Storage_Elements_Attribute,
1303 X.Min => A_Min_Attribute,
1304 X.Mod_Symbol => A_Mod_Attribute,
1305 X.Model => A_Model_Attribute,
1306 X.Model_Emin => A_Model_Emin_Attribute,
1307 X.Model_Epsilon => A_Model_Epsilon_Attribute,
1308 X.Model_Mantissa => A_Model_Mantissa_Attribute,
1309 X.Model_Small => A_Model_Small_Attribute,
1310 X.Modulus => A_Modulus_Attribute,
1311 X.Output => An_Output_Attribute,
1312 X.Partition_ID => A_Partition_ID_Attribute,
1313 X.Pos => A_Pos_Attribute,
1314 X.Position => A_Position_Attribute,
1315 X.Pred => A_Pred_Attribute,
1316 X.Priority => A_Priority_Attribute,
1317 X.Range_Symbol => A_Range_Attribute,
1318 X.Read => A_Read_Attribute,
1319 X.Remainder => A_Remainder_Attribute,
1320 X.Round => A_Round_Attribute,
1321 X.Rounding => A_Rounding_Attribute,
1322 X.Safe_First => A_Safe_First_Attribute,
1323 X.Safe_Last => A_Safe_Last_Attribute,
1324 X.Scale => A_Scale_Attribute,
1325 X.Scaling => A_Scaling_Attribute,
1326 X.Signed_Zeros => A_Signed_Zeros_Attribute,
1327 X.Size => A_Size_Attribute,
1328 X.Small => A_Small_Attribute,
1329 X.Storage_Pool => A_Storage_Pool_Attribute,
1330 X.Storage_Size => A_Storage_Size_Attribute,
1331 X.Stream_Size => A_Stream_Size_Attribute,
1332 X.Succ => A_Succ_Attribute,
1333 X.Tag => A_Tag_Attribute,
1334 X.Terminated => A_Terminated_Attribute,
1335 X.Truncation => A_Truncation_Attribute,
1336 X.Unbiased_Rounding => An_Unbiased_Rounding_Attribute,
1337 X.Unchecked_Access => An_Unchecked_Access_Attribute,
1338 X.Val => A_Val_Attribute,
1339 X.Valid => A_Valid_Attribute,
1340 X.Value => A_Value_Attribute,
1341 X.Version => A_Version_Attribute,
1342 X.Wide_Image => A_Wide_Image_Attribute,
1343 X.Wide_Value => A_Wide_Value_Attribute,
1344 X.Wide_Wide_Image => A_Wide_Wide_Image_Attribute,
1345 X.Wide_Wide_Value => A_Wide_Wide_Value_Attribute,
1346 X.Wide_Wide_Width => A_Wide_Wide_Width_Attribute,
1347 X.Wide_Width => A_Wide_Width_Attribute,
1348 X.Width => A_Width_Attribute,
1349 X.Write => A_Write_Attribute);
1350 begin
1351 if Token.Symbol in Map'Range then
1352 Self.Result := Map (Token.Symbol);
1353 end if;
1354 end Attribute_Reference;
1355
1356 overriding procedure Auxiliary_Apply
1357 (Self : in out Visiter;
1358 Node : not null Gela.Elements.Auxiliary_Applies.Auxiliary_Apply_Access)
1359 is
1360 pragma Unreferenced (Node);
1361 begin
1362 Self.Result := A_Function_Call;
1363 end Auxiliary_Apply;
1364
1365 overriding procedure Block_Statement
1366 (Self : in out Visiter;
1367 Node : not null Gela.Elements.Block_Statements.Block_Statement_Access)
1368 is
1369 pragma Unreferenced (Node);
1370 begin
1371 Self.Result := A_Block_Statement;
1372 end Block_Statement;
1373
1374 overriding procedure Case_Path
1375 (Self : in out Visiter;
1376 Node : not null Gela.Elements.Case_Paths.Case_Path_Access)
1377 is
1378 pragma Unreferenced (Node);
1379 begin
1380 Self.Result := A_Case_Path;
1381 end Case_Path;
1382
1383 overriding procedure Case_Statement
1384 (Self : in out Visiter;
1385 Node : not null Gela.Elements.Case_Statements.Case_Statement_Access)
1386 is
1387 pragma Unreferenced (Node);
1388 begin
1389 Self.Result := A_Case_Statement;
1390 end Case_Statement;
1391
1392 overriding procedure Component_Declaration
1393 (Self : in out Visiter;
1394 Node : not null Gela.Elements.Component_Declarations.
1395 Component_Declaration_Access)
1396 is
1397 pragma Unreferenced (Node);
1398 begin
1399 Self.Result := A_Component_Declaration;
1400 end Component_Declaration;
1401
1402 overriding procedure Component_Definition
1403 (Self : in out Visiter;
1404 Node : not null Gela.Elements.Component_Definitions.
1405 Component_Definition_Access)
1406 is
1407 pragma Unreferenced (Node);
1408 begin
1409 Self.Result := A_Component_Definition;
1410 end Component_Definition;
1411
1412 overriding procedure Composite_Constraint
1413 (Self : in out Visiter;
1414 Node : not null Gela.Elements.Composite_Constraints.
1415 Composite_Constraint_Access)
1416 is
1417 pragma Unreferenced (Node);
1418 begin
1419 Self.Result := An_Index_Constraint; -- FIXME
1420 end Composite_Constraint;
1421
1422 overriding procedure Constrained_Array_Definition
1423 (Self : in out Visiter;
1424 Node : not null Gela.Elements.Constrained_Array_Definitions.
1425 Constrained_Array_Definition_Access)
1426 is
1427 pragma Unreferenced (Node);
1428 begin
1429 Self.Result := A_Constrained_Array_Definition;
1430 end Constrained_Array_Definition;
1431
1432 overriding procedure Defining_Enumeration_Literal
1433 (Self : in out Visiter;
1434 Node : not null Gela.Elements.Defining_Enumeration_Literals.
1435 Defining_Enumeration_Literal_Access)
1436 is
1437 pragma Unreferenced (Node);
1438 begin
1439 Self.Result := A_Defining_Enumeration_Literal;
1440 end Defining_Enumeration_Literal;
1441
1442 overriding procedure Defining_Expanded_Unit_Name
1443 (Self : in out Visiter;
1444 Node : not null Gela.Elements.Defining_Expanded_Unit_Names.
1445 Defining_Expanded_Unit_Name_Access)
1446 is
1447 pragma Unreferenced (Node);
1448 begin
1449 Self.Result := A_Defining_Expanded_Name;
1450 end Defining_Expanded_Unit_Name;
1451
1452 overriding procedure Defining_Identifier
1453 (Self : in out Visiter;
1454 Node : not null Gela.Elements.Defining_Identifiers.
1455 Defining_Identifier_Access)
1456 is
1457 pragma Unreferenced (Node);
1458 begin
1459 Self.Result := A_Defining_Identifier;
1460 end Defining_Identifier;
1461
1462 overriding procedure Defining_Operator_Symbol
1463 (Self : in out Visiter;
1464 Node : not null Gela.Elements.Defining_Operator_Symbols.
1465 Defining_Operator_Symbol_Access)
1466 is
1467 Operator_Map : constant array
1468 (Gela.Lexical_Types.Symbol range 1 .. 19) of Element_Flat_Kind
1469 := (A_Defining_Less_Than_Operator,
1470 A_Defining_Equal_Operator,
1471 A_Defining_Greater_Than_Operator,
1472 A_Defining_Minus_Operator,
1473 A_Defining_Divide_Operator,
1474 A_Defining_Multiply_Operator,
1475 A_Defining_Concatenate_Operator,
1476 A_Defining_Plus_Operator,
1477 A_Defining_Less_Than_Or_Equal_Operator,
1478 A_Defining_Greater_Than_Or_Equal_Operator,
1479 A_Defining_Not_Equal_Operator,
1480 A_Defining_Exponentiate_Operator,
1481 A_Defining_Or_Operator,
1482 A_Defining_And_Operator,
1483 A_Defining_Xor_Operator,
1484 A_Defining_Mod_Operator,
1485 A_Defining_Rem_Operator,
1486 A_Defining_Abs_Operator,
1487 A_Defining_Not_Operator);
1488
1489 Comp : constant Gela.Compilations.Compilation_Access :=
1490 Node.Enclosing_Compilation;
1491 Token : constant Gela.Lexical_Types.Token :=
1492 Comp.Get_Token (Node.Operator_Symbol_Token);
1493 begin
1494 if Token.Symbol in Operator_Map'Range then
1495 Self.Result := Operator_Map (Token.Symbol);
1496 end if;
1497 end Defining_Operator_Symbol;
1498
1499 overriding procedure Delay_Statement
1500 (Self : in out Visiter;
1501 Node : not null Gela.Elements.Delay_Statements.Delay_Statement_Access)
1502 is
1503 use type Gela.Lexical_Types.Token_Index;
1504 begin
1505 if Node.Until_Token = 0 then
1506 Self.Result := A_Delay_Relative_Statement;
1507 else
1508 Self.Result := A_Delay_Until_Statement;
1509 end if;
1510 end Delay_Statement;
1511
1512 overriding procedure Derived_Type_Definition
1513 (Self : in out Visiter;
1514 Node : not null Gela.Elements.Derived_Type_Definitions.
1515 Derived_Type_Definition_Access)
1516 is
1517 pragma Unreferenced (Node);
1518 begin
1519 Self.Result := A_Derived_Type_Definition;
1520 end Derived_Type_Definition;
1521
1522 overriding procedure Discrete_Simple_Expression_Range
1523 (Self : in out Visiter;
1524 Node : not null Gela.Elements.Discrete_Simple_Expression_Ranges.
1525 Discrete_Simple_Expression_Range_Access)
1526 is
1527 pragma Unreferenced (Node);
1528 begin
1529 Self.Result := A_Discrete_Simple_Expression_Range;
1530 end Discrete_Simple_Expression_Range;
1531
1532 overriding procedure Discrete_Subtype_Indication
1533 (Self : in out Visiter;
1534 Node : not null Gela.Elements.Discrete_Subtype_Indications.
1535 Discrete_Subtype_Indication_Access)
1536 is
1537 pragma Unreferenced (Node);
1538 begin
1539 Self.Result := A_Discrete_Subtype_Indication;
1540 end Discrete_Subtype_Indication;
1541
1542 overriding procedure Discriminant_Specification
1543 (Self : in out Visiter;
1544 Node : not null Gela.Elements.Discriminant_Specifications.
1545 Discriminant_Specification_Access)
1546 is
1547 pragma Unreferenced (Node);
1548 begin
1549 Self.Result := A_Discriminant_Specification;
1550 end Discriminant_Specification;
1551
1552 overriding procedure Else_Path
1553 (Self : in out Visiter;
1554 Node : not null Gela.Elements.Else_Paths.Else_Path_Access)
1555 is
1556 pragma Unreferenced (Node);
1557 begin
1558 Self.Result := An_Else_Path;
1559 end Else_Path;
1560
1561 overriding procedure Entry_Body
1562 (Self : in out Visiter;
1563 Node : not null Gela.Elements.Entry_Bodies.Entry_Body_Access)
1564 is
1565 pragma Unreferenced (Node);
1566 begin
1567 Self.Result := An_Entry_Body_Declaration;
1568 end Entry_Body;
1569
1570 overriding procedure Entry_Declaration
1571 (Self : in out Visiter;
1572 Node : not null Gela.Elements.Entry_Declarations.
1573 Entry_Declaration_Access)
1574 is
1575 pragma Unreferenced (Node);
1576 begin
1577 Self.Result := An_Entry_Declaration;
1578 end Entry_Declaration;
1579
1580 overriding procedure Enumeration_Literal_Specification
1581 (Self : in out Visiter;
1582 Node : not null Gela.Elements.Enumeration_Literal_Specifications.
1583 Enumeration_Literal_Specification_Access)
1584 is
1585 pragma Unreferenced (Node);
1586 begin
1587 Self.Result := An_Enumeration_Literal_Specification;
1588 end Enumeration_Literal_Specification;
1589
1590 overriding procedure Enumeration_Type_Definition
1591 (Self : in out Visiter;
1592 Node : not null Gela.Elements.Enumeration_Type_Definitions.
1593 Enumeration_Type_Definition_Access)
1594 is
1595 pragma Unreferenced (Node);
1596 begin
1597 Self.Result := An_Enumeration_Type_Definition;
1598 end Enumeration_Type_Definition;
1599
1600 overriding procedure Exception_Declaration
1601 (Self : in out Visiter;
1602 Node : not null Gela.Elements.Exception_Declarations.
1603 Exception_Declaration_Access)
1604 is
1605 pragma Unreferenced (Node);
1606 begin
1607 Self.Result := An_Exception_Declaration;
1608 end Exception_Declaration;
1609
1610 overriding procedure Exception_Handler
1611 (Self : in out Visiter;
1612 Node : not null Gela.Elements.Exception_Handlers.
1613 Exception_Handler_Access)
1614 is
1615 pragma Unreferenced (Node);
1616 begin
1617 Self.Result := An_Exception_Handler;
1618 end Exception_Handler;
1619
1620 overriding procedure Exception_Renaming_Declaration
1621 (Self : in out Visiter;
1622 Node : not null Gela.Elements.Exception_Renaming_Declarations.
1623 Exception_Renaming_Declaration_Access)
1624 is
1625 pragma Unreferenced (Node);
1626 begin
1627 Self.Result := An_Exception_Renaming_Declaration;
1628 end Exception_Renaming_Declaration;
1629
1630 overriding procedure Exit_Statement
1631 (Self : in out Visiter;
1632 Node : not null Gela.Elements.Exit_Statements.Exit_Statement_Access)
1633 is
1634 pragma Unreferenced (Node);
1635 begin
1636 Self.Result := An_Exit_Statement;
1637 end Exit_Statement;
1638
1639 overriding procedure Explicit_Dereference
1640 (Self : in out Visiter;
1641 Node : not null Gela.Elements.Explicit_Dereferences.
1642 Explicit_Dereference_Access)
1643 is
1644 pragma Unreferenced (Node);
1645 begin
1646 Self.Result := An_Explicit_Dereference;
1647 end Explicit_Dereference;
1648
1649 ---------------
1650 -- Flat_Kind --
1651 ---------------
1652
1653 function Flat_Kind (Element : Asis.Element) return Element_Flat_Kind is
1654 V : aliased Visiter := (Result => Not_An_Element);
1655 begin
1656 Element.Data.Visit (V);
1657 pragma Assert
1658 (Element.Data.Assigned and then V.Result /= Not_An_Element);
1659 return V.Result;
1660 end Flat_Kind;
1661
1662 overriding procedure Formal_Derived_Type_Definition
1663 (Self : in out Visiter;
1664 Node : not null Gela.Elements.Formal_Derived_Type_Definitions.
1665 Formal_Derived_Type_Definition_Access)
1666 is
1667 pragma Unreferenced (Node);
1668 begin
1669 Self.Result := A_Formal_Derived_Type_Definition;
1670 end Formal_Derived_Type_Definition;
1671
1672 overriding procedure Formal_Type_Declaration
1673 (Self : in out Visiter;
1674 Node : not null Gela.Elements.Formal_Type_Declarations.
1675 Formal_Type_Declaration_Access)
1676 is
1677 pragma Unreferenced (Node);
1678 begin
1679 Self.Result := A_Formal_Type_Declaration;
1680 end Formal_Type_Declaration;
1681
1682 overriding procedure Full_Type_Declaration
1683 (Self : in out Visiter;
1684 Node : not null Gela.Elements.Full_Type_Declarations.
1685 Full_Type_Declaration_Access)
1686 is
1687 pragma Unreferenced (Node);
1688 begin
1689 Self.Result := An_Ordinary_Type_Declaration;
1690 end Full_Type_Declaration;
1691
1692 overriding procedure Function_Body
1693 (Self : in out Visiter;
1694 Node : not null Gela.Elements.Function_Bodies.Function_Body_Access)
1695 is
1696 pragma Unreferenced (Node);
1697 begin
1698 Self.Result := A_Function_Body_Declaration;
1699 end Function_Body;
1700
1701 overriding procedure Function_Declaration
1702 (Self : in out Visiter;
1703 Node : not null Gela.Elements.Function_Declarations.
1704 Function_Declaration_Access)
1705 is
1706 pragma Unreferenced (Node);
1707 begin
1708 Self.Result := A_Function_Declaration;
1709 end Function_Declaration;
1710
1711 overriding procedure Generic_Association
1712 (Self : in out Visiter;
1713 Node : not null Gela.Elements.Generic_Associations.
1714 Generic_Association_Access)
1715 is
1716 pragma Unreferenced (Node);
1717 begin
1718 Self.Result := A_Generic_Association;
1719 end Generic_Association;
1720
1721 overriding procedure Generic_Package_Declaration
1722 (Self : in out Visiter;
1723 Node : not null Gela.Elements.Generic_Package_Declarations.
1724 Generic_Package_Declaration_Access)
1725 is
1726 pragma Unreferenced (Node);
1727 begin
1728 Self.Result := A_Generic_Package_Declaration;
1729 end Generic_Package_Declaration;
1730
1731 overriding procedure Identifier
1732 (Self : in out Visiter;
1733 Node : not null Gela.Elements.Identifiers.Identifier_Access)
1734 is
1735 pragma Unreferenced (Node);
1736 begin
1737 Self.Result := An_Identifier;
1738 end Identifier;
1739
1740 overriding procedure If_Path
1741 (Self : in out Visiter;
1742 Node : not null Gela.Elements.If_Paths.If_Path_Access)
1743 is
1744 pragma Unreferenced (Node);
1745 begin
1746 Self.Result := An_If_Path;
1747 end If_Path;
1748
1749 overriding procedure If_Statement
1750 (Self : in out Visiter;
1751 Node : not null Gela.Elements.If_Statements.If_Statement_Access)
1752 is
1753 pragma Unreferenced (Node);
1754 begin
1755 Self.Result := An_If_Statement;
1756 end If_Statement;
1757
1758 overriding procedure Known_Discriminant_Part
1759 (Self : in out Visiter;
1760 Node : not null Gela.Elements.Known_Discriminant_Parts.
1761 Known_Discriminant_Part_Access)
1762 is
1763 pragma Unreferenced (Node);
1764 begin
1765 Self.Result := A_Known_Discriminant_Part;
1766 end Known_Discriminant_Part;
1767
1768 overriding procedure Loop_Statement
1769 (Self : in out Visiter;
1770 Node : not null Gela.Elements.Loop_Statements.Loop_Statement_Access)
1771 is
1772 pragma Unreferenced (Node);
1773 begin
1774 Self.Result := A_Loop_Statement;
1775 end Loop_Statement;
1776
1777 overriding procedure Null_Component
1778 (Self : in out Visiter;
1779 Node : not null Gela.Elements.Null_Components.Null_Component_Access)
1780 is
1781 pragma Unreferenced (Node);
1782 begin
1783 Self.Result := A_Null_Component;
1784 end Null_Component;
1785
1786 overriding procedure Null_Statement
1787 (Self : in out Visiter;
1788 Node : not null Gela.Elements.Null_Statements.Null_Statement_Access)
1789 is
1790 pragma Unreferenced (Node);
1791 begin
1792 Self.Result := A_Null_Statement;
1793 end Null_Statement;
1794
1795 overriding procedure Number_Declaration
1796 (Self : in out Visiter;
1797 Node : not null Gela.Elements.Number_Declarations.
1798 Number_Declaration_Access)
1799 is
1800 pragma Unreferenced (Node);
1801 begin
1802 Self.Result := An_Integer_Number_Declaration;
1803 end Number_Declaration;
1804
1805 overriding procedure Numeric_Literal
1806 (Self : in out Visiter;
1807 Node : not null Gela.Elements.Numeric_Literals.Numeric_Literal_Access)
1808 is
1809 pragma Unreferenced (Node);
1810 begin
1811 Self.Result := An_Integer_Literal;
1812 end Numeric_Literal;
1813
1814 overriding procedure Object_Declaration
1815 (Self : in out Visiter;
1816 Node : not null Gela.Elements.Object_Declarations.
1817 Object_Declaration_Access)
1818 is
1819 use type Gela.Lexical_Types.Token_Count;
1820 begin
1821 if Node.Constant_Token = 0 then
1822 Self.Result := A_Variable_Declaration;
1823 else
1824 Self.Result := A_Constant_Declaration;
1825 end if;
1826 end Object_Declaration;
1827
1828 overriding procedure Object_Renaming_Declaration
1829 (Self : in out Visiter;
1830 Node : not null Gela.Elements.Object_Renaming_Declarations.
1831 Object_Renaming_Declaration_Access)
1832 is
1833 pragma Unreferenced (Node);
1834 begin
1835 Self.Result := An_Object_Renaming_Declaration;
1836 end Object_Renaming_Declaration;
1837
1838 overriding procedure Operator_Symbol
1839 (Self : in out Visiter;
1840 Node : not null Gela.Elements.Operator_Symbols.Operator_Symbol_Access)
1841 is
1842 Operator_Map : constant array
1843 (Gela.Lexical_Types.Symbol range 1 .. 19) of Element_Flat_Kind
1844 :=
1845 (A_Less_Than_Operator, An_Equal_Operator, A_Greater_Than_Operator,
1846 A_Minus_Operator, A_Divide_Operator, A_Multiply_Operator,
1847 A_Concatenate_Operator, A_Plus_Operator,
1848 A_Less_Than_Or_Equal_Operator, A_Greater_Than_Or_Equal_Operator,
1849 A_Not_Equal_Operator, An_Exponentiate_Operator, An_Or_Operator,
1850 An_And_Operator, An_Xor_Operator, A_Mod_Operator, A_Rem_Operator,
1851 An_Abs_Operator, A_Not_Operator);
1852
1853 Comp : constant Gela.Compilations.Compilation_Access :=
1854 Node.Enclosing_Compilation;
1855 Token : constant Gela.Lexical_Types.Token :=
1856 Comp.Get_Token (Node.Operator_Symbol_Token);
1857 begin
1858 if Token.Symbol in Operator_Map'Range then
1859 Self.Result := Operator_Map (Token.Symbol);
1860 end if;
1861 end Operator_Symbol;
1862
1863 overriding procedure Others_Choice
1864 (Self : in out Visiter;
1865 Node : not null Gela.Elements.Others_Choices.Others_Choice_Access)
1866 is
1867 pragma Unreferenced (Node);
1868 begin
1869 Self.Result := An_Others_Choice;
1870 end Others_Choice;
1871
1872 overriding procedure Package_Body
1873 (Self : in out Visiter;
1874 Node : not null Gela.Elements.Package_Bodies.Package_Body_Access)
1875 is
1876 pragma Unreferenced (Node);
1877 begin
1878 Self.Result := A_Package_Body_Declaration;
1879 end Package_Body;
1880
1881 overriding procedure Package_Declaration
1882 (Self : in out Visiter;
1883 Node : not null Gela.Elements.Package_Declarations.
1884 Package_Declaration_Access)
1885 is
1886 pragma Unreferenced (Node);
1887 begin
1888 Self.Result := A_Package_Declaration;
1889 end Package_Declaration;
1890
1891 overriding procedure Package_Instantiation
1892 (Self : in out Visiter;
1893 Node : not null Gela.Elements.Package_Instantiations.
1894 Package_Instantiation_Access)
1895 is
1896 pragma Unreferenced (Node);
1897 begin
1898 Self.Result := A_Package_Instantiation;
1899 end Package_Instantiation;
1900
1901 overriding procedure Package_Renaming_Declaration
1902 (Self : in out Visiter;
1903 Node : not null Gela.Elements.Package_Renaming_Declarations.
1904 Package_Renaming_Declaration_Access)
1905 is
1906 pragma Unreferenced (Node);
1907 begin
1908 Self.Result := A_Package_Renaming_Declaration;
1909 end Package_Renaming_Declaration;
1910
1911 overriding procedure Parameter_Specification
1912 (Self : in out Visiter;
1913 Node : not null Gela.Elements.Parameter_Specifications.
1914 Parameter_Specification_Access)
1915 is
1916 pragma Unreferenced (Node);
1917 begin
1918 Self.Result := A_Parameter_Specification;
1919 end Parameter_Specification;
1920
1921 overriding procedure Pragma_Node
1922 (Self : in out Visiter;
1923 Node : not null Gela.Elements.Pragma_Nodes.Pragma_Node_Access)
1924 is
1925 package X renames Gela.Lexical_Types.Predefined_Symbols;
1926
1927 Comp : constant Gela.Compilations.Compilation_Access :=
1928 Node.Enclosing_Compilation;
1929 Token : constant Gela.Lexical_Types.Token :=
1930 Comp.Get_Token (Node.Pragma_Token);
1931 Map : constant array
1932 (Gela.Lexical_Types.Symbol range
1933 X.All_Calls_Remote .. X.Storage_Size) of Element_Flat_Kind :=
1934 (X.All_Calls_Remote => An_All_Calls_Remote_Pragma,
1935 X.Assert => An_Assert_Pragma,
1936 X.Assertion_Policy => An_Assertion_Policy_Pragma,
1937 X.Asynchronous => An_Asynchronous_Pragma,
1938 X.Atomic => An_Atomic_Pragma,
1939 X.Atomic_Components => An_Atomic_Components_Pragma,
1940 X.Attach_Handler => An_Attach_Handler_Pragma,
1941 X.Controlled => A_Controlled_Pragma,
1942 X.Convention => A_Convention_Pragma,
1943 X.Detect_Blocking => A_Detect_Blocking_Pragma,
1944 X.Discard_Names => A_Discard_Names_Pragma,
1945 X.Elaborate => An_Elaborate_Pragma,
1946 X.Elaborate_All => An_Elaborate_All_Pragma,
1947 X.Elaborate_Body => An_Elaborate_Body_Pragma,
1948 X.Export => An_Export_Pragma,
1949 X.Import => An_Import_Pragma,
1950 X.Inline => An_Inline_Pragma,
1951 X.Inspection_Point => An_Inspection_Point_Pragma,
1952 X.Interrupt_Handler => An_Interrupt_Handler_Pragma,
1953 X.Interrupt_Priority => An_Interrupt_Priority_Pragma,
1954 X.Linker_Options => A_Linker_Options_Pragma,
1955 X.List => A_List_Pragma,
1956 X.Locking_Policy => A_Locking_Policy_Pragma,
1957 X.No_Return => A_No_Return_Pragma,
1958 X.Normalize_Scalars => A_Normalize_Scalars_Pragma,
1959 X.Optimize => An_Optimize_Pragma,
1960 X.Pack => A_Pack_Pragma,
1961 X.Page => A_Page_Pragma,
1962 X.Partition_Elaboration_Policy =>
1963 A_Partition_Elaboration_Policy_Pragma,
1964 X.Preelaborable_Initialization =>
1965 A_Preelaborable_Initialization_Pragma,
1966 X.Preelaborate => A_Preelaborate_Pragma,
1967 X.Priority => A_Priority_Pragma,
1968 X.Priority_Specific_Dispatching =>
1969 A_Priority_Specific_Dispatching_Pragma,
1970 X.Profile => A_Profile_Pragma,
1971 X.Pure => A_Pure_Pragma,
1972 X.Queuing_Policy => A_Queuing_Policy_Pragma,
1973 X.Relative_Deadline => A_Relative_Deadline_Pragma,
1974 X.Remote_Call_Interface => A_Remote_Call_Interface_Pragma,
1975 X.Remote_Types => A_Remote_Types_Pragma,
1976 X.Restrictions => A_Restrictions_Pragma,
1977 X.Reviewable => A_Reviewable_Pragma,
1978 X.Shared_Passive => A_Shared_Passive_Pragma,
1979 X.Storage_Size => A_Storage_Size_Pragma,
1980 X.Suppress => A_Suppress_Pragma,
1981 X.Task_Dispatching_Policy => A_Task_Dispatching_Policy_Pragma,
1982 X.Unchecked_Union => An_Unchecked_Union_Pragma,
1983 X.Unsuppress => An_Unsuppress_Pragma,
1984 X.Volatile => A_Volatile_Pragma,
1985 X.Volatile_Components => A_Volatile_Components_Pragma,
1986 others => An_Unknown_Pragma);
1987
1988 begin
1989 if Token.Symbol in Map'Range then
1990 Self.Result := Map (Token.Symbol);
1991 else
1992 Self.Result := An_Unknown_Pragma;
1993 end if;
1994 end Pragma_Node;
1995
1996 overriding procedure Private_Type_Declaration
1997 (Self : in out Visiter;
1998 Node : not null Gela.Elements.Private_Type_Declarations.
1999 Private_Type_Declaration_Access)
2000 is
2001 pragma Unreferenced (Node);
2002 begin
2003 Self.Result := A_Private_Type_Declaration;
2004 end Private_Type_Declaration;
2005
2006 overriding procedure Private_Type_Definition
2007 (Self : in out Visiter;
2008 Node : not null Gela.Elements.Private_Type_Definitions.
2009 Private_Type_Definition_Access)
2010 is
2011 pragma Unreferenced (Node);
2012 begin
2013 Self.Result := A_Private_Type_Definition;
2014 end Private_Type_Definition;
2015
2016 --------------------
2017 -- Procedure_Body --
2018 --------------------
2019
2020 overriding procedure Procedure_Body
2021 (Self : in out Visiter;
2022 Node : not null Gela.Elements.Procedure_Bodies.Procedure_Body_Access)
2023 is
2024 pragma Unreferenced (Node);
2025 begin
2026 Self.Result := A_Procedure_Body_Declaration;
2027 end Procedure_Body;
2028
2029 ------------------------------
2030 -- Procedure_Call_Statement --
2031 ------------------------------
2032
2033 overriding procedure Procedure_Call_Statement
2034 (Self : in out Visiter;
2035 Node : not null Gela.Elements.Procedure_Call_Statements.
2036 Procedure_Call_Statement_Access)
2037 is
2038 pragma Unreferenced (Node);
2039 begin
2040 Self.Result := A_Procedure_Call_Statement;
2041 end Procedure_Call_Statement;
2042
2043 overriding procedure Procedure_Declaration
2044 (Self : in out Visiter;
2045 Node : not null Gela.Elements.Procedure_Declarations.
2046 Procedure_Declaration_Access)
2047 is
2048 pragma Unreferenced (Node);
2049 begin
2050 Self.Result := A_Procedure_Declaration;
2051 end Procedure_Declaration;
2052
2053 overriding procedure Protected_Body
2054 (Self : in out Visiter;
2055 Node : not null Gela.Elements.Protected_Bodies.Protected_Body_Access)
2056 is
2057 pragma Unreferenced (Node);
2058 begin
2059 Self.Result := A_Protected_Body_Declaration;
2060 end Protected_Body;
2061
2062 overriding procedure Protected_Definition
2063 (Self : in out Visiter;
2064 Node : not null Gela.Elements.Protected_Definitions.
2065 Protected_Definition_Access)
2066 is
2067 pragma Unreferenced (Node);
2068 begin
2069 Self.Result := A_Protected_Definition;
2070 end Protected_Definition;
2071
2072 overriding procedure Record_Aggregate
2073 (Self : in out Visiter;
2074 Node : not null Gela.Elements.Record_Aggregates.Record_Aggregate_Access)
2075 is
2076 pragma Unreferenced (Node);
2077 begin
2078 Self.Result := A_Record_Aggregate;
2079 end Record_Aggregate;
2080
2081 overriding procedure Record_Definition
2082 (Self : in out Visiter;
2083 Node : not null Gela.Elements.Record_Definitions.
2084 Record_Definition_Access)
2085 is
2086 pragma Unreferenced (Node);
2087 begin
2088 Self.Result := A_Record_Definition;
2089 end Record_Definition;
2090
2091 overriding procedure Record_Type_Definition
2092 (Self : in out Visiter;
2093 Node : not null Gela.Elements.Record_Type_Definitions.
2094 Record_Type_Definition_Access)
2095 is
2096 pragma Unreferenced (Node);
2097 begin
2098 Self.Result := A_Record_Type_Definition;
2099 end Record_Type_Definition;
2100
2101 overriding procedure Requeue_Statement
2102 (Self : in out Visiter;
2103 Node : not null Gela.Elements.Requeue_Statements.
2104 Requeue_Statement_Access)
2105 is
2106 use type Gela.Lexical_Types.Token_Count;
2107 begin
2108 if Node.With_Token = 0 then
2109 Self.Result := A_Requeue_Statement;
2110 else
2111 Self.Result := A_Requeue_Statement_With_Abort;
2112 end if;
2113 end Requeue_Statement;
2114
2115 overriding procedure Select_Or_Path
2116 (Self : in out Visiter;
2117 Node : not null Gela.Elements.Select_Or_Paths.Select_Or_Path_Access)
2118 is
2119 pragma Unreferenced (Node);
2120 begin
2121 Self.Result := An_Or_Path;
2122 end Select_Or_Path;
2123
2124 ------------------------
2125 -- Selected_Component --
2126 ------------------------
2127
2128 overriding procedure Selected_Component
2129 (Self : in out Visiter;
2130 Node : not null Gela.Elements.Selected_Components.
2131 Selected_Component_Access)
2132 is
2133 pragma Unreferenced (Node);
2134 begin
2135 Self.Result := A_Selected_Component;
2136 end Selected_Component;
2137
2138 -------------------------
2139 -- Selected_Identifier --
2140 -------------------------
2141
2142 overriding procedure Selected_Identifier
2143 (Self : in out Visiter;
2144 Node : not null Gela.Elements.Selected_Identifiers.
2145 Selected_Identifier_Access)
2146 is
2147 pragma Unreferenced (Node);
2148 begin
2149 Self.Result := A_Selected_Component;
2150 end Selected_Identifier;
2151
2152 overriding procedure Selective_Accept
2153 (Self : in out Visiter;
2154 Node : not null Gela.Elements.Selective_Accepts.Selective_Accept_Access)
2155 is
2156 pragma Unreferenced (Node);
2157 begin
2158 Self.Result := A_Selective_Accept_Statement;
2159 end Selective_Accept;
2160
2161 overriding procedure Signed_Integer_Type_Definition
2162 (Self : in out Visiter;
2163 Node : not null Gela.Elements.Signed_Integer_Type_Definitions.
2164 Signed_Integer_Type_Definition_Access)
2165 is
2166 pragma Unreferenced (Node);
2167 begin
2168 Self.Result := A_Signed_Integer_Type_Definition;
2169 end Signed_Integer_Type_Definition;
2170
2171 overriding procedure Simple_Expression_Range
2172 (Self : in out Visiter;
2173 Node : not null Gela.Elements.Simple_Expression_Ranges.
2174 Simple_Expression_Range_Access)
2175 is
2176 pragma Unreferenced (Node);
2177 begin
2178 Self.Result := A_Discrete_Simple_Expression_Range;
2179 end Simple_Expression_Range;
2180
2181 overriding procedure Simple_Expression_Range_Dr
2182 (Self : in out Visiter;
2183 Node : not null Gela.Elements.Simple_Expression_Range_Drs.
2184 Simple_Expression_Range_Dr_Access)
2185 is
2186 pragma Unreferenced (Node);
2187 begin
2188 Self.Result := A_Discrete_Simple_Expression_Range_DR;
2189 end Simple_Expression_Range_Dr;
2190
2191 overriding procedure Simple_Return_Statement
2192 (Self : in out Visiter;
2193 Node : not null Gela.Elements.Simple_Return_Statements.
2194 Simple_Return_Statement_Access)
2195 is
2196 pragma Unreferenced (Node);
2197 begin
2198 Self.Result := A_Simple_Return_Statement;
2199 end Simple_Return_Statement;
2200
2201 overriding procedure Single_Protected_Declaration
2202 (Self : in out Visiter;
2203 Node : not null Gela.Elements.Single_Protected_Declarations.
2204 Single_Protected_Declaration_Access)
2205 is
2206 pragma Unreferenced (Node);
2207 begin
2208 Self.Result := A_Single_Protected_Declaration;
2209 end Single_Protected_Declaration;
2210
2211 overriding procedure Single_Task_Declaration
2212 (Self : in out Visiter;
2213 Node : not null Gela.Elements.Single_Task_Declarations.
2214 Single_Task_Declaration_Access)
2215 is
2216 pragma Unreferenced (Node);
2217 begin
2218 Self.Result := A_Single_Task_Declaration;
2219 end Single_Task_Declaration;
2220
2221 --------------------
2222 -- String_Literal --
2223 --------------------
2224
2225 overriding procedure String_Literal
2226 (Self : in out Visiter;
2227 Node : not null Gela.Elements.String_Literals.String_Literal_Access)
2228 is
2229 pragma Unreferenced (Node);
2230 begin
2231 Self.Result := A_String_Literal;
2232 end String_Literal;
2233
2234 overriding procedure Subtype_Declaration
2235 (Self : in out Visiter;
2236 Node : not null Gela.Elements.Subtype_Declarations.
2237 Subtype_Declaration_Access)
2238 is
2239 pragma Unreferenced (Node);
2240 begin
2241 Self.Result := A_Subtype_Declaration;
2242 end Subtype_Declaration;
2243
2244 overriding procedure Subtype_Indication
2245 (Self : in out Visiter;
2246 Node : not null Gela.Elements.Subtype_Indications.
2247 Subtype_Indication_Access)
2248 is
2249 pragma Unreferenced (Node);
2250 begin
2251 Self.Result := A_Subtype_Indication;
2252 end Subtype_Indication;
2253
2254 overriding procedure Task_Body
2255 (Self : in out Visiter;
2256 Node : not null Gela.Elements.Task_Bodies.Task_Body_Access)
2257 is
2258 pragma Unreferenced (Node);
2259 begin
2260 Self.Result := A_Task_Body_Declaration;
2261 end Task_Body;
2262
2263 overriding procedure Task_Definition
2264 (Self : in out Visiter;
2265 Node : not null Gela.Elements.Task_Definitions.Task_Definition_Access)
2266 is
2267 pragma Unreferenced (Node);
2268 begin
2269 Self.Result := A_Task_Definition;
2270 end Task_Definition;
2271
2272 overriding procedure Terminate_Alternative_Statement
2273 (Self : in out Visiter;
2274 Node : not null Gela.Elements.Terminate_Alternative_Statements.
2275 Terminate_Alternative_Statement_Access)
2276 is
2277 pragma Unreferenced (Node);
2278 begin
2279 Self.Result := A_Terminate_Alternative_Statement;
2280 end Terminate_Alternative_Statement;
2281
2282 overriding procedure Unconstrained_Array_Definition
2283 (Self : in out Visiter;
2284 Node : not null Gela.Elements.Unconstrained_Array_Definitions.
2285 Unconstrained_Array_Definition_Access)
2286 is
2287 pragma Unreferenced (Node);
2288 begin
2289 Self.Result := An_Unconstrained_Array_Definition;
2290 end Unconstrained_Array_Definition;
2291
2292 ------------------------
2293 -- Use_Package_Clause --
2294 ------------------------
2295
2296 overriding procedure Use_Package_Clause
2297 (Self : in out Visiter;
2298 Node : not null Gela.Elements.Use_Package_Clauses.
2299 Use_Package_Clause_Access)
2300 is
2301 pragma Unreferenced (Node);
2302 begin
2303 Self.Result := A_Use_Package_Clause;
2304 end Use_Package_Clause;
2305
2306 overriding procedure Use_Type_Clause
2307 (Self : in out Visiter;
2308 Node : not null Gela.Elements.Use_Type_Clauses.Use_Type_Clause_Access)
2309 is
2310 pragma Unreferenced (Node);
2311 begin
2312 Self.Result := A_Use_Type_Clause;
2313 end Use_Type_Clause;
2314
2315 overriding procedure Variant
2316 (Self : in out Visiter;
2317 Node : not null Gela.Elements.Variants.Variant_Access)
2318 is
2319 pragma Unreferenced (Node);
2320 begin
2321 Self.Result := A_Variant;
2322 end Variant;
2323
2324 overriding procedure Variant_Part
2325 (Self : in out Visiter;
2326 Node : not null Gela.Elements.Variant_Parts.Variant_Part_Access)
2327 is
2328 pragma Unreferenced (Node);
2329 begin
2330 Self.Result := A_Variant_Part;
2331 end Variant_Part;
2332
2333 -----------------
2334 -- With_Clause --
2335 -----------------
2336
2337 overriding procedure With_Clause
2338 (Self : in out Visiter;
2339 Node : not null Gela.Elements.With_Clauses.With_Clause_Access)
2340 is
2341 pragma Unreferenced (Node);
2342 begin
2343 Self.Result := A_With_Clause;
2344 end With_Clause;
2345
2346end Asis.Extensions.Flat_Kinds;
Note: See TracBrowser for help on using the repository browser.