1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2001-2005 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
29 with GNAT
.Dynamic_HTables
;
30 with GNAT
.Dynamic_Tables
;
32 with Prj
.Attr
; use Prj
.Attr
;
33 with Types
; use Types
;
37 type Project_Node_Tree_Data
;
38 type Project_Node_Tree_Ref
is access all Project_Node_Tree_Data
;
39 -- Type to designate a project node tree, so that several project node
40 -- trees can coexist in memory.
42 Project_Nodes_Initial
: constant := 1_000
;
43 Project_Nodes_Increment
: constant := 100;
44 -- Allocation parameters for initializing and extending number
45 -- of nodes in table Tree_Private_Part.Project_Nodes
47 Project_Node_Low_Bound
: constant := 0;
48 Project_Node_High_Bound
: constant := 099_999_999
;
49 -- Range of values for project node id's (in practice infinite)
51 type Project_Node_Id
is range
52 Project_Node_Low_Bound
.. Project_Node_High_Bound
;
53 -- The index of table Tree_Private_Part.Project_Nodes
55 Empty_Node
: constant Project_Node_Id
:= Project_Node_Low_Bound
;
56 -- Designates no node in table Project_Nodes
58 First_Node_Id
: constant Project_Node_Id
:= Project_Node_Low_Bound
+ 1;
60 subtype Variable_Node_Id
is Project_Node_Id
;
61 -- Used to designate a node whose expected kind is one of
62 -- N_Typed_Variable_Declaration, N_Variable_Declaration or
63 -- N_Variable_Reference.
65 subtype Package_Declaration_Id
is Project_Node_Id
;
66 -- Used to designate a node whose expected kind is N_Proect_Declaration
68 type Project_Node_Kind
is
71 N_Project_Declaration
,
73 N_Package_Declaration
,
74 N_String_Type_Declaration
,
76 N_Attribute_Declaration
,
77 N_Typed_Variable_Declaration
,
78 N_Variable_Declaration
,
81 N_Literal_String_List
,
84 N_Attribute_Reference
,
89 -- Each node in the tree is of a Project_Node_Kind
90 -- For the signification of the fields in each node of a
91 -- Project_Node_Kind, look at package Tree_Private_Part.
93 procedure Initialize
(Tree
: Project_Node_Tree_Ref
);
94 -- Initialize the Project File tree: empty the Project_Nodes table
95 -- and reset the Projects_Htable.
97 function Default_Project_Node
98 (In_Tree
: Project_Node_Tree_Ref
;
99 Of_Kind
: Project_Node_Kind
;
100 And_Expr_Kind
: Variable_Kind
:= Undefined
) return Project_Node_Id
;
101 -- Returns a Project_Node_Record with the specified Kind and
102 -- Expr_Kind; all the other components have default nil values.
104 function Hash
(N
: Project_Node_Id
) return Header_Num
;
105 -- Used for hash tables where the key is a Project_Node_Id
107 function Imported_Or_Extended_Project_Of
108 (Project
: Project_Node_Id
;
109 In_Tree
: Project_Node_Tree_Ref
;
110 With_Name
: Name_Id
) return Project_Node_Id
;
111 -- Return the node of a project imported or extended by project Project and
112 -- whose name is With_Name. Return Empty_Node if there is no such project.
118 type Comment_State
is private;
119 -- A type to store the values of several global variables related to
122 procedure Save
(S
: out Comment_State
);
123 -- Save in variable S the comment state. Called before scanning a new
126 procedure Restore
(S
: in Comment_State
);
127 -- Restore the comment state to a previously saved value. Called after
128 -- scanning a project file.
130 procedure Reset_State
;
131 -- Set the comment state to its initial value. Called before scanning a
134 function There_Are_Unkept_Comments
return Boolean;
135 -- Indicates that some of the comments in a project file could not be
136 -- stored in the parse tree.
138 procedure Set_Previous_Line_Node
(To
: Project_Node_Id
);
139 -- Indicate the node on the previous line. If there are comments
140 -- immediately following this line, then they should be associated with
143 procedure Set_Previous_End_Node
(To
: Project_Node_Id
);
144 -- Indicate that on the previous line the "end" belongs to node To.
145 -- If there are comments immediately following this "end" line, they
146 -- should be associated with this node.
148 procedure Set_End_Of_Line
(To
: Project_Node_Id
);
149 -- Indicate the node on the current line. If there is an end of line
150 -- comment, then it should be associated with this node.
152 procedure Set_Next_End_Node
(To
: Project_Node_Id
);
153 -- Put node To on the top of the end node stack. When an "end" line
154 -- is found with this node on the top of the end node stack, the comments,
155 -- if any, immediately preceding this "end" line will be associated with
158 procedure Remove_Next_End_Node
;
159 -- Remove the top of the end node stack
161 ------------------------
162 -- Comment Processing --
163 ------------------------
165 type Comment_Data
is record
166 Value
: Name_Id
:= No_Name
;
167 Follows_Empty_Line
: Boolean := False;
168 Is_Followed_By_Empty_Line
: Boolean := False;
171 package Comments
is new Table
.Table
172 (Table_Component_Type
=> Comment_Data
,
173 Table_Index_Type
=> Natural,
174 Table_Low_Bound
=> 1,
176 Table_Increment
=> 100,
177 Table_Name
=> "Prj.Tree.Comments");
178 -- A table to store the comments that may be stored is the tree
180 procedure Scan
(In_Tree
: Project_Node_Tree_Ref
);
181 -- Scan the tokens and accumulate comments
183 type Comment_Location
is
184 (Before
, After
, Before_End
, After_End
, End_Of_Line
);
186 procedure Add_Comments
187 (To
: Project_Node_Id
;
188 In_Tree
: Project_Node_Tree_Ref
;
189 Where
: Comment_Location
);
190 -- Add comments to this node
192 ----------------------
193 -- Access Functions --
194 ----------------------
196 -- The following query functions are part of the abstract interface
197 -- of the Project File tree
200 (Node
: Project_Node_Id
;
201 In_Tree
: Project_Node_Tree_Ref
) return Name_Id
;
202 pragma Inline
(Name_Of
);
203 -- Valid for all non empty nodes. May return No_Name for nodes that have
207 (Node
: Project_Node_Id
;
208 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Kind
;
209 pragma Inline
(Kind_Of
);
210 -- Valid for all non empty nodes
213 (Node
: Project_Node_Id
;
214 In_Tree
: Project_Node_Tree_Ref
) return Source_Ptr
;
215 pragma Inline
(Location_Of
);
216 -- Valid for all non empty nodes
218 function First_Comment_After
219 (Node
: Project_Node_Id
;
220 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
221 -- Valid only for N_Comment_Zones nodes
223 function First_Comment_After_End
224 (Node
: Project_Node_Id
;
225 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
226 -- Valid only for N_Comment_Zones nodes
228 function First_Comment_Before
229 (Node
: Project_Node_Id
;
230 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
231 -- Valid only for N_Comment_Zones nodes
233 function First_Comment_Before_End
234 (Node
: Project_Node_Id
;
235 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
236 -- Valid only for N_Comment_Zones nodes
238 function Next_Comment
239 (Node
: Project_Node_Id
;
240 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
241 -- Valid only for N_Comment nodes
243 function End_Of_Line_Comment
244 (Node
: Project_Node_Id
;
245 In_Tree
: Project_Node_Tree_Ref
) return Name_Id
;
246 -- Valid only for non empty nodes
248 function Follows_Empty_Line
249 (Node
: Project_Node_Id
;
250 In_Tree
: Project_Node_Tree_Ref
) return Boolean;
251 -- Valid only for N_Comment nodes
253 function Is_Followed_By_Empty_Line
254 (Node
: Project_Node_Id
;
255 In_Tree
: Project_Node_Tree_Ref
) return Boolean;
256 -- Valid only for N_Comment nodes
258 function Project_File_Includes_Unkept_Comments
259 (Node
: Project_Node_Id
;
260 In_Tree
: Project_Node_Tree_Ref
)
262 -- Valid only for N_Project nodes
264 function Directory_Of
265 (Node
: Project_Node_Id
;
266 In_Tree
: Project_Node_Tree_Ref
) return Name_Id
;
267 pragma Inline
(Directory_Of
);
268 -- Only valid for N_Project nodes
270 function Expression_Kind_Of
271 (Node
: Project_Node_Id
;
272 In_Tree
: Project_Node_Tree_Ref
) return Variable_Kind
;
273 pragma Inline
(Expression_Kind_Of
);
274 -- Only valid for N_Literal_String, N_Attribute_Declaration,
275 -- N_Variable_Declaration, N_Typed_Variable_Declaration, N_Expression,
276 -- N_Term, N_Variable_Reference or N_Attribute_Reference nodes.
278 function Is_Extending_All
279 (Node
: Project_Node_Id
;
280 In_Tree
: Project_Node_Tree_Ref
) return Boolean;
281 pragma Inline
(Is_Extending_All
);
282 -- Only valid for N_Project and N_With_Clause
284 function First_Variable_Of
285 (Node
: Project_Node_Id
;
286 In_Tree
: Project_Node_Tree_Ref
) return Variable_Node_Id
;
287 pragma Inline
(First_Variable_Of
);
288 -- Only valid for N_Project or N_Package_Declaration nodes
290 function First_Package_Of
291 (Node
: Project_Node_Id
;
292 In_Tree
: Project_Node_Tree_Ref
) return Package_Declaration_Id
;
293 pragma Inline
(First_Package_Of
);
294 -- Only valid for N_Project nodes
296 function Package_Id_Of
297 (Node
: Project_Node_Id
;
298 In_Tree
: Project_Node_Tree_Ref
) return Package_Node_Id
;
299 pragma Inline
(Package_Id_Of
);
300 -- Only valid for N_Package_Declaration nodes
302 function Path_Name_Of
303 (Node
: Project_Node_Id
;
304 In_Tree
: Project_Node_Tree_Ref
) return Name_Id
;
305 pragma Inline
(Path_Name_Of
);
306 -- Only valid for N_Project and N_With_Clause nodes
308 function String_Value_Of
309 (Node
: Project_Node_Id
;
310 In_Tree
: Project_Node_Tree_Ref
) return Name_Id
;
311 pragma Inline
(String_Value_Of
);
312 -- Only valid for N_With_Clause, N_Literal_String nodes or N_Comment
314 function Source_Index_Of
315 (Node
: Project_Node_Id
;
316 In_Tree
: Project_Node_Tree_Ref
) return Int
;
317 pragma Inline
(Source_Index_Of
);
318 -- Only valid for N_Literal_String and N_Attribute_Declaration nodes
320 function First_With_Clause_Of
321 (Node
: Project_Node_Id
;
322 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
323 pragma Inline
(First_With_Clause_Of
);
324 -- Only valid for N_Project nodes
326 function Project_Declaration_Of
327 (Node
: Project_Node_Id
;
328 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
329 pragma Inline
(Project_Declaration_Of
);
330 -- Only valid for N_Project nodes
332 function Extending_Project_Of
333 (Node
: Project_Node_Id
;
334 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
335 pragma Inline
(Extending_Project_Of
);
336 -- Only valid for N_Project_Declaration nodes
338 function First_String_Type_Of
339 (Node
: Project_Node_Id
;
340 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
341 pragma Inline
(First_String_Type_Of
);
342 -- Only valid for N_Project nodes
344 function Extended_Project_Path_Of
345 (Node
: Project_Node_Id
;
346 In_Tree
: Project_Node_Tree_Ref
) return Name_Id
;
347 pragma Inline
(Extended_Project_Path_Of
);
348 -- Only valid for N_With_Clause nodes
350 function Project_Node_Of
351 (Node
: Project_Node_Id
;
352 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
353 pragma Inline
(Project_Node_Of
);
354 -- Only valid for N_With_Clause, N_Variable_Reference and
355 -- N_Attribute_Reference nodes.
357 function Non_Limited_Project_Node_Of
358 (Node
: Project_Node_Id
;
359 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
360 pragma Inline
(Non_Limited_Project_Node_Of
);
361 -- Only valid for N_With_Clause nodes. Returns Empty_Node for limited
362 -- imported project files, otherwise returns the same result as
365 function Next_With_Clause_Of
366 (Node
: Project_Node_Id
;
367 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
368 pragma Inline
(Next_With_Clause_Of
);
369 -- Only valid for N_With_Clause nodes
371 function First_Declarative_Item_Of
372 (Node
: Project_Node_Id
;
373 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
374 pragma Inline
(First_Declarative_Item_Of
);
375 -- Only valid for N_With_Clause nodes
377 function Extended_Project_Of
378 (Node
: Project_Node_Id
;
379 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
380 pragma Inline
(Extended_Project_Of
);
381 -- Only valid for N_Project_Declaration nodes
383 function Current_Item_Node
384 (Node
: Project_Node_Id
;
385 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
386 pragma Inline
(Current_Item_Node
);
387 -- Only valid for N_Declarative_Item nodes
389 function Next_Declarative_Item
390 (Node
: Project_Node_Id
;
391 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
392 pragma Inline
(Next_Declarative_Item
);
393 -- Only valid for N_Declarative_Item node
395 function Project_Of_Renamed_Package_Of
396 (Node
: Project_Node_Id
;
397 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
398 pragma Inline
(Project_Of_Renamed_Package_Of
);
399 -- Only valid for N_Package_Declaration nodes.
400 -- May return Empty_Node.
402 function Next_Package_In_Project
403 (Node
: Project_Node_Id
;
404 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
405 pragma Inline
(Next_Package_In_Project
);
406 -- Only valid for N_Package_Declaration nodes
408 function First_Literal_String
409 (Node
: Project_Node_Id
;
410 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
411 pragma Inline
(First_Literal_String
);
412 -- Only valid for N_String_Type_Declaration nodes
414 function Next_String_Type
415 (Node
: Project_Node_Id
;
416 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
417 pragma Inline
(Next_String_Type
);
418 -- Only valid for N_String_Type_Declaration nodes
420 function Next_Literal_String
421 (Node
: Project_Node_Id
;
422 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
423 pragma Inline
(Next_Literal_String
);
424 -- Only valid for N_Literal_String nodes
426 function Expression_Of
427 (Node
: Project_Node_Id
;
428 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
429 pragma Inline
(Expression_Of
);
430 -- Only valid for N_Attribute_Declaration, N_Typed_Variable_Declaration
431 -- or N_Variable_Declaration nodes
433 function Associative_Project_Of
434 (Node
: Project_Node_Id
;
435 In_Tree
: Project_Node_Tree_Ref
)
436 return Project_Node_Id
;
437 pragma Inline
(Associative_Project_Of
);
438 -- Only valid for N_Attribute_Declaration nodes
440 function Associative_Package_Of
441 (Node
: Project_Node_Id
;
442 In_Tree
: Project_Node_Tree_Ref
)
443 return Project_Node_Id
;
444 pragma Inline
(Associative_Package_Of
);
445 -- Only valid for N_Attribute_Declaration nodes
447 function Value_Is_Valid
448 (For_Typed_Variable
: Project_Node_Id
;
449 In_Tree
: Project_Node_Tree_Ref
;
450 Value
: Name_Id
) return Boolean;
451 pragma Inline
(Value_Is_Valid
);
452 -- Only valid for N_Typed_Variable_Declaration. Returns True if Value is
453 -- in the list of allowed strings for For_Typed_Variable. False otherwise.
455 function Associative_Array_Index_Of
456 (Node
: Project_Node_Id
;
457 In_Tree
: Project_Node_Tree_Ref
) return Name_Id
;
458 pragma Inline
(Associative_Array_Index_Of
);
459 -- Only valid for N_Attribute_Declaration and N_Attribute_Reference.
460 -- Returns No_String for non associative array attributes.
462 function Next_Variable
463 (Node
: Project_Node_Id
;
464 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
465 pragma Inline
(Next_Variable
);
466 -- Only valid for N_Typed_Variable_Declaration or N_Variable_Declaration
470 (Node
: Project_Node_Id
;
471 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
472 pragma Inline
(First_Term
);
473 -- Only valid for N_Expression nodes
475 function Next_Expression_In_List
476 (Node
: Project_Node_Id
;
477 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
478 pragma Inline
(Next_Expression_In_List
);
479 -- Only valid for N_Expression nodes
481 function Current_Term
482 (Node
: Project_Node_Id
;
483 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
484 pragma Inline
(Current_Term
);
485 -- Only valid for N_Term nodes
488 (Node
: Project_Node_Id
;
489 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
490 pragma Inline
(Next_Term
);
491 -- Only valid for N_Term nodes
493 function First_Expression_In_List
494 (Node
: Project_Node_Id
;
495 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
496 pragma Inline
(First_Expression_In_List
);
497 -- Only valid for N_Literal_String_List nodes
499 function Package_Node_Of
500 (Node
: Project_Node_Id
;
501 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
502 pragma Inline
(Package_Node_Of
);
503 -- Only valid for N_Variable_Reference or N_Attribute_Reference nodes.
504 -- May return Empty_Node.
506 function String_Type_Of
507 (Node
: Project_Node_Id
;
508 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
509 pragma Inline
(String_Type_Of
);
510 -- Only valid for N_Variable_Reference or N_Typed_Variable_Declaration
513 function External_Reference_Of
514 (Node
: Project_Node_Id
;
515 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
516 pragma Inline
(External_Reference_Of
);
517 -- Only valid for N_External_Value nodes
519 function External_Default_Of
520 (Node
: Project_Node_Id
;
521 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
522 pragma Inline
(External_Default_Of
);
523 -- Only valid for N_External_Value nodes
525 function Case_Variable_Reference_Of
526 (Node
: Project_Node_Id
;
527 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
528 pragma Inline
(Case_Variable_Reference_Of
);
529 -- Only valid for N_Case_Construction nodes
531 function First_Case_Item_Of
532 (Node
: Project_Node_Id
;
533 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
534 pragma Inline
(First_Case_Item_Of
);
535 -- Only valid for N_Case_Construction nodes
537 function First_Choice_Of
538 (Node
: Project_Node_Id
;
539 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
540 pragma Inline
(First_Choice_Of
);
541 -- Return the first choice in a N_Case_Item, or Empty_Node if
542 -- this is when others.
544 function Next_Case_Item
545 (Node
: Project_Node_Id
;
546 In_Tree
: Project_Node_Tree_Ref
) return Project_Node_Id
;
547 pragma Inline
(Next_Case_Item
);
548 -- Only valid for N_Case_Item nodes
550 function Case_Insensitive
551 (Node
: Project_Node_Id
;
552 In_Tree
: Project_Node_Tree_Ref
) return Boolean;
553 -- Only valid for N_Attribute_Declaration and N_Attribute_Reference nodes
559 -- The following procedures are part of the abstract interface of
560 -- the Project File tree.
562 -- Each Set_* procedure is valid only for the same Project_Node_Kind
563 -- nodes as the corresponding query function above.
565 procedure Set_Name_Of
566 (Node
: Project_Node_Id
;
567 In_Tree
: Project_Node_Tree_Ref
;
569 pragma Inline
(Set_Name_Of
);
571 procedure Set_Kind_Of
572 (Node
: Project_Node_Id
;
573 In_Tree
: Project_Node_Tree_Ref
;
574 To
: Project_Node_Kind
);
575 pragma Inline
(Set_Kind_Of
);
577 procedure Set_Location_Of
578 (Node
: Project_Node_Id
;
579 In_Tree
: Project_Node_Tree_Ref
;
581 pragma Inline
(Set_Location_Of
);
583 procedure Set_First_Comment_After
584 (Node
: Project_Node_Id
;
585 In_Tree
: Project_Node_Tree_Ref
;
586 To
: Project_Node_Id
);
587 pragma Inline
(Set_First_Comment_After
);
589 procedure Set_First_Comment_After_End
590 (Node
: Project_Node_Id
;
591 In_Tree
: Project_Node_Tree_Ref
;
592 To
: Project_Node_Id
);
593 pragma Inline
(Set_First_Comment_After_End
);
595 procedure Set_First_Comment_Before
596 (Node
: Project_Node_Id
;
597 In_Tree
: Project_Node_Tree_Ref
;
598 To
: Project_Node_Id
);
599 pragma Inline
(Set_First_Comment_Before
);
601 procedure Set_First_Comment_Before_End
602 (Node
: Project_Node_Id
;
603 In_Tree
: Project_Node_Tree_Ref
;
604 To
: Project_Node_Id
);
605 pragma Inline
(Set_First_Comment_Before_End
);
607 procedure Set_Next_Comment
608 (Node
: Project_Node_Id
;
609 In_Tree
: Project_Node_Tree_Ref
;
610 To
: Project_Node_Id
);
611 pragma Inline
(Set_Next_Comment
);
613 procedure Set_Project_File_Includes_Unkept_Comments
614 (Node
: Project_Node_Id
;
615 In_Tree
: Project_Node_Tree_Ref
;
618 procedure Set_Directory_Of
619 (Node
: Project_Node_Id
;
620 In_Tree
: Project_Node_Tree_Ref
;
622 pragma Inline
(Set_Directory_Of
);
624 procedure Set_Expression_Kind_Of
625 (Node
: Project_Node_Id
;
626 In_Tree
: Project_Node_Tree_Ref
;
628 pragma Inline
(Set_Expression_Kind_Of
);
630 procedure Set_Is_Extending_All
631 (Node
: Project_Node_Id
;
632 In_Tree
: Project_Node_Tree_Ref
);
633 pragma Inline
(Set_Is_Extending_All
);
635 procedure Set_First_Variable_Of
636 (Node
: Project_Node_Id
;
637 In_Tree
: Project_Node_Tree_Ref
;
638 To
: Variable_Node_Id
);
639 pragma Inline
(Set_First_Variable_Of
);
641 procedure Set_First_Package_Of
642 (Node
: Project_Node_Id
;
643 In_Tree
: Project_Node_Tree_Ref
;
644 To
: Package_Declaration_Id
);
645 pragma Inline
(Set_First_Package_Of
);
647 procedure Set_Package_Id_Of
648 (Node
: Project_Node_Id
;
649 In_Tree
: Project_Node_Tree_Ref
;
650 To
: Package_Node_Id
);
651 pragma Inline
(Set_Package_Id_Of
);
653 procedure Set_Path_Name_Of
654 (Node
: Project_Node_Id
;
655 In_Tree
: Project_Node_Tree_Ref
;
657 pragma Inline
(Set_Path_Name_Of
);
659 procedure Set_String_Value_Of
660 (Node
: Project_Node_Id
;
661 In_Tree
: Project_Node_Tree_Ref
;
663 pragma Inline
(Set_String_Value_Of
);
665 procedure Set_First_With_Clause_Of
666 (Node
: Project_Node_Id
;
667 In_Tree
: Project_Node_Tree_Ref
;
668 To
: Project_Node_Id
);
669 pragma Inline
(Set_First_With_Clause_Of
);
671 procedure Set_Project_Declaration_Of
672 (Node
: Project_Node_Id
;
673 In_Tree
: Project_Node_Tree_Ref
;
674 To
: Project_Node_Id
);
675 pragma Inline
(Set_Project_Declaration_Of
);
677 procedure Set_Extending_Project_Of
678 (Node
: Project_Node_Id
;
679 In_Tree
: Project_Node_Tree_Ref
;
680 To
: Project_Node_Id
);
681 pragma Inline
(Set_Extending_Project_Of
);
683 procedure Set_First_String_Type_Of
684 (Node
: Project_Node_Id
;
685 In_Tree
: Project_Node_Tree_Ref
;
686 To
: Project_Node_Id
);
687 pragma Inline
(Set_First_String_Type_Of
);
689 procedure Set_Extended_Project_Path_Of
690 (Node
: Project_Node_Id
;
691 In_Tree
: Project_Node_Tree_Ref
;
693 pragma Inline
(Set_Extended_Project_Path_Of
);
695 procedure Set_Project_Node_Of
696 (Node
: Project_Node_Id
;
697 In_Tree
: Project_Node_Tree_Ref
;
698 To
: Project_Node_Id
;
699 Limited_With
: Boolean := False);
700 pragma Inline
(Set_Project_Node_Of
);
702 procedure Set_Next_With_Clause_Of
703 (Node
: Project_Node_Id
;
704 In_Tree
: Project_Node_Tree_Ref
;
705 To
: Project_Node_Id
);
706 pragma Inline
(Set_Next_With_Clause_Of
);
708 procedure Set_First_Declarative_Item_Of
709 (Node
: Project_Node_Id
;
710 In_Tree
: Project_Node_Tree_Ref
;
711 To
: Project_Node_Id
);
712 pragma Inline
(Set_First_Declarative_Item_Of
);
714 procedure Set_Extended_Project_Of
715 (Node
: Project_Node_Id
;
716 In_Tree
: Project_Node_Tree_Ref
;
717 To
: Project_Node_Id
);
718 pragma Inline
(Set_Extended_Project_Of
);
720 procedure Set_Current_Item_Node
721 (Node
: Project_Node_Id
;
722 In_Tree
: Project_Node_Tree_Ref
;
723 To
: Project_Node_Id
);
724 pragma Inline
(Set_Current_Item_Node
);
726 procedure Set_Next_Declarative_Item
727 (Node
: Project_Node_Id
;
728 In_Tree
: Project_Node_Tree_Ref
;
729 To
: Project_Node_Id
);
730 pragma Inline
(Set_Next_Declarative_Item
);
732 procedure Set_Project_Of_Renamed_Package_Of
733 (Node
: Project_Node_Id
;
734 In_Tree
: Project_Node_Tree_Ref
;
735 To
: Project_Node_Id
);
736 pragma Inline
(Set_Project_Of_Renamed_Package_Of
);
738 procedure Set_Next_Package_In_Project
739 (Node
: Project_Node_Id
;
740 In_Tree
: Project_Node_Tree_Ref
;
741 To
: Project_Node_Id
);
742 pragma Inline
(Set_Next_Package_In_Project
);
744 procedure Set_First_Literal_String
745 (Node
: Project_Node_Id
;
746 In_Tree
: Project_Node_Tree_Ref
;
747 To
: Project_Node_Id
);
748 pragma Inline
(Set_First_Literal_String
);
750 procedure Set_Next_String_Type
751 (Node
: Project_Node_Id
;
752 In_Tree
: Project_Node_Tree_Ref
;
753 To
: Project_Node_Id
);
754 pragma Inline
(Set_Next_String_Type
);
756 procedure Set_Next_Literal_String
757 (Node
: Project_Node_Id
;
758 In_Tree
: Project_Node_Tree_Ref
;
759 To
: Project_Node_Id
);
760 pragma Inline
(Set_Next_Literal_String
);
762 procedure Set_Expression_Of
763 (Node
: Project_Node_Id
;
764 In_Tree
: Project_Node_Tree_Ref
;
765 To
: Project_Node_Id
);
766 pragma Inline
(Set_Expression_Of
);
768 procedure Set_Associative_Project_Of
769 (Node
: Project_Node_Id
;
770 In_Tree
: Project_Node_Tree_Ref
;
771 To
: Project_Node_Id
);
772 pragma Inline
(Set_Associative_Project_Of
);
774 procedure Set_Associative_Package_Of
775 (Node
: Project_Node_Id
;
776 In_Tree
: Project_Node_Tree_Ref
;
777 To
: Project_Node_Id
);
778 pragma Inline
(Set_Associative_Package_Of
);
780 procedure Set_Associative_Array_Index_Of
781 (Node
: Project_Node_Id
;
782 In_Tree
: Project_Node_Tree_Ref
;
784 pragma Inline
(Set_Associative_Array_Index_Of
);
786 procedure Set_Next_Variable
787 (Node
: Project_Node_Id
;
788 In_Tree
: Project_Node_Tree_Ref
;
789 To
: Project_Node_Id
);
790 pragma Inline
(Set_Next_Variable
);
792 procedure Set_First_Term
793 (Node
: Project_Node_Id
;
794 In_Tree
: Project_Node_Tree_Ref
;
795 To
: Project_Node_Id
);
796 pragma Inline
(Set_First_Term
);
798 procedure Set_Next_Expression_In_List
799 (Node
: Project_Node_Id
;
800 In_Tree
: Project_Node_Tree_Ref
;
801 To
: Project_Node_Id
);
802 pragma Inline
(Set_Next_Expression_In_List
);
804 procedure Set_Current_Term
805 (Node
: Project_Node_Id
;
806 In_Tree
: Project_Node_Tree_Ref
;
807 To
: Project_Node_Id
);
808 pragma Inline
(Set_Current_Term
);
810 procedure Set_Next_Term
811 (Node
: Project_Node_Id
;
812 In_Tree
: Project_Node_Tree_Ref
;
813 To
: Project_Node_Id
);
814 pragma Inline
(Set_Next_Term
);
816 procedure Set_First_Expression_In_List
817 (Node
: Project_Node_Id
;
818 In_Tree
: Project_Node_Tree_Ref
;
819 To
: Project_Node_Id
);
820 pragma Inline
(Set_First_Expression_In_List
);
822 procedure Set_Package_Node_Of
823 (Node
: Project_Node_Id
;
824 In_Tree
: Project_Node_Tree_Ref
;
825 To
: Project_Node_Id
);
826 pragma Inline
(Set_Package_Node_Of
);
828 procedure Set_Source_Index_Of
829 (Node
: Project_Node_Id
;
830 In_Tree
: Project_Node_Tree_Ref
;
832 pragma Inline
(Set_Source_Index_Of
);
834 procedure Set_String_Type_Of
835 (Node
: Project_Node_Id
;
836 In_Tree
: Project_Node_Tree_Ref
;
837 To
: Project_Node_Id
);
838 pragma Inline
(Set_String_Type_Of
);
840 procedure Set_External_Reference_Of
841 (Node
: Project_Node_Id
;
842 In_Tree
: Project_Node_Tree_Ref
;
843 To
: Project_Node_Id
);
844 pragma Inline
(Set_External_Reference_Of
);
846 procedure Set_External_Default_Of
847 (Node
: Project_Node_Id
;
848 In_Tree
: Project_Node_Tree_Ref
;
849 To
: Project_Node_Id
);
850 pragma Inline
(Set_External_Default_Of
);
852 procedure Set_Case_Variable_Reference_Of
853 (Node
: Project_Node_Id
;
854 In_Tree
: Project_Node_Tree_Ref
;
855 To
: Project_Node_Id
);
856 pragma Inline
(Set_Case_Variable_Reference_Of
);
858 procedure Set_First_Case_Item_Of
859 (Node
: Project_Node_Id
;
860 In_Tree
: Project_Node_Tree_Ref
;
861 To
: Project_Node_Id
);
862 pragma Inline
(Set_First_Case_Item_Of
);
864 procedure Set_First_Choice_Of
865 (Node
: Project_Node_Id
;
866 In_Tree
: Project_Node_Tree_Ref
;
867 To
: Project_Node_Id
);
868 pragma Inline
(Set_First_Choice_Of
);
870 procedure Set_Next_Case_Item
871 (Node
: Project_Node_Id
;
872 In_Tree
: Project_Node_Tree_Ref
;
873 To
: Project_Node_Id
);
874 pragma Inline
(Set_Next_Case_Item
);
876 procedure Set_Case_Insensitive
877 (Node
: Project_Node_Id
;
878 In_Tree
: Project_Node_Tree_Ref
;
881 -------------------------------
882 -- Restricted Access Section --
883 -------------------------------
885 package Tree_Private_Part
is
887 -- This is conceptually in the private part.
888 -- However, for efficiency, some packages are accessing it directly.
890 type Project_Node_Record
is record
892 Kind
: Project_Node_Kind
;
894 Location
: Source_Ptr
:= No_Location
;
896 Directory
: Name_Id
:= No_Name
;
897 -- Only for N_Project
899 Expr_Kind
: Variable_Kind
:= Undefined
;
900 -- See below for what Project_Node_Kind it is used
902 Variables
: Variable_Node_Id
:= Empty_Node
;
903 -- First variable in a project or a package
905 Packages
: Package_Declaration_Id
:= Empty_Node
;
906 -- First package declaration in a project
908 Pkg_Id
: Package_Node_Id
:= Empty_Package
;
909 -- Only used for N_Package_Declaration
910 -- The component Pkg_Id is an entry into the table Package_Attributes
911 -- (in Prj.Attr). It is used to indicate all the attributes of the
912 -- package with their characteristics.
914 -- The tables Prj.Attr.Attributes and Prj.Attr.Package_Attributes
915 -- are built once and for all through a call (from Prj.Initialize)
916 -- to procedure Prj.Attr.Initialize. It is never modified after that.
918 Name
: Name_Id
:= No_Name
;
919 -- See below for what Project_Node_Kind it is used
921 Src_Index
: Int
:= 0;
922 -- Index of a unit in a multi-unit source.
923 -- Onli for some N_Attribute_Declaration and N_Literal_String.
925 Path_Name
: Name_Id
:= No_Name
;
926 -- See below for what Project_Node_Kind it is used
928 Value
: Name_Id
:= No_Name
;
929 -- See below for what Project_Node_Kind it is used
931 Field1
: Project_Node_Id
:= Empty_Node
;
932 -- See below the meaning for each Project_Node_Kind
934 Field2
: Project_Node_Id
:= Empty_Node
;
935 -- See below the meaning for each Project_Node_Kind
937 Field3
: Project_Node_Id
:= Empty_Node
;
938 -- See below the meaning for each Project_Node_Kind
940 Flag1
: Boolean := False;
941 -- This flag is significant only for:
942 -- N_Attribute_Declaration and N_Atribute_Reference
943 -- It indicates for an associative array attribute, that the
944 -- index is case insensitive.
945 -- N_Comment - it indicates that the comment is preceded by an
947 -- N_Project - it indicates that there are comments in the project
948 -- source that cannot be kept in the tree.
949 -- N_Project_Declaration
950 -- - it indicates that there are unkept comments in the
953 Flag2
: Boolean := False;
954 -- This flag is significant only for:
955 -- N_Project - it indicates that the project "extends all" another
957 -- N_Comment - it indicates that the comment is followed by an
960 -- - it indicates that the originally imported project
961 -- is an extending all project.
963 Comments
: Project_Node_Id
:= Empty_Node
;
964 -- For nodes other that N_Comment_Zones or N_Comment, designates the
965 -- comment zones associated with the node.
966 -- for N_Comment_Zones, designates the comment after the "end" of
968 -- For N_Comment, designates the next comment, if any.
972 -- type Project_Node_Kind is
975 -- -- Name: project name
976 -- -- Path_Name: project path name
977 -- -- Expr_Kind: Undefined
978 -- -- Field1: first with clause
979 -- -- Field2: project declaration
980 -- -- Field3: first string type
981 -- -- Value: extended project path name (if any)
984 -- -- Name: imported project name
985 -- -- Path_Name: imported project path name
986 -- -- Expr_Kind: Undefined
987 -- -- Field1: project node
988 -- -- Field2: next with clause
989 -- -- Field3: project node or empty if "limited with"
990 -- -- Value: literal string withed
992 -- N_Project_Declaration,
994 -- -- Path_Name: not used
995 -- -- Expr_Kind: Undefined
996 -- -- Field1: first declarative item
997 -- -- Field2: extended project
998 -- -- Field3: extending project
999 -- -- Value: not used
1001 -- N_Declarative_Item,
1002 -- -- Name: not used
1003 -- -- Path_Name: not used
1004 -- -- Expr_Kind: Undefined
1005 -- -- Field1: current item node
1006 -- -- Field2: next declarative item
1007 -- -- Field3: not used
1008 -- -- Value: not used
1010 -- N_Package_Declaration,
1011 -- -- Name: package name
1012 -- -- Path_Name: not used
1013 -- -- Expr_Kind: Undefined
1014 -- -- Field1: project of renamed package (if any)
1015 -- -- Field2: first declarative item
1016 -- -- Field3: next package in project
1017 -- -- Value: not used
1019 -- N_String_Type_Declaration,
1020 -- -- Name: type name
1021 -- -- Path_Name: not used
1022 -- -- Expr_Kind: Undefined
1023 -- -- Field1: first literal string
1024 -- -- Field2: next string type
1025 -- -- Field3: not used
1026 -- -- Value: not used
1028 -- N_Literal_String,
1029 -- -- Name: not used
1030 -- -- Path_Name: not used
1031 -- -- Expr_Kind: Single
1032 -- -- Field1: next literal string
1033 -- -- Field2: not used
1034 -- -- Field3: not used
1035 -- -- Value: string value
1037 -- N_Attribute_Declaration,
1038 -- -- Name: attribute name
1039 -- -- Path_Name: not used
1040 -- -- Expr_Kind: attribute kind
1041 -- -- Field1: expression
1042 -- -- Field2: project of full associative array
1043 -- -- Field3: package of full associative array
1044 -- -- Value: associative array index
1045 -- -- (if an associative array element)
1047 -- N_Typed_Variable_Declaration,
1048 -- -- Name: variable name
1049 -- -- Path_Name: not used
1050 -- -- Expr_Kind: Single
1051 -- -- Field1: expression
1052 -- -- Field2: type of variable (N_String_Type_Declaration)
1053 -- -- Field3: next variable
1054 -- -- Value: not used
1056 -- N_Variable_Declaration,
1057 -- -- Name: variable name
1058 -- -- Path_Name: not used
1059 -- -- Expr_Kind: variable kind
1060 -- -- Field1: expression
1061 -- -- Field2: not used
1062 -- -- Field3 is used for next variable, instead of Field2,
1063 -- -- so that it is the same field for
1064 -- -- N_Variable_Declaration and
1065 -- -- N_Typed_Variable_Declaration
1066 -- -- Field3: next variable
1067 -- -- Value: not used
1070 -- -- Name: not used
1071 -- -- Path_Name: not used
1072 -- -- Expr_Kind: expression kind
1073 -- -- Field1: first term
1074 -- -- Field2: next expression in list
1075 -- -- Field3: not used
1076 -- -- Value: not used
1079 -- -- Name: not used
1080 -- -- Path_Name: not used
1081 -- -- Expr_Kind: term kind
1082 -- -- Field1: current term
1083 -- -- Field2: next term in the expression
1084 -- -- Field3: not used
1085 -- -- Value: not used
1087 -- N_Literal_String_List,
1088 -- -- Designates a list of string expressions between brackets
1089 -- -- separated by commas. The string expressions are not necessarily
1090 -- -- literal strings.
1091 -- -- Name: not used
1092 -- -- Path_Name: not used
1093 -- -- Expr_Kind: List
1094 -- -- Field1: first expression
1095 -- -- Field2: not used
1096 -- -- Field3: not used
1097 -- -- Value: not used
1099 -- N_Variable_Reference,
1100 -- -- Name: variable name
1101 -- -- Path_Name: not used
1102 -- -- Expr_Kind: variable kind
1103 -- -- Field1: project (if specified)
1104 -- -- Field2: package (if specified)
1105 -- -- Field3: type of variable (N_String_Type_Declaration), if any
1106 -- -- Value: not used
1108 -- N_External_Value,
1109 -- -- Name: not used
1110 -- -- Path_Name: not used
1111 -- -- Expr_Kind: Single
1112 -- -- Field1: Name of the external reference (literal string)
1113 -- -- Field2: Default (literal string)
1114 -- -- Field3: not used
1115 -- -- Value: not used
1117 -- N_Attribute_Reference,
1118 -- -- Name: attribute name
1119 -- -- Path_Name: not used
1120 -- -- Expr_Kind: attribute kind
1121 -- -- Field1: project
1122 -- -- Field2: package (if attribute of a package)
1123 -- -- Field3: not used
1124 -- -- Value: associative array index
1125 -- -- (if an associative array element)
1127 -- N_Case_Construction,
1128 -- -- Name: not used
1129 -- -- Path_Name: not used
1130 -- -- Expr_Kind: Undefined
1131 -- -- Field1: case variable reference
1132 -- -- Field2: first case item
1133 -- -- Field3: not used
1134 -- -- Value: not used
1137 -- -- Name: not used
1138 -- -- Path_Name: not used
1139 -- -- Expr_Kind: not used
1140 -- -- Field1: first choice (literal string), or Empty_Node
1141 -- -- for when others
1142 -- -- Field2: first declarative item
1143 -- -- Field3: next case item
1144 -- -- Value: not used
1147 -- -- Name: not used
1148 -- -- Path_Name: not used
1149 -- -- Expr_Kind: not used
1150 -- -- Field1: comment before the construct
1151 -- -- Field2: comment after the construct
1152 -- -- Field3: comment before the "end" of the construct
1153 -- -- Value: end of line comment
1154 -- -- Comments: comment after the "end" of the construct
1157 -- -- Name: not used
1158 -- -- Path_Name: not used
1159 -- -- Expr_Kind: not used
1160 -- -- Field1: not used
1161 -- -- Field2: not used
1162 -- -- Field3: not used
1163 -- -- Value: comment
1164 -- -- Flag1: comment is preceded by an empty line
1165 -- -- Flag2: comment is followed by an empty line
1166 -- -- Comments: next comment
1168 package Project_Node_Table
is
1169 new GNAT
.Dynamic_Tables
1170 (Table_Component_Type
=> Project_Node_Record
,
1171 Table_Index_Type
=> Project_Node_Id
,
1172 Table_Low_Bound
=> First_Node_Id
,
1173 Table_Initial
=> Project_Nodes_Initial
,
1174 Table_Increment
=> Project_Nodes_Increment
);
1175 -- This table contains the syntactic tree of project data
1176 -- from project files.
1178 type Project_Name_And_Node
is record
1180 -- Name of the project
1182 Node
: Project_Node_Id
;
1183 -- Node of the project in table Project_Nodes
1185 Canonical_Path
: Name_Id
;
1186 -- Resolved and canonical path of the project file
1189 -- True when the project is being extended by another project
1192 No_Project_Name_And_Node
: constant Project_Name_And_Node
:=
1195 Canonical_Path
=> No_Name
,
1198 package Projects_Htable
is new GNAT
.Dynamic_HTables
.Simple_HTable
1199 (Header_Num
=> Header_Num
,
1200 Element
=> Project_Name_And_Node
,
1201 No_Element
=> No_Project_Name_And_Node
,
1205 -- This hash table contains a mapping of project names to project nodes.
1206 -- Note that this hash table contains only the nodes whose Kind is
1207 -- N_Project. It is used to find the node of a project from its
1208 -- name, and to verify if a project has already been parsed, knowing
1211 end Tree_Private_Part
;
1213 type Project_Node_Tree_Data
is record
1214 Project_Nodes
: Tree_Private_Part
.Project_Node_Table
.Instance
;
1215 Projects_HT
: Tree_Private_Part
.Projects_Htable
.Instance
;
1217 -- The data for a project node tree
1220 type Comment_Array
is array (Positive range <>) of Comment_Data
;
1221 type Comments_Ptr
is access Comment_Array
;
1223 type Comment_State
is record
1224 End_Of_Line_Node
: Project_Node_Id
:= Empty_Node
;
1226 Previous_Line_Node
: Project_Node_Id
:= Empty_Node
;
1228 Previous_End_Node
: Project_Node_Id
:= Empty_Node
;
1230 Unkept_Comments
: Boolean := False;
1232 Comments
: Comments_Ptr
:= null;