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

Last change on this file since 391 was 391, checked in by Maxim Reznik, 5 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

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