source: trunk/ada-2012/src/asis/asis-elements.adb@ 399

Last change on this file since 399 was 399, checked in by Maxim Reznik, 5 years ago

Make distinction between index and disriminant constraint

  • Property svn:keywords set to Date Revision
File size: 46.2 KB
Line 
1------------------------------------------------------------------------------
2-- G E L A A S I S --
3-- ASIS implementation for Gela project, a portable Ada compiler --
4-- http://gela.ada-ru.org --
5-- - - - - - - - - - - - - - - - --
6-- Read copyright and license at the end of this file --
7------------------------------------------------------------------------------
8-- $Revision: 399 $ $Date: 2015-02-16 11:35:11 +0000 (Mon, 16 Feb 2015) $
9-- Purpose:
10-- Procedural wrapper over Object-Oriented ASIS implementation
11
12with Ada.Containers;
13
14with Gela.Compilations;
15with Gela.Compilation_Unit_Sets;
16with Gela.Elements.Compilation_Units;
17with Gela.Element_Visiters;
18with Gela.Elements.Compilation_Unit_Bodies;
19with Gela.Elements.Compilation_Unit_Declarations;
20with Gela.Elements.Subunits;
21with Gela.Elements.Context_Items;
22with Asis.Extensions.Flat_Kinds;
23with Gela.Elements.Library_Unit_Bodies;
24with Gela.Elements.Library_Unit_Declarations;
25with Gela.Elements.Proper_Bodies;
26with Gela.Lexical_Types;
27
28package body Asis.Elements is
29
30 package F renames Asis.Extensions.Flat_Kinds;
31
32 ----------------------------
33 -- Access_Definition_Kind --
34 ----------------------------
35
36 function Access_Definition_Kind
37 (Definition : Asis.Definition)
38 return Asis.Access_Definition_Kinds
39 is
40 Map : constant array (F.An_Access_Definition)
41 of Asis.Access_Definition_Kinds :=
42 (F.An_Anonymous_Access_To_Variable =>
43 Asis.An_Anonymous_Access_To_Variable,
44 F.An_Anonymous_Access_To_Constant =>
45 Asis.An_Anonymous_Access_To_Constant,
46 F.An_Anonymous_Access_To_Procedure =>
47 Asis.An_Anonymous_Access_To_Procedure,
48 F.An_Anonymous_Access_To_Protected_Procedure =>
49 Asis.An_Anonymous_Access_To_Protected_Procedure,
50 F.An_Anonymous_Access_To_Function =>
51 Asis.An_Anonymous_Access_To_Function,
52 F.An_Anonymous_Access_To_Protected_Function =>
53 Asis.An_Anonymous_Access_To_Protected_Function);
54
55 Kind : constant Asis.Extensions.Flat_Kinds.Element_Flat_Kind :=
56 Asis.Extensions.Flat_Kinds.Flat_Kind (Definition);
57 begin
58 if Kind in Map'Range then
59 return Map (Kind);
60 else
61 return Not_An_Access_Definition;
62 end if;
63 end Access_Definition_Kind;
64
65 ----------------------
66 -- Access_Type_Kind --
67 ----------------------
68
69 function Access_Type_Kind
70 (Definition : in Asis.Access_Type_Definition)
71 return Asis.Access_Type_Kinds
72 is
73 begin
74 if Assigned (Definition) then
75 Raise_Not_Implemented ("");
76 return Not_An_Access_Type_Definition;
77 else
78 return Not_An_Access_Type_Definition;
79 end if;
80 end Access_Type_Kind;
81
82 ----------------------
83 -- Association_Kind --
84 ----------------------
85
86 function Association_Kind
87 (Association : in Asis.Association)
88 return Asis.Association_Kinds
89 is
90 Map : constant array (F.An_Association) of Asis.Association_Kinds :=
91 (F.A_Pragma_Argument_Association => Asis.A_Pragma_Argument_Association,
92 F.A_Discriminant_Association => Asis.A_Discriminant_Association,
93 F.A_Record_Component_Association =>
94 Asis.A_Record_Component_Association,
95 F.An_Array_Component_Association =>
96 Asis.An_Array_Component_Association,
97 F.A_Parameter_Association => Asis.A_Parameter_Association,
98 F.A_Generic_Association => Asis.A_Generic_Association);
99
100 Kind : constant Asis.Extensions.Flat_Kinds.Element_Flat_Kind :=
101 Asis.Extensions.Flat_Kinds.Flat_Kind (Association);
102 begin
103 if Kind in Map'Range then
104 return Map (Kind);
105 else
106 return Not_An_Association;
107 end if;
108 end Association_Kind;
109
110 --------------------
111 -- Attribute_Kind --
112 --------------------
113
114 function Attribute_Kind
115 (Expression : in Asis.Expression)
116 return Asis.Attribute_Kinds
117 is
118 begin
119 if Assigned (Expression) then
120 Raise_Not_Implemented ("");
121 return Not_An_Attribute;
122 else
123 return Not_An_Attribute;
124 end if;
125 end Attribute_Kind;
126
127 -----------------
128 -- Clause_Kind --
129 -----------------
130
131 function Clause_Kind (Clause : in Asis.Clause) return Asis.Clause_Kinds is
132 begin
133 case F.Flat_Kind (Clause) is
134 when F.A_Use_Package_Clause =>
135 return A_Use_Package_Clause;
136 when F.A_Use_Type_Clause =>
137 return A_Use_Type_Clause;
138 when F.A_With_Clause =>
139 return A_With_Clause;
140 when F.A_Representation_Clause =>
141 return A_Representation_Clause;
142 when F.A_Component_Clause =>
143 return A_Component_Clause;
144 when others =>
145 return Not_A_Clause;
146 end case;
147 end Clause_Kind;
148
149 -------------------------
150 -- Compilation_Pragmas --
151 -------------------------
152
153 function Compilation_Pragmas
154 (Compilation_Unit : in Asis.Compilation_Unit)
155 return Asis.Pragma_Element_List
156 is
157 begin
158 Check_Nil_Unit (Compilation_Unit, "Compilation_Pragmas");
159 Raise_Not_Implemented ("");
160 return Asis.Nil_Element_List;
161 end Compilation_Pragmas;
162
163 ---------------------------
164 -- Configuration_Pragmas --
165 ---------------------------
166
167 function Configuration_Pragmas
168 (The_Context : in Asis.Context)
169 return Asis.Pragma_Element_List
170 is
171 pragma Unreferenced (The_Context);
172 begin
173 -- Check_Context (The_Context);
174 Raise_Not_Implemented ("");
175 return Asis.Nil_Element_List;
176 end Configuration_Pragmas;
177
178 ---------------------
179 -- Constraint_Kind --
180 ---------------------
181
182 function Constraint_Kind
183 (Definition : in Asis.Constraint)
184 return Asis.Constraint_Kinds
185 is
186 Map : constant array (F.A_Constraint) of Asis.Constraint_Kinds :=
187 (F.A_Range_Attribute_Reference => Asis.A_Range_Attribute_Reference,
188 F.A_Simple_Expression_Range => Asis.A_Simple_Expression_Range,
189 F.A_Digits_Constraint => Asis.A_Digits_Constraint,
190 F.A_Delta_Constraint => Asis.A_Delta_Constraint,
191 F.An_Index_Constraint => Asis.An_Index_Constraint,
192 F.A_Discriminant_Constraint => Asis.A_Discriminant_Constraint);
193
194 Kind : constant Asis.Extensions.Flat_Kinds.Element_Flat_Kind :=
195 Asis.Extensions.Flat_Kinds.Flat_Kind (Definition);
196 begin
197 if Kind in Map'Range then
198 return Map (Kind);
199 else
200 return Not_A_Constraint;
201 end if;
202 end Constraint_Kind;
203
204 -----------------------------
205 -- Context_Clause_Elements --
206 -----------------------------
207
208 function Context_Clause_Elements
209 (Compilation_Unit : in Asis.Compilation_Unit;
210 Include_Pragmas : in Boolean := False)
211 return Asis.Context_Clause_List
212 is
213 pragma Unreferenced (Include_Pragmas);
214
215 package Get is
216
217 type Visiter is new Gela.Element_Visiters.Visiter with record
218 Result : Gela.Elements.Context_Items.Context_Item_Sequence_Access;
219 end record;
220
221 overriding procedure Compilation_Unit_Body
222 (Self : in out Visiter;
223 Node : not null Gela.Elements.Compilation_Unit_Bodies.
224 Compilation_Unit_Body_Access);
225
226 overriding procedure Compilation_Unit_Declaration
227 (Self : in out Visiter;
228 Node : not null Gela.Elements.Compilation_Unit_Declarations.
229 Compilation_Unit_Declaration_Access);
230
231 overriding procedure Subunit
232 (Self : in out Visiter;
233 Node : not null Gela.Elements.Subunits.Subunit_Access);
234
235 end Get;
236
237 package body Get is
238
239 overriding procedure Compilation_Unit_Body
240 (Self : in out Visiter;
241 Node : not null Gela.Elements.Compilation_Unit_Bodies.
242 Compilation_Unit_Body_Access) is
243 begin
244 Self.Result := Node.Context_Clause_Elements;
245 end Compilation_Unit_Body;
246
247 overriding procedure Compilation_Unit_Declaration
248 (Self : in out Visiter;
249 Node : not null Gela.Elements.Compilation_Unit_Declarations.
250 Compilation_Unit_Declaration_Access) is
251 begin
252 Self.Result := Node.Context_Clause_Elements;
253 end Compilation_Unit_Declaration;
254
255 overriding procedure Subunit
256 (Self : in out Visiter;
257 Node : not null Gela.Elements.Subunits.Subunit_Access) is
258 begin
259 Self.Result := Node.Context_Clause_Elements;
260 end Subunit;
261
262 end Get;
263
264 Tree : Gela.Elements.Compilation_Units.Compilation_Unit_Access;
265 V : aliased Get.Visiter;
266 begin
267 Check_Nil_Unit (Compilation_Unit, "Context_Clause_Elements");
268 Tree := Compilation_Unit.Data.Tree;
269 Tree.Visit (V);
270
271 declare
272 Result : Asis.Element_List (1 .. Asis.ASIS_Natural (V.Result.Length));
273 C : Gela.Elements.Context_Items.Context_Item_Sequence_Cursor :=
274 V.Result.First;
275 begin
276 for J in Result'Range loop
277 Result (J) := (Data => Gela.Elements.Element_Access (C.Element));
278 C.Next;
279 end loop;
280
281 return Result;
282 end;
283 end Context_Clause_Elements;
284
285 ---------------------------
286 -- Corresponding_Pragmas --
287 ---------------------------
288
289 function Corresponding_Pragmas
290 (Element : in Asis.Element)
291 return Asis.Pragma_Element_List
292 is
293 begin
294 Check_Nil_Element (Element, "Corresponding_Pragmas");
295 Raise_Not_Implemented ("");
296 return Asis.Nil_Element_List;
297 end Corresponding_Pragmas;
298
299 -----------------
300 -- Debug_Image --
301 -----------------
302
303 function Debug_Image (Element : in Asis.Element) return Wide_String is
304 pragma Unreferenced (Element);
305 begin
306 return "";
307 end Debug_Image;
308
309 ----------------------
310 -- Declaration_Kind --
311 ----------------------
312
313 function Declaration_Kind
314 (Declaration : in Asis.Declaration)
315 return Asis.Declaration_Kinds
316 is
317 Map : constant array (F.A_Declaration) of Asis.Declaration_Kinds :=
318 (F.An_Ordinary_Type_Declaration => Asis.An_Ordinary_Type_Declaration,
319 F.A_Task_Type_Declaration => Asis.A_Task_Type_Declaration,
320 F.A_Protected_Type_Declaration => Asis.A_Protected_Type_Declaration,
321 F.An_Incomplete_Type_Declaration =>
322 Asis.An_Incomplete_Type_Declaration,
323 F.A_Private_Type_Declaration => Asis.A_Private_Type_Declaration,
324 F.A_Private_Extension_Declaration =>
325 Asis.A_Private_Extension_Declaration,
326 F.A_Subtype_Declaration => Asis.A_Subtype_Declaration,
327 F.A_Variable_Declaration => Asis.A_Variable_Declaration,
328 F.A_Constant_Declaration => Asis.A_Constant_Declaration,
329 F.A_Deferred_Constant_Declaration =>
330 Asis.A_Deferred_Constant_Declaration,
331 F.A_Single_Task_Declaration => Asis.A_Single_Task_Declaration,
332 F.A_Single_Protected_Declaration =>
333 Asis.A_Single_Protected_Declaration,
334 F.An_Integer_Number_Declaration => Asis.An_Integer_Number_Declaration,
335 F.A_Real_Number_Declaration => Asis.A_Real_Number_Declaration,
336 F.An_Enumeration_Literal_Specification =>
337 Asis.An_Enumeration_Literal_Specification,
338 F.A_Discriminant_Specification => Asis.A_Discriminant_Specification,
339 F.A_Component_Declaration => Asis.A_Component_Declaration,
340 F.A_Return_Object_Specification => Asis.A_Return_Object_Specification,
341 F.A_Loop_Parameter_Specification =>
342 Asis.A_Loop_Parameter_Specification,
343 F.A_Procedure_Declaration => Asis.A_Procedure_Declaration,
344 F.A_Function_Declaration => Asis.A_Function_Declaration,
345 F.A_Parameter_Specification => Asis.A_Parameter_Specification,
346 F.A_Procedure_Body_Declaration => Asis.A_Procedure_Body_Declaration,
347 F.A_Function_Body_Declaration => Asis.A_Function_Body_Declaration,
348 F.A_Package_Declaration => Asis.A_Package_Declaration,
349 F.A_Package_Body_Declaration => Asis.A_Package_Body_Declaration,
350 F.An_Object_Renaming_Declaration =>
351 Asis.An_Object_Renaming_Declaration,
352 F.An_Exception_Renaming_Declaration =>
353 Asis.An_Exception_Renaming_Declaration,
354 F.A_Package_Renaming_Declaration =>
355 Asis.A_Package_Renaming_Declaration,
356 F.A_Procedure_Renaming_Declaration =>
357 Asis.A_Procedure_Renaming_Declaration,
358 F.A_Function_Renaming_Declaration =>
359 Asis.A_Function_Renaming_Declaration,
360 F.A_Generic_Package_Renaming_Declaration =>
361 Asis.A_Generic_Package_Renaming_Declaration,
362 F.A_Generic_Procedure_Renaming_Declaration =>
363 Asis.A_Generic_Procedure_Renaming_Declaration,
364 F.A_Generic_Function_Renaming_Declaration =>
365 Asis.A_Generic_Function_Renaming_Declaration,
366 F.A_Task_Body_Declaration => Asis.A_Task_Body_Declaration,
367 F.A_Protected_Body_Declaration => Asis.A_Protected_Body_Declaration,
368 F.An_Entry_Declaration => Asis.An_Entry_Declaration,
369 F.An_Entry_Body_Declaration => Asis.An_Entry_Body_Declaration,
370 F.An_Entry_Index_Specification => Asis.An_Entry_Index_Specification,
371 F.A_Procedure_Body_Stub => Asis.A_Procedure_Body_Stub,
372 F.A_Function_Body_Stub => Asis.A_Function_Body_Stub,
373 F.A_Package_Body_Stub => Asis.A_Package_Body_Stub,
374 F.A_Task_Body_Stub => Asis.A_Task_Body_Stub,
375 F.A_Protected_Body_Stub => Asis.A_Protected_Body_Stub,
376 F.An_Exception_Declaration => Asis.An_Exception_Declaration,
377 F.A_Choice_Parameter_Specification =>
378 Asis.A_Choice_Parameter_Specification,
379 F.A_Generic_Procedure_Declaration =>
380 Asis.A_Generic_Procedure_Declaration,
381 F.A_Generic_Function_Declaration =>
382 Asis.A_Generic_Function_Declaration,
383 F.A_Generic_Package_Declaration => Asis.A_Generic_Package_Declaration,
384 F.A_Package_Instantiation => Asis.A_Package_Instantiation,
385 F.A_Procedure_Instantiation => Asis.A_Procedure_Instantiation,
386 F.A_Function_Instantiation => Asis.A_Function_Instantiation,
387 F.A_Formal_Object_Declaration => Asis.A_Formal_Object_Declaration,
388 F.A_Formal_Type_Declaration => Asis.A_Formal_Type_Declaration,
389 F.A_Formal_Procedure_Declaration =>
390 Asis.A_Formal_Procedure_Declaration,
391 F.A_Formal_Function_Declaration => Asis.A_Formal_Function_Declaration,
392 F.A_Formal_Package_Declaration => Asis.A_Formal_Package_Declaration,
393 F.A_Formal_Package_Declaration_With_Box =>
394 Asis.A_Formal_Package_Declaration_With_Box);
395
396 Kind : constant Asis.Extensions.Flat_Kinds.Element_Flat_Kind :=
397 Asis.Extensions.Flat_Kinds.Flat_Kind (Declaration);
398 begin
399 if Kind in Map'Range then
400 return Map (Kind);
401 else
402 return Not_A_Declaration;
403 end if;
404 end Declaration_Kind;
405
406 ------------------------
407 -- Declaration_Origin --
408 ------------------------
409
410 function Declaration_Origin
411 (Declaration : in Asis.Declaration)
412 return Asis.Declaration_Origins
413 is
414 begin
415 if Assigned (Declaration) then
416 Raise_Not_Implemented ("");
417 return Not_A_Declaration_Origin;
418 else
419 return Not_A_Declaration_Origin;
420 end if;
421 end Declaration_Origin;
422
423 ------------------
424 -- Default_Kind --
425 ------------------
426
427 function Default_Kind
428 (Declaration : in Asis.Generic_Formal_Parameter)
429 return Asis.Subprogram_Default_Kinds
430 is
431 begin
432 if Assigned (Declaration) then
433 Raise_Not_Implemented ("");
434 return Not_A_Default;
435 else
436 return Not_A_Default;
437 end if;
438 end Default_Kind;
439
440 ------------------------
441 -- Defining_Name_Kind --
442 ------------------------
443
444 function Defining_Name_Kind
445 (Defining_Name : in Asis.Defining_Name)
446 return Asis.Defining_Name_Kinds
447 is
448 begin
449 case F.Flat_Kind (Defining_Name) is
450 when F.A_Defining_Identifier =>
451 return Asis.A_Defining_Identifier;
452 when F.A_Defining_Character_Literal =>
453 return Asis.A_Defining_Character_Literal;
454 when F.A_Defining_Enumeration_Literal =>
455 return Asis.A_Defining_Enumeration_Literal;
456 when F.A_Defining_Operator_Symbol =>
457 return Asis.A_Defining_Operator_Symbol;
458 when F.A_Defining_Expanded_Name =>
459 return Asis.A_Defining_Expanded_Name;
460 when others =>
461 return Not_A_Defining_Name;
462 end case;
463 end Defining_Name_Kind;
464
465 ---------------------
466 -- Definition_Kind --
467 ---------------------
468
469 function Definition_Kind
470 (Definition : in Asis.Definition)
471 return Asis.Definition_Kinds
472 is
473 begin
474 case F.Flat_Kind (Definition) is
475 when F.A_Type_Definition =>
476 return Asis.A_Type_Definition;
477 when F.A_Subtype_Indication =>
478 return Asis.A_Subtype_Indication;
479 when F.A_Constraint =>
480 return Asis.A_Constraint;
481 when F.A_Component_Definition =>
482 return Asis.A_Component_Definition;
483 when F.A_Discrete_Subtype_Definition =>
484 return Asis.A_Discrete_Subtype_Definition;
485 when F.A_Discrete_Range =>
486 return Asis.A_Discrete_Range;
487 when F.An_Unknown_Discriminant_Part =>
488 return Asis.An_Unknown_Discriminant_Part;
489 when F.A_Known_Discriminant_Part =>
490 return Asis.A_Known_Discriminant_Part;
491 when F.A_Record_Definition =>
492 return Asis.A_Record_Definition;
493 when F.A_Null_Record_Definition =>
494 return Asis.A_Null_Record_Definition;
495 when F.A_Null_Component =>
496 return Asis.A_Null_Component;
497 when F.A_Variant_Part =>
498 return Asis.A_Variant_Part;
499 when F.A_Variant =>
500 return Asis.A_Variant;
501 when F.An_Others_Choice =>
502 return Asis.An_Others_Choice;
503 when F.An_Access_Definition =>
504 return Asis.An_Access_Definition;
505 when F.An_Incomplete_Type_Definition =>
506 return Asis.An_Incomplete_Type_Definition;
507 when F.A_Tagged_Incomplete_Type_Definition =>
508 return Asis.A_Tagged_Incomplete_Type_Definition;
509 when F.A_Private_Type_Definition =>
510 return Asis.A_Private_Type_Definition;
511 when F.A_Tagged_Private_Type_Definition =>
512 return Asis.A_Tagged_Private_Type_Definition;
513 when F.A_Private_Extension_Definition =>
514 return Asis.A_Private_Extension_Definition;
515 when F.A_Task_Definition =>
516 return Asis.A_Task_Definition;
517 when F.A_Protected_Definition =>
518 return Asis.A_Protected_Definition;
519 when F.A_Formal_Type_Definition =>
520 return Asis.A_Formal_Type_Definition;
521 when others =>
522 return Asis.Not_A_Definition;
523 end case;
524 end Definition_Kind;
525
526 -------------------------
527 -- Discrete_Range_Kind --
528 -------------------------
529
530 function Discrete_Range_Kind
531 (Definition : in Asis.Discrete_Range)
532 return Asis.Discrete_Range_Kinds
533 is
534 Map : constant array (F.A_Discrete_Range) of Asis.Discrete_Range_Kinds
535 := (F.A_Discrete_Subtype_Indication_DR =>
536 A_Discrete_Subtype_Indication,
537 F.A_Discrete_Range_Attribute_Reference_DR =>
538 A_Discrete_Range_Attribute_Reference,
539 F.A_Discrete_Simple_Expression_Range_DR =>
540 A_Discrete_Simple_Expression_Range);
541
542 Kind : constant Asis.Extensions.Flat_Kinds.Element_Flat_Kind :=
543 Asis.Extensions.Flat_Kinds.Flat_Kind (Definition);
544 begin
545 if Kind in Map'Range then
546 return Map (Kind);
547 else
548 return Not_A_Discrete_Range;
549 end if;
550 end Discrete_Range_Kind;
551
552 ------------------
553 -- Element_Kind --
554 ------------------
555
556 function Element_Kind
557 (Element : in Asis.Element) return Asis.Element_Kinds is
558 begin
559 case F.Flat_Kind (Element) is
560 when F.A_Pragma =>
561 return A_Pragma;
562 when F.A_Defining_Name =>
563 return A_Defining_Name;
564 when F.A_Declaration =>
565 return A_Declaration;
566 when F.A_Definition =>
567 return A_Definition;
568 when F.An_Expression =>
569 return An_Expression;
570 when F.An_Association =>
571 return An_Association;
572 when F.A_Statement =>
573 return A_Statement;
574 when F.A_Path =>
575 return A_Path;
576 when F.A_Clause =>
577 return A_Clause;
578 when F.An_Exception_Handler =>
579 return An_Exception_Handler;
580 when others =>
581 return Not_An_Element;
582 end case;
583 end Element_Kind;
584
585 --------------------------------
586 -- Enclosing_Compilation_Unit --
587 --------------------------------
588
589 function Enclosing_Compilation_Unit
590 (Element : in Asis.Element)
591 return Asis.Compilation_Unit
592 is
593 use type Gela.Compilation_Units.Compilation_Unit_Access;
594
595 procedure Find
596 (List : Gela.Compilation_Unit_Sets.Compilation_Unit_Set_Access;
597 Unit : out Gela.Compilation_Units.Compilation_Unit_Access);
598
599 Comp : Gela.Compilations.Compilation_Access;
600 From : Gela.Lexical_Types.Token_Count;
601 To : Gela.Lexical_Types.Token_Count;
602
603 ----------
604 -- Find --
605 ----------
606
607 procedure Find
608 (List : Gela.Compilation_Unit_Sets.Compilation_Unit_Set_Access;
609 Unit : out Gela.Compilation_Units.Compilation_Unit_Access)
610 is
611 use Gela.Compilations;
612 use type Gela.Lexical_Types.Token_Count;
613 Tree : Gela.Elements.Compilation_Units.Compilation_Unit_Access;
614 Cursor : Gela.Compilation_Unit_Sets.Compilation_Unit_Cursor'Class :=
615 List.First;
616 begin
617 while Cursor.Has_Element loop
618 Unit := Cursor.Element;
619 Tree := Unit.Tree;
620
621 if Unit.Compilation = Comp
622 and then Tree.First_Token <= From
623 and then Tree.Last_Token >= To
624 then
625 return;
626 end if;
627
628 Cursor.Next;
629 end loop;
630
631 Unit := null;
632 end Find;
633
634 Context : Gela.Contexts.Context_Access;
635 Unit : Gela.Compilation_Units.Compilation_Unit_Access;
636
637 begin
638 Check_Nil_Element (Element, "Enclosing_Compilation_Unit");
639 Comp := Element.Data.Enclosing_Compilation;
640 Context := Comp.Context;
641 From := Element.Data.First_Token;
642 To := Element.Data.Last_Token;
643 Find (Context.Library_Unit_Declarations, Unit);
644
645 if Unit = null then
646 Find (Context.Compilation_Unit_Bodies, Unit);
647 end if;
648
649 -- Raise_Not_Implemented ("");
650 return (Data => Unit);
651 end Enclosing_Compilation_Unit;
652
653 -----------------------
654 -- Enclosing_Element --
655 -----------------------
656
657 function Enclosing_Element
658 (Element : in Asis.Element)
659 return Asis.Element
660 is
661 Next : Asis.Element := Element;
662 begin
663 Check_Nil_Element (Element, "Enclosing_Element");
664 loop
665 Next := (Data => Next.Data.Enclosing_Element);
666
667 if not Assigned (Next) or else not Auxilary (Next) then
668 return Next;
669 end if;
670 end loop;
671 end Enclosing_Element;
672
673 -----------------------
674 -- Enclosing_Element --
675 -----------------------
676
677 function Enclosing_Element
678 (Element : in Asis.Element;
679 Expected_Enclosing_Element : in Asis.Element)
680 return Asis.Element
681 is
682 pragma Unreferenced (Expected_Enclosing_Element);
683 begin
684 return Enclosing_Element (Element);
685 end Enclosing_Element;
686
687 ---------------------
688 -- Expression_Kind --
689 ---------------------
690
691 function Expression_Kind
692 (Expression : in Asis.Expression) return Asis.Expression_Kinds is
693 begin
694 case F.Flat_Kind (Expression) is
695 when F.A_Box_Expression =>
696 return Asis.A_Box_Expression;
697 when F.An_Integer_Literal =>
698 return Asis.An_Integer_Literal;
699 when F.A_Real_Literal =>
700 return Asis.A_Real_Literal;
701 when F.A_String_Literal =>
702 return Asis.A_String_Literal;
703 when F.An_Identifier =>
704 return Asis.An_Identifier;
705 when F.An_Operator_Symbol =>
706 return Asis.An_Operator_Symbol;
707 when F.A_Character_Literal =>
708 return Asis.A_Character_Literal;
709 when F.An_Enumeration_Literal =>
710 return Asis.An_Enumeration_Literal;
711 when F.An_Explicit_Dereference =>
712 return Asis.An_Explicit_Dereference;
713 when F.A_Function_Call =>
714 return Asis.A_Function_Call;
715 when F.An_Indexed_Component =>
716 return Asis.An_Indexed_Component;
717 when F.A_Slice =>
718 return Asis.A_Slice;
719 when F.A_Selected_Component =>
720 return Asis.A_Selected_Component;
721 when F.An_Attribute_Reference =>
722 return Asis.An_Attribute_Reference;
723 when F.A_Record_Aggregate =>
724 return Asis.A_Record_Aggregate;
725 when F.An_Extension_Aggregate =>
726 return Asis.An_Extension_Aggregate;
727 when F.A_Positional_Array_Aggregate =>
728 return Asis.A_Positional_Array_Aggregate;
729 when F.A_Named_Array_Aggregate =>
730 return Asis.A_Named_Array_Aggregate;
731 when F.An_And_Then_Short_Circuit =>
732 return Asis.An_And_Then_Short_Circuit;
733 when F.An_Or_Else_Short_Circuit =>
734 return Asis.An_Or_Else_Short_Circuit;
735 when F.An_In_Range_Membership_Test =>
736 return Asis.An_In_Range_Membership_Test;
737 when F.A_Not_In_Range_Membership_Test =>
738 return Asis.A_Not_In_Range_Membership_Test;
739 when F.An_In_Type_Membership_Test =>
740 return Asis.An_In_Type_Membership_Test;
741 when F.A_Not_In_Type_Membership_Test =>
742 return Asis.A_Not_In_Type_Membership_Test;
743 when F.A_Null_Literal =>
744 return Asis.A_Null_Literal;
745 when F.A_Parenthesized_Expression =>
746 return Asis.A_Parenthesized_Expression;
747 when F.A_Type_Conversion =>
748 return Asis.A_Type_Conversion;
749 when F.A_Qualified_Expression =>
750 return Asis.A_Qualified_Expression;
751 when F.An_Allocation_From_Subtype =>
752 return Asis.An_Allocation_From_Subtype;
753 when F.An_Allocation_From_Qualified_Expression =>
754 return Asis.An_Allocation_From_Qualified_Expression;
755 when others =>
756 return Not_An_Expression;
757 end case;
758 end Expression_Kind;
759
760 ----------------------
761 -- Formal_Type_Kind --
762 ----------------------
763
764 function Formal_Type_Kind
765 (Definition : in Asis.Formal_Type_Definition)
766 return Asis.Formal_Type_Kinds
767 is
768 begin
769 if Assigned (Definition) then
770 Raise_Not_Implemented ("");
771 return Not_A_Formal_Type_Definition;
772 else
773 return Not_A_Formal_Type_Definition;
774 end if;
775 end Formal_Type_Kind;
776
777 -----------------
778 -- Has_Limited --
779 -----------------
780
781 function Has_Limited (Element : in Asis.Element) return Boolean is
782 begin
783 if Assigned (Element) then
784 Raise_Not_Implemented ("");
785 return False;
786 else
787 return False;
788 end if;
789 end Has_Limited;
790
791 -----------------
792 -- Has_Private --
793 -----------------
794
795 function Has_Private (Element : in Asis.Element) return Boolean is
796 begin
797 if Assigned (Element) then
798 Raise_Not_Implemented ("");
799 return False;
800 else
801 return False;
802 end if;
803 end Has_Private;
804
805 ------------------
806 -- Has_Abstract --
807 ------------------
808
809 function Has_Abstract (Element : in Asis.Element) return Boolean is
810 begin
811 if Assigned (Element) then
812 Raise_Not_Implemented ("");
813 return False;
814 else
815 return False;
816 end if;
817 end Has_Abstract;
818
819 -----------------
820 -- Has_Reverse --
821 -----------------
822
823 function Has_Reverse (Element : in Asis.Element) return Boolean is
824 begin
825 return Trait_Kind (Element) = A_Reverse_Trait;
826 end Has_Reverse;
827
828 -----------------
829 -- Has_Aliased --
830 -----------------
831
832 function Has_Aliased (Element : in Asis.Element) return Boolean is
833 begin
834 return Trait_Kind (Element) = An_Aliased_Trait;
835 end Has_Aliased;
836
837 ----------------------
838 -- Has_Synchronized --
839 ----------------------
840
841 function Has_Synchronized (Element : in Asis.Element) return Boolean is
842 begin
843 if Assigned (Element) then
844 Raise_Not_Implemented ("");
845 return False;
846 else
847 return False;
848 end if;
849 end Has_Synchronized;
850
851 -------------------
852 -- Has_Protected --
853 -------------------
854
855 function Has_Protected (Element : in Asis.Element) return Boolean is
856 begin
857 if Assigned (Element) then
858 Raise_Not_Implemented ("");
859 return False;
860 else
861 return False;
862 end if;
863 end Has_Protected;
864
865 ----------------
866 -- Has_Tagged --
867 ----------------
868
869 function Has_Tagged (Element : in Asis.Element) return Boolean is
870 begin
871 if Assigned (Element) then
872 Raise_Not_Implemented ("");
873 return False;
874 else
875 return False;
876 end if;
877 end Has_Tagged;
878
879 --------------
880 -- Has_Task --
881 --------------
882
883 function Has_Task (Element : in Asis.Element) return Boolean is
884 begin
885 if Assigned (Element) then
886 Raise_Not_Implemented ("");
887 return False;
888 else
889 return False;
890 end if;
891 end Has_Task;
892
893 ------------------------
894 -- Has_Null_Exclusion --
895 ------------------------
896
897 function Has_Null_Exclusion (Element : Asis.Element) return Boolean is
898 begin
899 if Assigned (Element) then
900 Raise_Not_Implemented ("");
901 return False;
902 else
903 return False;
904 end if;
905 end Has_Null_Exclusion;
906
907 ----------
908 -- Hash --
909 ----------
910
911 function Hash (Element : in Asis.Element) return Asis.ASIS_Integer is
912 use type Ada.Containers.Hash_Type;
913
914 X : Ada.Containers.Hash_Type;
915 begin
916 if Assigned (Element) then
917 X := Element.Data.Hash;
918 X := X and Ada.Containers.Hash_Type (ASIS_Integer'Last);
919 return ASIS_Integer (X);
920 else
921 return 0;
922 end if;
923 end Hash;
924
925 --------------------
926 -- Interface_Kind --
927 --------------------
928
929 function Interface_Kind
930 (Definition : Asis.Definition)
931 return Asis.Interface_Kinds is
932 begin
933 if Assigned (Definition) then
934 if Type_Kind (Definition) = An_Interface_Type_Definition or
935 Formal_Type_Kind (Definition) =
936 A_Formal_Interface_Type_Definition
937 then
938 if Has_Task (Definition) then
939 return A_Task_Interface;
940 elsif Has_Limited (Definition) then
941 return A_Limited_Interface;
942 elsif Has_Protected (Definition) then
943 return A_Protected_Interface;
944 elsif Has_Synchronized (Definition) then
945 return A_Synchronized_Interface;
946 else
947 return An_Ordinary_Interface;
948 end if;
949 end if;
950 end if;
951
952 return Not_An_Interface;
953 end Interface_Kind;
954
955 ----------------------------
956 -- Is_Abstract_Subprogram --
957 ----------------------------
958
959 function Is_Abstract_Subprogram
960 (Element : in Asis.Element)
961 return Boolean
962 is
963 begin
964 case Declaration_Kind (Element) is
965 when A_Procedure_Declaration |
966 A_Function_Declaration |
967 A_Formal_Procedure_Declaration |
968 A_Formal_Function_Declaration =>
969 return Has_Abstract (Element);
970 when others =>
971 return False;
972 end case;
973 end Is_Abstract_Subprogram;
974
975 --------------
976 -- Is_Equal --
977 --------------
978
979 function Is_Equal
980 (Left : in Asis.Element;
981 Right : in Asis.Element)
982 return Boolean
983 is
984 pragma Unreferenced (Left);
985 pragma Unreferenced (Right);
986 begin
987 Raise_Not_Implemented ("");
988 return False;
989 end Is_Equal;
990
991 ------------------
992 -- Is_Identical --
993 ------------------
994
995 function Is_Identical
996 (Left : in Asis.Element;
997 Right : in Asis.Element)
998 return Boolean
999 is
1000 use type Gela.Elements.Element_Access;
1001 begin
1002 return Left.Data = Right.Data;
1003 end Is_Identical;
1004
1005 ------------
1006 -- Is_Nil --
1007 ------------
1008
1009 function Is_Nil (Right : in Asis.Element) return Boolean is
1010 begin
1011 return not Assigned (Right);
1012 end Is_Nil;
1013
1014 ------------
1015 -- Is_Nil --
1016 ------------
1017
1018 function Is_Nil (Right : in Asis.Element_List) return Boolean is
1019 begin
1020 return Right'Length = 0;
1021 end Is_Nil;
1022
1023 -----------------------
1024 -- Is_Null_Procedure --
1025 -----------------------
1026
1027 function Is_Null_Procedure (Element : in Asis.Element) return Boolean is
1028 begin
1029 if Assigned (Element) then
1030 Raise_Not_Implemented ("");
1031 return False;
1032 else
1033 return False;
1034 end if;
1035 end Is_Null_Procedure;
1036
1037 -------------------------
1038 -- Is_Part_Of_Implicit --
1039 -------------------------
1040
1041 function Is_Part_Of_Implicit (Element : in Asis.Element) return Boolean is
1042 begin
1043 if Assigned (Element) then
1044 return Element.Data.Is_Part_Of_Implicit;
1045 else
1046 return False;
1047 end if;
1048 end Is_Part_Of_Implicit;
1049
1050 --------------------------
1051 -- Is_Part_Of_Inherited --
1052 --------------------------
1053
1054 function Is_Part_Of_Inherited
1055 (Element : in Asis.Element)
1056 return Boolean
1057 is
1058 begin
1059 if Assigned (Element) then
1060 return Element.Data.Is_Part_Of_Inherited;
1061 else
1062 return False;
1063 end if;
1064 end Is_Part_Of_Inherited;
1065
1066 -------------------------
1067 -- Is_Part_Of_Instance --
1068 -------------------------
1069
1070 function Is_Part_Of_Instance (Element : in Asis.Element) return Boolean is
1071 begin
1072 if Assigned (Element) then
1073 return Element.Data.Is_Part_Of_Instance;
1074 else
1075 return False;
1076 end if;
1077 end Is_Part_Of_Instance;
1078
1079 ---------------
1080 -- Mode_Kind --
1081 ---------------
1082
1083 function Mode_Kind
1084 (Declaration : in Asis.Declaration)
1085 return Asis.Mode_Kinds
1086 is
1087 begin
1088 if Assigned (Declaration) then
1089 Raise_Not_Implemented ("");
1090 return Not_A_Mode;
1091 else
1092 return Not_A_Mode;
1093 end if;
1094 end Mode_Kind;
1095
1096 -------------------
1097 -- Operator_Kind --
1098 -------------------
1099
1100 function Operator_Kind
1101 (Element : in Asis.Element)
1102 return Asis.Operator_Kinds
1103 is
1104 begin
1105 if Assigned (Element) then
1106 Raise_Not_Implemented ("");
1107 return Not_An_Operator;
1108 else
1109 return Not_An_Operator;
1110 end if;
1111 end Operator_Kind;
1112
1113 ---------------
1114 -- Path_Kind --
1115 ---------------
1116
1117 function Path_Kind (Path : in Asis.Path) return Asis.Path_Kinds is
1118 Map : constant array (F.A_Path) of Asis.Path_Kinds
1119 := (F.An_If_Path => Asis.An_If_Path,
1120 F.An_Elsif_Path => Asis.An_Elsif_Path,
1121 F.An_Else_Path => Asis.An_Else_Path,
1122 F.A_Case_Path => Asis.A_Case_Path,
1123 F.A_Select_Path => Asis.A_Select_Path,
1124 F.An_Or_Path => Asis.An_Or_Path,
1125 F.A_Then_Abort_Path => Asis.A_Then_Abort_Path);
1126
1127 Kind : constant Asis.Extensions.Flat_Kinds.Element_Flat_Kind :=
1128 Asis.Extensions.Flat_Kinds.Flat_Kind (Path);
1129 begin
1130 if Kind in Map'Range then
1131 return Map (Kind);
1132 else
1133 return Not_A_Path;
1134 end if;
1135 end Path_Kind;
1136
1137 ----------------------------------
1138 -- Pragma_Argument_Associations --
1139 ----------------------------------
1140
1141 function Pragma_Argument_Associations
1142 (Pragma_Element : in Asis.Pragma_Element)
1143 return Asis.Association_List
1144 is
1145 begin
1146 Check_Nil_Element (Pragma_Element, "Pragma_Argument_Associations");
1147 Raise_Not_Implemented ("");
1148 return Asis.Nil_Element_List;
1149 end Pragma_Argument_Associations;
1150
1151 -----------------
1152 -- Pragma_Kind --
1153 -----------------
1154
1155 function Pragma_Kind
1156 (Pragma_Element : in Asis.Pragma_Element)
1157 return Asis.Pragma_Kinds
1158 is
1159 begin
1160 if Assigned (Pragma_Element) then
1161 return Not_A_Pragma;
1162 else
1163 return Not_A_Pragma;
1164 end if;
1165 end Pragma_Kind;
1166
1167 -----------------------
1168 -- Pragma_Name_Image --
1169 -----------------------
1170
1171 function Pragma_Name_Image
1172 (Pragma_Element : in Asis.Pragma_Element)
1173 return Program_Text
1174 is
1175 begin
1176 Check_Nil_Element (Pragma_Element, "Pragma_Name_Image");
1177 Raise_Not_Implemented ("");
1178 return "";
1179 end Pragma_Name_Image;
1180
1181 -------------
1182 -- Pragmas --
1183 -------------
1184
1185 function Pragmas
1186 (The_Element : in Asis.Element)
1187 return Asis.Pragma_Element_List
1188 is
1189 begin
1190 Check_Nil_Element (The_Element, "Pragmas");
1191 Raise_Not_Implemented ("");
1192 return Asis.Nil_Element_List;
1193 end Pragmas;
1194
1195 --------------------------------
1196 -- Representation_Clause_Kind --
1197 --------------------------------
1198
1199 function Representation_Clause_Kind
1200 (Clause : in Asis.Representation_Clause)
1201 return Asis.Representation_Clause_Kinds
1202 is
1203 begin
1204 if Assigned (Clause) then
1205 Raise_Not_Implemented ("");
1206 return Not_A_Representation_Clause;
1207 else
1208 return Not_A_Representation_Clause;
1209 end if;
1210 end Representation_Clause_Kind;
1211
1212 --------------------
1213 -- Root_Type_Kind --
1214 --------------------
1215
1216 function Root_Type_Kind
1217 (Definition : in Asis.Root_Type_Definition)
1218 return Asis.Root_Type_Kinds
1219 is
1220 begin
1221 if Assigned (Definition) then
1222 Raise_Not_Implemented ("");
1223 return Not_A_Root_Type_Definition;
1224 else
1225 return Not_A_Root_Type_Definition;
1226 end if;
1227 end Root_Type_Kind;
1228
1229 --------------------
1230 -- Statement_Kind --
1231 --------------------
1232
1233 function Statement_Kind
1234 (Statement : in Asis.Statement)
1235 return Asis.Statement_Kinds
1236 is
1237 Map : constant array (F.A_Statement) of Asis.Statement_Kinds :=
1238 (F.A_Null_Statement => Asis.A_Null_Statement,
1239 F.An_Assignment_Statement => Asis.An_Assignment_Statement,
1240 F.An_If_Statement => Asis.An_If_Statement,
1241 F.A_Case_Statement => Asis.A_Case_Statement,
1242 F.A_Loop_Statement => Asis.A_Loop_Statement,
1243 F.A_While_Loop_Statement => Asis.A_While_Loop_Statement,
1244 F.A_For_Loop_Statement => Asis.A_For_Loop_Statement,
1245 F.A_Block_Statement => Asis.A_Block_Statement,
1246 F.An_Exit_Statement => Asis.An_Exit_Statement,
1247 F.A_Goto_Statement => Asis.A_Goto_Statement,
1248 F.A_Procedure_Call_Statement => Asis.A_Procedure_Call_Statement,
1249 F.A_Simple_Return_Statement => Asis.A_Simple_Return_Statement,
1250 F.An_Extended_Return_Statement => Asis.An_Extended_Return_Statement,
1251 F.An_Accept_Statement => Asis.An_Accept_Statement,
1252 F.An_Entry_Call_Statement => Asis.An_Entry_Call_Statement,
1253 F.A_Requeue_Statement => Asis.A_Requeue_Statement,
1254 F.A_Requeue_Statement_With_Abort =>
1255 Asis.A_Requeue_Statement_With_Abort,
1256 F.A_Delay_Until_Statement => Asis.A_Delay_Until_Statement,
1257 F.A_Delay_Relative_Statement => Asis.A_Delay_Relative_Statement,
1258 F.A_Terminate_Alternative_Statement =>
1259 Asis.A_Terminate_Alternative_Statement,
1260 F.A_Selective_Accept_Statement => Asis.A_Selective_Accept_Statement,
1261 F.A_Timed_Entry_Call_Statement => Asis.A_Timed_Entry_Call_Statement,
1262 F.A_Conditional_Entry_Call_Statement =>
1263 Asis.A_Conditional_Entry_Call_Statement,
1264 F.An_Asynchronous_Select_Statement =>
1265 Asis.An_Asynchronous_Select_Statement,
1266 F.An_Abort_Statement => Asis.An_Abort_Statement,
1267 F.A_Raise_Statement => Asis.A_Raise_Statement,
1268 F.A_Code_Statement => Asis.A_Code_Statement);
1269
1270 Kind : constant Asis.Extensions.Flat_Kinds.Element_Flat_Kind :=
1271 Asis.Extensions.Flat_Kinds.Flat_Kind (Statement);
1272 begin
1273 if Kind in Map'Range then
1274 return Map (Kind);
1275 else
1276 return Not_A_Statement;
1277 end if;
1278 end Statement_Kind;
1279
1280 ----------------
1281 -- Trait_Kind --
1282 ----------------
1283
1284 function Trait_Kind
1285 (Element : in Asis.Element)
1286 return Asis.Trait_Kinds
1287 is
1288 begin
1289 if Assigned (Element) then
1290-- Raise_Not_Implemented ("");
1291 return Not_A_Trait;
1292 else
1293 return Not_A_Trait;
1294 end if;
1295 end Trait_Kind;
1296
1297 ---------------
1298 -- Type_Kind --
1299 ---------------
1300
1301 function Type_Kind
1302 (Definition : in Asis.Type_Definition)
1303 return Asis.Type_Kinds
1304 is
1305 begin
1306 case F.Flat_Kind (Definition) is
1307 when F.A_Derived_Type_Definition =>
1308 return Asis.A_Derived_Type_Definition;
1309 when F.A_Derived_Record_Extension_Definition =>
1310 return Asis.A_Derived_Record_Extension_Definition;
1311 when F.An_Enumeration_Type_Definition =>
1312 return Asis.An_Enumeration_Type_Definition;
1313 when F.A_Signed_Integer_Type_Definition =>
1314 return Asis.A_Signed_Integer_Type_Definition;
1315 when F.A_Modular_Type_Definition =>
1316 return Asis.A_Modular_Type_Definition;
1317 when F.A_Root_Type_Definition =>
1318 return Asis.A_Root_Type_Definition;
1319 when F.A_Floating_Point_Definition =>
1320 return A_Floating_Point_Definition;
1321 when F.An_Ordinary_Fixed_Point_Definition =>
1322 return An_Ordinary_Fixed_Point_Definition;
1323 when F.A_Decimal_Fixed_Point_Definition =>
1324 return A_Decimal_Fixed_Point_Definition;
1325 when F.An_Unconstrained_Array_Definition =>
1326 return An_Unconstrained_Array_Definition;
1327 when F.A_Constrained_Array_Definition =>
1328 return A_Constrained_Array_Definition;
1329 when F.A_Record_Type_Definition =>
1330 return A_Record_Type_Definition;
1331 when F.A_Tagged_Record_Type_Definition =>
1332 return A_Tagged_Record_Type_Definition;
1333 when F.An_Interface_Type_Definition =>
1334 return Asis.An_Interface_Type_Definition;
1335 when F.An_Access_Type_Definition =>
1336 return Asis.An_Access_Type_Definition;
1337 when others =>
1338 return Not_A_Type_Definition;
1339 end case;
1340 end Type_Kind;
1341
1342 ----------------------
1343 -- Unit_Declaration --
1344 ----------------------
1345
1346 function Unit_Declaration
1347 (Compilation_Unit : in Asis.Compilation_Unit)
1348 return Asis.Declaration
1349 is
1350 package Get is
1351
1352 type Visiter is new Gela.Element_Visiters.Visiter with record
1353 Unit : Gela.Elements.Element_Access;
1354 end record;
1355
1356 overriding procedure Compilation_Unit_Body
1357 (Self : in out Visiter;
1358 Node : not null Gela.Elements.Compilation_Unit_Bodies.
1359 Compilation_Unit_Body_Access);
1360
1361 overriding procedure Compilation_Unit_Declaration
1362 (Self : in out Visiter;
1363 Node : not null Gela.Elements.Compilation_Unit_Declarations.
1364 Compilation_Unit_Declaration_Access);
1365
1366 overriding procedure Subunit
1367 (Self : in out Visiter;
1368 Node : not null Gela.Elements.Subunits.Subunit_Access);
1369
1370 end Get;
1371
1372 package body Get is
1373
1374 overriding procedure Compilation_Unit_Body
1375 (Self : in out Visiter;
1376 Node : not null Gela.Elements.Compilation_Unit_Bodies.
1377 Compilation_Unit_Body_Access)
1378 is
1379 Result : constant Gela.Elements.Library_Unit_Bodies.
1380 Library_Unit_Body_Access := Node.Unit_Declaration;
1381 begin
1382 Self.Unit := Gela.Elements.Element_Access (Result);
1383 end Compilation_Unit_Body;
1384
1385 overriding procedure Compilation_Unit_Declaration
1386 (Self : in out Visiter;
1387 Node : not null Gela.Elements.Compilation_Unit_Declarations.
1388 Compilation_Unit_Declaration_Access)
1389 is
1390 Result : constant Gela.Elements.Library_Unit_Declarations.
1391 Library_Unit_Declaration_Access := Node.Unit_Declaration;
1392 begin
1393 Self.Unit := Gela.Elements.Element_Access (Result);
1394 end Compilation_Unit_Declaration;
1395
1396 overriding procedure Subunit
1397 (Self : in out Visiter;
1398 Node : not null Gela.Elements.Subunits.Subunit_Access)
1399 is
1400 Result : constant Gela.Elements.Proper_Bodies.Proper_Body_Access :=
1401 Node.Unit_Declaration;
1402 begin
1403 Self.Unit := Gela.Elements.Element_Access (Result);
1404 end Subunit;
1405
1406 end Get;
1407
1408 Tree : Gela.Elements.Compilation_Units.Compilation_Unit_Access;
1409 V : aliased Get.Visiter;
1410 begin
1411 Check_Nil_Unit (Compilation_Unit, "Unit_Declaration");
1412 Tree := Compilation_Unit.Data.Tree;
1413 Tree.Visit (V);
1414
1415 return (Data => V.Unit);
1416 end Unit_Declaration;
1417
1418end Asis.Elements;
1419
1420
1421------------------------------------------------------------------------------
1422-- Copyright (c) 2006-2013, Maxim Reznik
1423-- All rights reserved.
1424--
1425-- Redistribution and use in source and binary forms, with or without
1426-- modification, are permitted provided that the following conditions are met:
1427--
1428-- * Redistributions of source code must retain the above copyright notice,
1429-- this list of conditions and the following disclaimer.
1430-- * Redistributions in binary form must reproduce the above copyright
1431-- notice, this list of conditions and the following disclaimer in the
1432-- documentation and/or other materials provided with the distribution.
1433-- * Neither the name of the Maxim Reznik, IE nor the names of its
1434-- contributors may be used to endorse or promote products derived from
1435-- this software without specific prior written permission.
1436--
1437-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
1438-- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
1439-- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
1440-- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
1441-- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
1442-- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
1443-- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
1444-- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
1445-- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
1446-- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
1447-- POSSIBILITY OF SUCH DAMAGE.
1448------------------------------------------------------------------------------
Note: See TracBrowser for help on using the repository browser.