1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2001-2004 Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
27 -- This package defines the structure of the Project File tree.
31 with Prj
.Attr
; use Prj
.Attr
;
32 with Prj
.Com
; use Prj
.Com
;
33 with Table
; use Table
;
34 with Types
; use Types
;
38 Project_Nodes_Initial
: constant := 1_000
;
39 Project_Nodes_Increment
: constant := 100;
40 -- Allocation parameters for initializing and extending number
41 -- of nodes in table Tree_Private_Part.Project_Nodes
43 Project_Node_Low_Bound
: constant := 0;
44 Project_Node_High_Bound
: constant := 099_999_999
;
45 -- Range of values for project node id's (in practice infinite)
47 type Project_Node_Id
is range
48 Project_Node_Low_Bound
.. Project_Node_High_Bound
;
49 -- The index of table Tree_Private_Part.Project_Nodes
51 Empty_Node
: constant Project_Node_Id
:= Project_Node_Low_Bound
;
52 -- Designates no node in table Project_Nodes
54 First_Node_Id
: constant Project_Node_Id
:= Project_Node_Low_Bound
+ 1;
56 subtype Variable_Node_Id
is Project_Node_Id
;
57 -- Used to designate a node whose expected kind is one of
58 -- N_Typed_Variable_Declaration, N_Variable_Declaration or
59 -- N_Variable_Reference.
61 subtype Package_Declaration_Id
is Project_Node_Id
;
62 -- Used to designate a node whose expected kind is N_Proect_Declaration
64 type Project_Node_Kind
is
67 N_Project_Declaration
,
69 N_Package_Declaration
,
70 N_String_Type_Declaration
,
72 N_Attribute_Declaration
,
73 N_Typed_Variable_Declaration
,
74 N_Variable_Declaration
,
77 N_Literal_String_List
,
80 N_Attribute_Reference
,
85 -- Each node in the tree is of a Project_Node_Kind
86 -- For the signification of the fields in each node of a
87 -- Project_Node_Kind, look at package Tree_Private_Part.
90 -- Initialize the Project File tree: empty the Project_Nodes table
91 -- and reset the Projects_Htable.
93 function Default_Project_Node
94 (Of_Kind
: Project_Node_Kind
;
95 And_Expr_Kind
: Variable_Kind
:= Undefined
) return Project_Node_Id
;
96 -- Returns a Project_Node_Record with the specified Kind and
97 -- Expr_Kind; all the other components have default nil values.
99 function Hash
(N
: Project_Node_Id
) return Header_Num
;
100 -- Used for hash tables where the key is a Project_Node_Id
102 function Imported_Or_Extended_Project_Of
103 (Project
: Project_Node_Id
;
104 With_Name
: Name_Id
) return Project_Node_Id
;
105 -- Return the node of a project imported or extended by project Project and
106 -- whose name is With_Name. Return Empty_Node if there is no such project.
112 type Comment_State
is private;
113 -- A type to store the values of several global variables related to
116 procedure Save
(S
: out Comment_State
);
117 -- Save in variable S the comment state. Called before scanning a new
120 procedure Restore
(S
: in Comment_State
);
121 -- Restore the comment state to a previously saved value. Called after
122 -- scanning a project file.
124 procedure Reset_State
;
125 -- Set the comment state to its initial value. Called before scanning a
128 function There_Are_Unkept_Comments
return Boolean;
129 -- Indicates that some of the comments in a project file could not be
130 -- stored in the parse tree.
132 procedure Set_Previous_Line_Node
(To
: Project_Node_Id
);
133 -- Indicate the node on the previous line. If there are comments
134 -- immediately following this line, then they should be associated with
137 procedure Set_Previous_End_Node
(To
: Project_Node_Id
);
138 -- Indicate that on the previous line the "end" belongs to node To.
139 -- If there are comments immediately following this "end" line, they
140 -- should be associated with this node.
142 procedure Set_End_Of_Line
(To
: Project_Node_Id
);
143 -- Indicate the node on the current line. If there is an end of line
144 -- comment, then it should be associated with this node.
146 procedure Set_Next_End_Node
(To
: Project_Node_Id
);
147 -- Put node To on the top of the end node stack. When an "end" line
148 -- is found with this node on the top of the end node stack, the comments,
149 -- if any, immediately preceding this "end" line will be associated with
152 procedure Remove_Next_End_Node
;
153 -- Remove the top of the end node stack.
155 ------------------------
156 -- Comment Processing --
157 ------------------------
159 type Comment_Data
is record
160 Value
: Name_Id
:= No_Name
;
161 Follows_Empty_Line
: Boolean := False;
162 Is_Followed_By_Empty_Line
: Boolean := False;
165 package Comments
is new Table
.Table
166 (Table_Component_Type
=> Comment_Data
,
167 Table_Index_Type
=> Natural,
168 Table_Low_Bound
=> 1,
170 Table_Increment
=> 100,
171 Table_Name
=> "Prj.Tree.Comments");
172 -- A table to store the comments that may be stored is the tree
175 -- Scan the tokens and accumulate comments.
177 type Comment_Location
is
178 (Before
, After
, Before_End
, After_End
, End_Of_Line
);
180 procedure Add_Comments
(To
: Project_Node_Id
; Where
: Comment_Location
);
181 -- Add comments to this node.
183 ----------------------
184 -- Access Functions --
185 ----------------------
187 -- The following query functions are part of the abstract interface
188 -- of the Project File tree
190 function Name_Of
(Node
: Project_Node_Id
) return Name_Id
;
191 pragma Inline
(Name_Of
);
192 -- Valid for all non empty nodes. May return No_Name for nodes that have
195 function Kind_Of
(Node
: Project_Node_Id
) return Project_Node_Kind
;
196 pragma Inline
(Kind_Of
);
197 -- Valid for all non empty nodes
199 function Location_Of
(Node
: Project_Node_Id
) return Source_Ptr
;
200 pragma Inline
(Location_Of
);
201 -- Valid for all non empty nodes
203 function First_Comment_After
204 (Node
: Project_Node_Id
) return Project_Node_Id
;
205 -- Valid only for N_Comment_Zones nodes
207 function First_Comment_After_End
208 (Node
: Project_Node_Id
) return Project_Node_Id
;
209 -- Valid only for N_Comment_Zones nodes
211 function First_Comment_Before
212 (Node
: Project_Node_Id
) return Project_Node_Id
;
213 -- Valid only for N_Comment_Zones nodes
215 function First_Comment_Before_End
216 (Node
: Project_Node_Id
) return Project_Node_Id
;
217 -- Valid only for N_Comment_Zones nodes
219 function Next_Comment
(Node
: Project_Node_Id
) return Project_Node_Id
;
220 -- Valid only for N_Comment nodes
222 function End_Of_Line_Comment
(Node
: Project_Node_Id
) return Name_Id
;
223 -- Valid only for non empty nodes
225 function Follows_Empty_Line
(Node
: Project_Node_Id
) return Boolean;
226 -- Valid only for N_Comment nodes
228 function Is_Followed_By_Empty_Line
(Node
: Project_Node_Id
) return Boolean;
229 -- Valid only for N_Comment nodes
231 function Project_File_Includes_Unkept_Comments
232 (Node
: Project_Node_Id
)
234 -- Valid only for N_Project nodes
236 function Directory_Of
(Node
: Project_Node_Id
) return Name_Id
;
237 pragma Inline
(Directory_Of
);
238 -- Only valid for N_Project nodes.
240 function Expression_Kind_Of
(Node
: Project_Node_Id
) return Variable_Kind
;
241 pragma Inline
(Expression_Kind_Of
);
242 -- Only valid for N_Literal_String, N_Attribute_Declaration,
243 -- N_Variable_Declaration, N_Typed_Variable_Declaration, N_Expression,
244 -- N_Term, N_Variable_Reference or N_Attribute_Reference nodes.
246 function Is_Extending_All
(Node
: Project_Node_Id
) return Boolean;
247 pragma Inline
(Is_Extending_All
);
248 -- Only valid for N_Project and N_With_Clause
250 function First_Variable_Of
251 (Node
: Project_Node_Id
) return Variable_Node_Id
;
252 pragma Inline
(First_Variable_Of
);
253 -- Only valid for N_Project or N_Package_Declaration nodes
255 function First_Package_Of
256 (Node
: Project_Node_Id
) return Package_Declaration_Id
;
257 pragma Inline
(First_Package_Of
);
258 -- Only valid for N_Project nodes
260 function Package_Id_Of
(Node
: Project_Node_Id
) return Package_Node_Id
;
261 pragma Inline
(Package_Id_Of
);
262 -- Only valid for N_Package_Declaration nodes
264 function Path_Name_Of
(Node
: Project_Node_Id
) return Name_Id
;
265 pragma Inline
(Path_Name_Of
);
266 -- Only valid for N_Project and N_With_Clause nodes.
268 function String_Value_Of
(Node
: Project_Node_Id
) return Name_Id
;
269 pragma Inline
(String_Value_Of
);
270 -- Only valid for N_With_Clause, N_Literal_String nodes or N_Comment
272 function Source_Index_Of
(Node
: Project_Node_Id
) return Int
;
273 pragma Inline
(Source_Index_Of
);
274 -- Only valid for N_Literal_String and N_Attribute_Declaration nodes
276 function First_With_Clause_Of
277 (Node
: Project_Node_Id
) return Project_Node_Id
;
278 pragma Inline
(First_With_Clause_Of
);
279 -- Only valid for N_Project nodes
281 function Project_Declaration_Of
282 (Node
: Project_Node_Id
) return Project_Node_Id
;
283 pragma Inline
(Project_Declaration_Of
);
284 -- Only valid for N_Project nodes
286 function Extending_Project_Of
287 (Node
: Project_Node_Id
) return Project_Node_Id
;
288 pragma Inline
(Extending_Project_Of
);
289 -- Only valid for N_Project_Declaration nodes
291 function First_String_Type_Of
292 (Node
: Project_Node_Id
) return Project_Node_Id
;
293 pragma Inline
(First_String_Type_Of
);
294 -- Only valid for N_Project nodes
296 function Extended_Project_Path_Of
297 (Node
: Project_Node_Id
) return Name_Id
;
298 pragma Inline
(Extended_Project_Path_Of
);
299 -- Only valid for N_With_Clause nodes
301 function Project_Node_Of
302 (Node
: Project_Node_Id
) return Project_Node_Id
;
303 pragma Inline
(Project_Node_Of
);
304 -- Only valid for N_With_Clause, N_Variable_Reference and
305 -- N_Attribute_Reference nodes.
307 function Non_Limited_Project_Node_Of
308 (Node
: Project_Node_Id
) return Project_Node_Id
;
309 pragma Inline
(Non_Limited_Project_Node_Of
);
310 -- Only valid for N_With_Clause nodes. Returns Empty_Node for limited
311 -- imported project files, otherwise returns the same result as
314 function Next_With_Clause_Of
315 (Node
: Project_Node_Id
) return Project_Node_Id
;
316 pragma Inline
(Next_With_Clause_Of
);
317 -- Only valid for N_With_Clause nodes
319 function First_Declarative_Item_Of
320 (Node
: Project_Node_Id
) return Project_Node_Id
;
321 pragma Inline
(First_Declarative_Item_Of
);
322 -- Only valid for N_With_Clause nodes
324 function Extended_Project_Of
325 (Node
: Project_Node_Id
) return Project_Node_Id
;
326 pragma Inline
(Extended_Project_Of
);
327 -- Only valid for N_Project_Declaration nodes
329 function Current_Item_Node
330 (Node
: Project_Node_Id
) return Project_Node_Id
;
331 pragma Inline
(Current_Item_Node
);
332 -- Only valid for N_Declarative_Item nodes
334 function Next_Declarative_Item
335 (Node
: Project_Node_Id
) return Project_Node_Id
;
336 pragma Inline
(Next_Declarative_Item
);
337 -- Only valid for N_Declarative_Item node
339 function Project_Of_Renamed_Package_Of
340 (Node
: Project_Node_Id
) return Project_Node_Id
;
341 pragma Inline
(Project_Of_Renamed_Package_Of
);
342 -- Only valid for N_Package_Declaration nodes.
343 -- May return Empty_Node.
345 function Next_Package_In_Project
346 (Node
: Project_Node_Id
) return Project_Node_Id
;
347 pragma Inline
(Next_Package_In_Project
);
348 -- Only valid for N_Package_Declaration nodes
350 function First_Literal_String
351 (Node
: Project_Node_Id
) return Project_Node_Id
;
352 pragma Inline
(First_Literal_String
);
353 -- Only valid for N_String_Type_Declaration nodes
355 function Next_String_Type
356 (Node
: Project_Node_Id
) return Project_Node_Id
;
357 pragma Inline
(Next_String_Type
);
358 -- Only valid for N_String_Type_Declaration nodes
360 function Next_Literal_String
361 (Node
: Project_Node_Id
) return Project_Node_Id
;
362 pragma Inline
(Next_Literal_String
);
363 -- Only valid for N_Literal_String nodes
365 function Expression_Of
366 (Node
: Project_Node_Id
) return Project_Node_Id
;
367 pragma Inline
(Expression_Of
);
368 -- Only valid for N_Attribute_Declaration, N_Typed_Variable_Declaration
369 -- or N_Variable_Declaration nodes
371 function Associative_Project_Of
372 (Node
: Project_Node_Id
)
373 return Project_Node_Id
;
374 pragma Inline
(Associative_Project_Of
);
375 -- Only valid for N_Attribute_Declaration nodes
377 function Associative_Package_Of
378 (Node
: Project_Node_Id
)
379 return Project_Node_Id
;
380 pragma Inline
(Associative_Package_Of
);
381 -- Only valid for N_Attribute_Declaration nodes
383 function Value_Is_Valid
384 (For_Typed_Variable
: Project_Node_Id
;
385 Value
: Name_Id
) return Boolean;
386 pragma Inline
(Value_Is_Valid
);
387 -- Only valid for N_Typed_Variable_Declaration. Returns True if Value is
388 -- in the list of allowed strings for For_Typed_Variable. False otherwise.
390 function Associative_Array_Index_Of
391 (Node
: Project_Node_Id
) return Name_Id
;
392 pragma Inline
(Associative_Array_Index_Of
);
393 -- Only valid for N_Attribute_Declaration and N_Attribute_Reference.
394 -- Returns No_String for non associative array attributes.
396 function Next_Variable
397 (Node
: Project_Node_Id
) return Project_Node_Id
;
398 pragma Inline
(Next_Variable
);
399 -- Only valid for N_Typed_Variable_Declaration or N_Variable_Declaration
403 (Node
: Project_Node_Id
) return Project_Node_Id
;
404 pragma Inline
(First_Term
);
405 -- Only valid for N_Expression nodes
407 function Next_Expression_In_List
408 (Node
: Project_Node_Id
) return Project_Node_Id
;
409 pragma Inline
(Next_Expression_In_List
);
410 -- Only valid for N_Expression nodes
412 function Current_Term
413 (Node
: Project_Node_Id
) return Project_Node_Id
;
414 pragma Inline
(Current_Term
);
415 -- Only valid for N_Term nodes
418 (Node
: Project_Node_Id
) return Project_Node_Id
;
419 pragma Inline
(Next_Term
);
420 -- Only valid for N_Term nodes
422 function First_Expression_In_List
423 (Node
: Project_Node_Id
) return Project_Node_Id
;
424 pragma Inline
(First_Expression_In_List
);
425 -- Only valid for N_Literal_String_List nodes
427 function Package_Node_Of
428 (Node
: Project_Node_Id
) return Project_Node_Id
;
429 pragma Inline
(Package_Node_Of
);
430 -- Only valid for N_Variable_Reference or N_Attribute_Reference nodes.
431 -- May return Empty_Node.
433 function String_Type_Of
434 (Node
: Project_Node_Id
) return Project_Node_Id
;
435 pragma Inline
(String_Type_Of
);
436 -- Only valid for N_Variable_Reference or N_Typed_Variable_Declaration
439 function External_Reference_Of
440 (Node
: Project_Node_Id
) return Project_Node_Id
;
441 pragma Inline
(External_Reference_Of
);
442 -- Only valid for N_External_Value nodes
444 function External_Default_Of
445 (Node
: Project_Node_Id
) return Project_Node_Id
;
446 pragma Inline
(External_Default_Of
);
447 -- Only valid for N_External_Value nodes
449 function Case_Variable_Reference_Of
450 (Node
: Project_Node_Id
) return Project_Node_Id
;
451 pragma Inline
(Case_Variable_Reference_Of
);
452 -- Only valid for N_Case_Construction nodes
454 function First_Case_Item_Of
455 (Node
: Project_Node_Id
) return Project_Node_Id
;
456 pragma Inline
(First_Case_Item_Of
);
457 -- Only valid for N_Case_Construction nodes
459 function First_Choice_Of
460 (Node
: Project_Node_Id
) return Project_Node_Id
;
461 pragma Inline
(First_Choice_Of
);
462 -- Return the first choice in a N_Case_Item, or Empty_Node if
463 -- this is when others.
465 function Next_Case_Item
466 (Node
: Project_Node_Id
) return Project_Node_Id
;
467 pragma Inline
(Next_Case_Item
);
468 -- Only valid for N_Case_Item nodes
470 function Case_Insensitive
(Node
: Project_Node_Id
) return Boolean;
471 -- Only valid for N_Attribute_Declaration and N_Attribute_Reference nodes
477 -- The following procedures are part of the abstract interface of
478 -- the Project File tree.
480 -- Each Set_* procedure is valid only for the same Project_Node_Kind
481 -- nodes as the corresponding query function above.
483 procedure Set_Name_Of
484 (Node
: Project_Node_Id
;
486 pragma Inline
(Set_Name_Of
);
488 procedure Set_Kind_Of
489 (Node
: Project_Node_Id
;
490 To
: Project_Node_Kind
);
491 pragma Inline
(Set_Kind_Of
);
493 procedure Set_Location_Of
494 (Node
: Project_Node_Id
;
496 pragma Inline
(Set_Location_Of
);
498 procedure Set_First_Comment_After
499 (Node
: Project_Node_Id
;
500 To
: Project_Node_Id
);
501 pragma Inline
(Set_First_Comment_After
);
503 procedure Set_First_Comment_After_End
504 (Node
: Project_Node_Id
;
505 To
: Project_Node_Id
);
506 pragma Inline
(Set_First_Comment_After_End
);
508 procedure Set_First_Comment_Before
509 (Node
: Project_Node_Id
;
510 To
: Project_Node_Id
);
511 pragma Inline
(Set_First_Comment_Before
);
513 procedure Set_First_Comment_Before_End
514 (Node
: Project_Node_Id
;
515 To
: Project_Node_Id
);
516 pragma Inline
(Set_First_Comment_Before_End
);
518 procedure Set_Next_Comment
519 (Node
: Project_Node_Id
;
520 To
: Project_Node_Id
);
521 pragma Inline
(Set_Next_Comment
);
523 procedure Set_Project_File_Includes_Unkept_Comments
524 (Node
: Project_Node_Id
;
527 procedure Set_Directory_Of
528 (Node
: Project_Node_Id
;
530 pragma Inline
(Set_Directory_Of
);
532 procedure Set_Expression_Kind_Of
533 (Node
: Project_Node_Id
;
535 pragma Inline
(Set_Expression_Kind_Of
);
537 procedure Set_Is_Extending_All
(Node
: Project_Node_Id
);
538 pragma Inline
(Set_Is_Extending_All
);
540 procedure Set_First_Variable_Of
541 (Node
: Project_Node_Id
;
542 To
: Variable_Node_Id
);
543 pragma Inline
(Set_First_Variable_Of
);
545 procedure Set_First_Package_Of
546 (Node
: Project_Node_Id
;
547 To
: Package_Declaration_Id
);
548 pragma Inline
(Set_First_Package_Of
);
550 procedure Set_Package_Id_Of
551 (Node
: Project_Node_Id
;
552 To
: Package_Node_Id
);
553 pragma Inline
(Set_Package_Id_Of
);
555 procedure Set_Path_Name_Of
556 (Node
: Project_Node_Id
;
558 pragma Inline
(Set_Path_Name_Of
);
560 procedure Set_String_Value_Of
561 (Node
: Project_Node_Id
;
563 pragma Inline
(Set_String_Value_Of
);
565 procedure Set_First_With_Clause_Of
566 (Node
: Project_Node_Id
;
567 To
: Project_Node_Id
);
568 pragma Inline
(Set_First_With_Clause_Of
);
570 procedure Set_Project_Declaration_Of
571 (Node
: Project_Node_Id
;
572 To
: Project_Node_Id
);
573 pragma Inline
(Set_Project_Declaration_Of
);
575 procedure Set_Extending_Project_Of
576 (Node
: Project_Node_Id
;
577 To
: Project_Node_Id
);
578 pragma Inline
(Set_Extending_Project_Of
);
580 procedure Set_First_String_Type_Of
581 (Node
: Project_Node_Id
;
582 To
: Project_Node_Id
);
583 pragma Inline
(Set_First_String_Type_Of
);
585 procedure Set_Extended_Project_Path_Of
586 (Node
: Project_Node_Id
;
588 pragma Inline
(Set_Extended_Project_Path_Of
);
590 procedure Set_Project_Node_Of
591 (Node
: Project_Node_Id
;
592 To
: Project_Node_Id
;
593 Limited_With
: Boolean := False);
594 pragma Inline
(Set_Project_Node_Of
);
596 procedure Set_Next_With_Clause_Of
597 (Node
: Project_Node_Id
;
598 To
: Project_Node_Id
);
599 pragma Inline
(Set_Next_With_Clause_Of
);
601 procedure Set_First_Declarative_Item_Of
602 (Node
: Project_Node_Id
;
603 To
: Project_Node_Id
);
604 pragma Inline
(Set_First_Declarative_Item_Of
);
606 procedure Set_Extended_Project_Of
607 (Node
: Project_Node_Id
;
608 To
: Project_Node_Id
);
609 pragma Inline
(Set_Extended_Project_Of
);
611 procedure Set_Current_Item_Node
612 (Node
: Project_Node_Id
;
613 To
: Project_Node_Id
);
614 pragma Inline
(Set_Current_Item_Node
);
616 procedure Set_Next_Declarative_Item
617 (Node
: Project_Node_Id
;
618 To
: Project_Node_Id
);
619 pragma Inline
(Set_Next_Declarative_Item
);
621 procedure Set_Project_Of_Renamed_Package_Of
622 (Node
: Project_Node_Id
;
623 To
: Project_Node_Id
);
624 pragma Inline
(Set_Project_Of_Renamed_Package_Of
);
626 procedure Set_Next_Package_In_Project
627 (Node
: Project_Node_Id
;
628 To
: Project_Node_Id
);
629 pragma Inline
(Set_Next_Package_In_Project
);
631 procedure Set_First_Literal_String
632 (Node
: Project_Node_Id
;
633 To
: Project_Node_Id
);
634 pragma Inline
(Set_First_Literal_String
);
636 procedure Set_Next_String_Type
637 (Node
: Project_Node_Id
;
638 To
: Project_Node_Id
);
639 pragma Inline
(Set_Next_String_Type
);
641 procedure Set_Next_Literal_String
642 (Node
: Project_Node_Id
;
643 To
: Project_Node_Id
);
644 pragma Inline
(Set_Next_Literal_String
);
646 procedure Set_Expression_Of
647 (Node
: Project_Node_Id
;
648 To
: Project_Node_Id
);
649 pragma Inline
(Set_Expression_Of
);
651 procedure Set_Associative_Project_Of
652 (Node
: Project_Node_Id
;
653 To
: Project_Node_Id
);
654 pragma Inline
(Set_Associative_Project_Of
);
656 procedure Set_Associative_Package_Of
657 (Node
: Project_Node_Id
;
658 To
: Project_Node_Id
);
659 pragma Inline
(Set_Associative_Package_Of
);
661 procedure Set_Associative_Array_Index_Of
662 (Node
: Project_Node_Id
;
664 pragma Inline
(Set_Associative_Array_Index_Of
);
666 procedure Set_Next_Variable
667 (Node
: Project_Node_Id
;
668 To
: Project_Node_Id
);
669 pragma Inline
(Set_Next_Variable
);
671 procedure Set_First_Term
672 (Node
: Project_Node_Id
;
673 To
: Project_Node_Id
);
674 pragma Inline
(Set_First_Term
);
676 procedure Set_Next_Expression_In_List
677 (Node
: Project_Node_Id
;
678 To
: Project_Node_Id
);
679 pragma Inline
(Set_Next_Expression_In_List
);
681 procedure Set_Current_Term
682 (Node
: Project_Node_Id
;
683 To
: Project_Node_Id
);
684 pragma Inline
(Set_Current_Term
);
686 procedure Set_Next_Term
687 (Node
: Project_Node_Id
;
688 To
: Project_Node_Id
);
689 pragma Inline
(Set_Next_Term
);
691 procedure Set_First_Expression_In_List
692 (Node
: Project_Node_Id
;
693 To
: Project_Node_Id
);
694 pragma Inline
(Set_First_Expression_In_List
);
696 procedure Set_Package_Node_Of
697 (Node
: Project_Node_Id
;
698 To
: Project_Node_Id
);
699 pragma Inline
(Set_Package_Node_Of
);
701 procedure Set_Source_Index_Of
702 (Node
: Project_Node_Id
;
704 pragma Inline
(Set_Source_Index_Of
);
706 procedure Set_String_Type_Of
707 (Node
: Project_Node_Id
;
708 To
: Project_Node_Id
);
709 pragma Inline
(Set_String_Type_Of
);
711 procedure Set_External_Reference_Of
712 (Node
: Project_Node_Id
;
713 To
: Project_Node_Id
);
714 pragma Inline
(Set_External_Reference_Of
);
716 procedure Set_External_Default_Of
717 (Node
: Project_Node_Id
;
718 To
: Project_Node_Id
);
719 pragma Inline
(Set_External_Default_Of
);
721 procedure Set_Case_Variable_Reference_Of
722 (Node
: Project_Node_Id
;
723 To
: Project_Node_Id
);
724 pragma Inline
(Set_Case_Variable_Reference_Of
);
726 procedure Set_First_Case_Item_Of
727 (Node
: Project_Node_Id
;
728 To
: Project_Node_Id
);
729 pragma Inline
(Set_First_Case_Item_Of
);
731 procedure Set_First_Choice_Of
732 (Node
: Project_Node_Id
;
733 To
: Project_Node_Id
);
734 pragma Inline
(Set_First_Choice_Of
);
736 procedure Set_Next_Case_Item
737 (Node
: Project_Node_Id
;
738 To
: Project_Node_Id
);
739 pragma Inline
(Set_Next_Case_Item
);
741 procedure Set_Case_Insensitive
742 (Node
: Project_Node_Id
;
745 -------------------------------
746 -- Restricted Access Section --
747 -------------------------------
749 package Tree_Private_Part
is
751 -- This is conceptually in the private part.
752 -- However, for efficiency, some packages are accessing it directly.
754 type Project_Node_Record
is record
756 Kind
: Project_Node_Kind
;
758 Location
: Source_Ptr
:= No_Location
;
760 Directory
: Name_Id
:= No_Name
;
761 -- Only for N_Project
763 Expr_Kind
: Variable_Kind
:= Undefined
;
764 -- See below for what Project_Node_Kind it is used
766 Variables
: Variable_Node_Id
:= Empty_Node
;
767 -- First variable in a project or a package
769 Packages
: Package_Declaration_Id
:= Empty_Node
;
770 -- First package declaration in a project
772 Pkg_Id
: Package_Node_Id
:= Empty_Package
;
773 -- Only used for N_Package_Declaration
774 -- The component Pkg_Id is an entry into the table Package_Attributes
775 -- (in Prj.Attr). It is used to indicate all the attributes of the
776 -- package with their characteristics.
778 -- The tables Prj.Attr.Attributes and Prj.Attr.Package_Attributes
779 -- are built once and for all through a call (from Prj.Initialize)
780 -- to procedure Prj.Attr.Initialize. It is never modified after that.
782 Name
: Name_Id
:= No_Name
;
783 -- See below for what Project_Node_Kind it is used
785 Src_Index
: Int
:= 0;
786 -- Index of a unit in a multi-unit source.
787 -- Onli for some N_Attribute_Declaration and N_Literal_String.
789 Path_Name
: Name_Id
:= No_Name
;
790 -- See below for what Project_Node_Kind it is used
792 Value
: Name_Id
:= No_Name
;
793 -- See below for what Project_Node_Kind it is used
795 Field1
: Project_Node_Id
:= Empty_Node
;
796 -- See below the meaning for each Project_Node_Kind
798 Field2
: Project_Node_Id
:= Empty_Node
;
799 -- See below the meaning for each Project_Node_Kind
801 Field3
: Project_Node_Id
:= Empty_Node
;
802 -- See below the meaning for each Project_Node_Kind
804 Flag1
: Boolean := False;
805 -- This flag is significant only for:
806 -- N_Attribute_Declaration and N_Atribute_Reference
807 -- It indicates for an associative array attribute, that the
808 -- index is case insensitive.
809 -- N_Comment - it indicates that the comment is preceded by an
811 -- N_Project - it indicates that there are comments in the project
812 -- source that cannot be kept in the tree.
813 -- N_Project_Declaration
814 -- - it indicates that there are unkept comments in the
817 Flag2
: Boolean := False;
818 -- This flag is significant only for:
819 -- N_Project - it indicates that the project "extends all" another
821 -- N_Comment - it indicates that the comment is followed by an
824 -- - it indicates that the originally imported project
825 -- is an extending all project.
827 Comments
: Project_Node_Id
:= Empty_Node
;
828 -- For nodes other that N_Comment_Zones or N_Comment, designates the
829 -- comment zones associated with the node.
830 -- for N_Comment_Zones, designates the comment after the "end" of
832 -- For N_Comment, designates the next comment, if any.
836 -- type Project_Node_Kind is
839 -- -- Name: project name
840 -- -- Path_Name: project path name
841 -- -- Expr_Kind: Undefined
842 -- -- Field1: first with clause
843 -- -- Field2: project declaration
844 -- -- Field3: first string type
845 -- -- Value: extended project path name (if any)
848 -- -- Name: imported project name
849 -- -- Path_Name: imported project path name
850 -- -- Expr_Kind: Undefined
851 -- -- Field1: project node
852 -- -- Field2: next with clause
853 -- -- Field3: project node or empty if "limited with"
854 -- -- Value: literal string withed
856 -- N_Project_Declaration,
858 -- -- Path_Name: not used
859 -- -- Expr_Kind: Undefined
860 -- -- Field1: first declarative item
861 -- -- Field2: extended project
862 -- -- Field3: extending project
863 -- -- Value: not used
865 -- N_Declarative_Item,
867 -- -- Path_Name: not used
868 -- -- Expr_Kind: Undefined
869 -- -- Field1: current item node
870 -- -- Field2: next declarative item
871 -- -- Field3: not used
872 -- -- Value: not used
874 -- N_Package_Declaration,
875 -- -- Name: package name
876 -- -- Path_Name: not used
877 -- -- Expr_Kind: Undefined
878 -- -- Field1: project of renamed package (if any)
879 -- -- Field2: first declarative item
880 -- -- Field3: next package in project
881 -- -- Value: not used
883 -- N_String_Type_Declaration,
884 -- -- Name: type name
885 -- -- Path_Name: not used
886 -- -- Expr_Kind: Undefined
887 -- -- Field1: first literal string
888 -- -- Field2: next string type
889 -- -- Field3: not used
890 -- -- Value: not used
894 -- -- Path_Name: not used
895 -- -- Expr_Kind: Single
896 -- -- Field1: next literal string
897 -- -- Field2: not used
898 -- -- Field3: not used
899 -- -- Value: string value
901 -- N_Attribute_Declaration,
902 -- -- Name: attribute name
903 -- -- Path_Name: not used
904 -- -- Expr_Kind: attribute kind
905 -- -- Field1: expression
906 -- -- Field2: project of full associative array
907 -- -- Field3: package of full associative array
908 -- -- Value: associative array index
909 -- -- (if an associative array element)
911 -- N_Typed_Variable_Declaration,
912 -- -- Name: variable name
913 -- -- Path_Name: not used
914 -- -- Expr_Kind: Single
915 -- -- Field1: expression
916 -- -- Field2: type of variable (N_String_Type_Declaration)
917 -- -- Field3: next variable
918 -- -- Value: not used
920 -- N_Variable_Declaration,
921 -- -- Name: variable name
922 -- -- Path_Name: not used
923 -- -- Expr_Kind: variable kind
924 -- -- Field1: expression
925 -- -- Field2: not used
926 -- -- Field3 is used for next variable, instead of Field2,
927 -- -- so that it is the same field for
928 -- -- N_Variable_Declaration and
929 -- -- N_Typed_Variable_Declaration
930 -- -- Field3: next variable
931 -- -- Value: not used
935 -- -- Path_Name: not used
936 -- -- Expr_Kind: expression kind
937 -- -- Field1: first term
938 -- -- Field2: next expression in list
939 -- -- Field3: not used
940 -- -- Value: not used
944 -- -- Path_Name: not used
945 -- -- Expr_Kind: term kind
946 -- -- Field1: current term
947 -- -- Field2: next term in the expression
948 -- -- Field3: not used
949 -- -- Value: not used
951 -- N_Literal_String_List,
952 -- -- Designates a list of string expressions between brackets
953 -- -- separated by commas. The string expressions are not necessarily
954 -- -- literal strings.
956 -- -- Path_Name: not used
957 -- -- Expr_Kind: List
958 -- -- Field1: first expression
959 -- -- Field2: not used
960 -- -- Field3: not used
961 -- -- Value: not used
963 -- N_Variable_Reference,
964 -- -- Name: variable name
965 -- -- Path_Name: not used
966 -- -- Expr_Kind: variable kind
967 -- -- Field1: project (if specified)
968 -- -- Field2: package (if specified)
969 -- -- Field3: type of variable (N_String_Type_Declaration), if any
970 -- -- Value: not used
974 -- -- Path_Name: not used
975 -- -- Expr_Kind: Single
976 -- -- Field1: Name of the external reference (literal string)
977 -- -- Field2: Default (literal string)
978 -- -- Field3: not used
979 -- -- Value: not used
981 -- N_Attribute_Reference,
982 -- -- Name: attribute name
983 -- -- Path_Name: not used
984 -- -- Expr_Kind: attribute kind
985 -- -- Field1: project
986 -- -- Field2: package (if attribute of a package)
987 -- -- Field3: not used
988 -- -- Value: associative array index
989 -- -- (if an associative array element)
991 -- N_Case_Construction,
993 -- -- Path_Name: not used
994 -- -- Expr_Kind: Undefined
995 -- -- Field1: case variable reference
996 -- -- Field2: first case item
997 -- -- Field3: not used
998 -- -- Value: not used
1001 -- -- Name: not used
1002 -- -- Path_Name: not used
1003 -- -- Expr_Kind: not used
1004 -- -- Field1: first choice (literal string), or Empty_Node
1005 -- -- for when others
1006 -- -- Field2: first declarative item
1007 -- -- Field3: next case item
1008 -- -- Value: not used
1011 -- -- Name: not used
1012 -- -- Path_Name: not used
1013 -- -- Expr_Kind: not used
1014 -- -- Field1: comment before the construct
1015 -- -- Field2: comment after the construct
1016 -- -- Field3: comment before the "end" of the construct
1017 -- -- Value: end of line comment
1018 -- -- Comments: comment after the "end" of the construct
1021 -- -- Name: not used
1022 -- -- Path_Name: not used
1023 -- -- Expr_Kind: not used
1024 -- -- Field1: not used
1025 -- -- Field2: not used
1026 -- -- Field3: not used
1027 -- -- Value: comment
1028 -- -- Flag1: comment is preceded by an empty line
1029 -- -- Flag2: comment is followed by an empty line
1030 -- -- Comments: next comment
1032 package Project_Nodes
is
1033 new Table
.Table
(Table_Component_Type
=> Project_Node_Record
,
1034 Table_Index_Type
=> Project_Node_Id
,
1035 Table_Low_Bound
=> First_Node_Id
,
1036 Table_Initial
=> Project_Nodes_Initial
,
1037 Table_Increment
=> Project_Nodes_Increment
,
1038 Table_Name
=> "Project_Nodes");
1039 -- This table contains the syntactic tree of project data
1040 -- from project files.
1042 type Project_Name_And_Node
is record
1044 -- Name of the project
1046 Node
: Project_Node_Id
;
1047 -- Node of the project in table Project_Nodes
1050 -- True when the project is being extended by another project
1053 No_Project_Name_And_Node
: constant Project_Name_And_Node
:=
1054 (Name
=> No_Name
, Node
=> Empty_Node
, Extended
=> True);
1056 package Projects_Htable
is new GNAT
.HTable
.Simple_HTable
1057 (Header_Num
=> Header_Num
,
1058 Element
=> Project_Name_And_Node
,
1059 No_Element
=> No_Project_Name_And_Node
,
1063 -- This hash table contains a mapping of project names to project nodes.
1064 -- Note that this hash table contains only the nodes whose Kind is
1065 -- N_Project. It is used to find the node of a project from its
1066 -- name, and to verify if a project has already been parsed, knowing
1069 end Tree_Private_Part
;
1072 type Comment_Array
is array (Positive range <>) of Comment_Data
;
1073 type Comments_Ptr
is access Comment_Array
;
1075 type Comment_State
is record
1076 End_Of_Line_Node
: Project_Node_Id
:= Empty_Node
;
1078 Previous_Line_Node
: Project_Node_Id
:= Empty_Node
;
1080 Previous_End_Node
: Project_Node_Id
:= Empty_Node
;
1082 Unkept_Comments
: Boolean := False;
1084 Comments
: Comments_Ptr
:= null;