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 ------------------------------------------------------------------------------
29 package body Prj
.Tree
is
31 Node_With_Comments
: constant array (Project_Node_Kind
) of Boolean :=
33 N_With_Clause
=> True,
34 N_Project_Declaration
=> False,
35 N_Declarative_Item
=> False,
36 N_Package_Declaration
=> True,
37 N_String_Type_Declaration
=> True,
38 N_Literal_String
=> False,
39 N_Attribute_Declaration
=> True,
40 N_Typed_Variable_Declaration
=> True,
41 N_Variable_Declaration
=> True,
42 N_Expression
=> False,
44 N_Literal_String_List
=> False,
45 N_Variable_Reference
=> False,
46 N_External_Value
=> False,
47 N_Attribute_Reference
=> False,
48 N_Case_Construction
=> True,
50 N_Comment_Zones
=> True,
52 -- Indicates the kinds of node that may have associated comments
54 package Next_End_Nodes
is new Table
.Table
55 (Table_Component_Type
=> Project_Node_Id
,
56 Table_Index_Type
=> Natural,
59 Table_Increment
=> 100,
60 Table_Name
=> "Next_End_Nodes");
61 -- A stack of nodes to indicates to what node the next "end" is associated
63 use Tree_Private_Part
;
65 End_Of_Line_Node
: Project_Node_Id
:= Empty_Node
;
66 -- The node an end of line comment may be associated with
68 Previous_Line_Node
: Project_Node_Id
:= Empty_Node
;
69 -- The node an immediately following comment may be associated with
71 Previous_End_Node
: Project_Node_Id
:= Empty_Node
;
72 -- The node comments immediately following an "end" line may be
75 Unkept_Comments
: Boolean := False;
76 -- Set to True when some comments may not be associated with any node
78 function Comment_Zones_Of
79 (Node
: Project_Node_Id
) return Project_Node_Id
;
80 -- Returns the ID of the N_Comment_Zones node associated with node Node.
81 -- If there is not already an N_Comment_Zones node, create one and
82 -- associate it with node Node.
88 procedure Add_Comments
(To
: Project_Node_Id
; Where
: Comment_Location
) is
89 Zone
: Project_Node_Id
:= Empty_Node
;
90 Previous
: Project_Node_Id
:= Empty_Node
;
96 Project_Nodes
.Table
(To
).Kind
/= N_Comment
);
98 Zone
:= Project_Nodes
.Table
(To
).Comments
;
100 if Zone
= Empty_Node
then
102 -- Create new N_Comment_Zones node
104 Project_Nodes
.Increment_Last
;
105 Project_Nodes
.Table
(Project_Nodes
.Last
) :=
106 (Kind
=> N_Comment_Zones
,
107 Expr_Kind
=> Undefined
,
108 Location
=> No_Location
,
109 Directory
=> No_Name
,
110 Variables
=> Empty_Node
,
111 Packages
=> Empty_Node
,
112 Pkg_Id
=> Empty_Package
,
115 Path_Name
=> No_Name
,
117 Field1
=> Empty_Node
,
118 Field2
=> Empty_Node
,
119 Field3
=> Empty_Node
,
122 Comments
=> Empty_Node
);
124 Zone
:= Project_Nodes
.Last
;
125 Project_Nodes
.Table
(To
).Comments
:= Zone
;
128 if Where
= End_Of_Line
then
129 Project_Nodes
.Table
(Zone
).Value
:= Comments
.Table
(1).Value
;
132 -- Get each comments in the Comments table and link them to node To
134 for J
in 1 .. Comments
.Last
loop
136 -- Create new N_Comment node
138 if (Where
= After
or else Where
= After_End
) and then
139 Token
/= Tok_EOF
and then
140 Comments
.Table
(J
).Follows_Empty_Line
142 Comments
.Table
(1 .. Comments
.Last
- J
+ 1) :=
143 Comments
.Table
(J
.. Comments
.Last
);
144 Comments
.Set_Last
(Comments
.Last
- J
+ 1);
148 Project_Nodes
.Increment_Last
;
149 Project_Nodes
.Table
(Project_Nodes
.Last
) :=
151 Expr_Kind
=> Undefined
,
152 Flag1
=> Comments
.Table
(J
).Follows_Empty_Line
,
154 Comments
.Table
(J
).Is_Followed_By_Empty_Line
,
155 Location
=> No_Location
,
156 Directory
=> No_Name
,
157 Variables
=> Empty_Node
,
158 Packages
=> Empty_Node
,
159 Pkg_Id
=> Empty_Package
,
162 Path_Name
=> No_Name
,
163 Value
=> Comments
.Table
(J
).Value
,
164 Field1
=> Empty_Node
,
165 Field2
=> Empty_Node
,
166 Field3
=> Empty_Node
,
167 Comments
=> Empty_Node
);
169 -- If this is the first comment, put it in the right field of
172 if Previous
= Empty_Node
then
175 Project_Nodes
.Table
(Zone
).Field1
:= Project_Nodes
.Last
;
178 Project_Nodes
.Table
(Zone
).Field2
:= Project_Nodes
.Last
;
181 Project_Nodes
.Table
(Zone
).Field3
:= Project_Nodes
.Last
;
184 Project_Nodes
.Table
(Zone
).Comments
:= Project_Nodes
.Last
;
191 -- When it is not the first, link it to the previous one
193 Project_Nodes
.Table
(Previous
).Comments
:= Project_Nodes
.Last
;
196 -- This node becomes the previous one for the next comment, if
199 Previous
:= Project_Nodes
.Last
;
203 -- Empty the Comments table, so that there is no risk to link the same
204 -- comments to another node.
206 Comments
.Set_Last
(0);
209 --------------------------------
210 -- Associative_Array_Index_Of --
211 --------------------------------
213 function Associative_Array_Index_Of
214 (Node
: Project_Node_Id
) return Name_Id
220 (Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
222 Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
223 return Project_Nodes
.Table
(Node
).Value
;
224 end Associative_Array_Index_Of
;
226 ----------------------------
227 -- Associative_Package_Of --
228 ----------------------------
230 function Associative_Package_Of
231 (Node
: Project_Node_Id
) return Project_Node_Id
237 (Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
));
238 return Project_Nodes
.Table
(Node
).Field3
;
239 end Associative_Package_Of
;
241 ----------------------------
242 -- Associative_Project_Of --
243 ----------------------------
245 function Associative_Project_Of
246 (Node
: Project_Node_Id
) return Project_Node_Id
252 (Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
));
253 return Project_Nodes
.Table
(Node
).Field2
;
254 end Associative_Project_Of
;
256 ----------------------
257 -- Case_Insensitive --
258 ----------------------
260 function Case_Insensitive
(Node
: Project_Node_Id
) return Boolean is
265 (Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
267 Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
268 return Project_Nodes
.Table
(Node
).Flag1
;
269 end Case_Insensitive
;
271 --------------------------------
272 -- Case_Variable_Reference_Of --
273 --------------------------------
275 function Case_Variable_Reference_Of
276 (Node
: Project_Node_Id
) return Project_Node_Id
282 Project_Nodes
.Table
(Node
).Kind
= N_Case_Construction
);
283 return Project_Nodes
.Table
(Node
).Field1
;
284 end Case_Variable_Reference_Of
;
286 ----------------------
287 -- Comment_Zones_Of --
288 ----------------------
290 function Comment_Zones_Of
291 (Node
: Project_Node_Id
) return Project_Node_Id
293 Zone
: Project_Node_Id
;
296 pragma Assert
(Node
/= Empty_Node
);
297 Zone
:= Project_Nodes
.Table
(Node
).Comments
;
299 -- If there is not already an N_Comment_Zones associated, create a new
300 -- one and associate it with node Node.
302 if Zone
= Empty_Node
then
303 Project_Nodes
.Increment_Last
;
304 Zone
:= Project_Nodes
.Last
;
305 Project_Nodes
.Table
(Zone
) :=
306 (Kind
=> N_Comment_Zones
,
307 Location
=> No_Location
,
308 Directory
=> No_Name
,
309 Expr_Kind
=> Undefined
,
310 Variables
=> Empty_Node
,
311 Packages
=> Empty_Node
,
312 Pkg_Id
=> Empty_Package
,
315 Path_Name
=> No_Name
,
317 Field1
=> Empty_Node
,
318 Field2
=> Empty_Node
,
319 Field3
=> Empty_Node
,
322 Comments
=> Empty_Node
);
323 Project_Nodes
.Table
(Node
).Comments
:= Zone
;
327 end Comment_Zones_Of
;
329 -----------------------
330 -- Current_Item_Node --
331 -----------------------
333 function Current_Item_Node
334 (Node
: Project_Node_Id
) return Project_Node_Id
340 Project_Nodes
.Table
(Node
).Kind
= N_Declarative_Item
);
341 return Project_Nodes
.Table
(Node
).Field1
;
342 end Current_Item_Node
;
348 function Current_Term
349 (Node
: Project_Node_Id
) return Project_Node_Id
355 Project_Nodes
.Table
(Node
).Kind
= N_Term
);
356 return Project_Nodes
.Table
(Node
).Field1
;
359 --------------------------
360 -- Default_Project_Node --
361 --------------------------
363 function Default_Project_Node
364 (Of_Kind
: Project_Node_Kind
;
365 And_Expr_Kind
: Variable_Kind
:= Undefined
) return Project_Node_Id
367 Result
: Project_Node_Id
;
368 Zone
: Project_Node_Id
;
369 Previous
: Project_Node_Id
;
372 -- Create new node with specified kind and expression kind
374 Project_Nodes
.Increment_Last
;
375 Project_Nodes
.Table
(Project_Nodes
.Last
) :=
377 Location
=> No_Location
,
378 Directory
=> No_Name
,
379 Expr_Kind
=> And_Expr_Kind
,
380 Variables
=> Empty_Node
,
381 Packages
=> Empty_Node
,
382 Pkg_Id
=> Empty_Package
,
385 Path_Name
=> No_Name
,
387 Field1
=> Empty_Node
,
388 Field2
=> Empty_Node
,
389 Field3
=> Empty_Node
,
392 Comments
=> Empty_Node
);
394 -- Save the new node for the returned value
396 Result
:= Project_Nodes
.Last
;
398 if Comments
.Last
> 0 then
400 -- If this is not a node with comments, then set the flag
402 if not Node_With_Comments
(Of_Kind
) then
403 Unkept_Comments
:= True;
405 elsif Of_Kind
/= N_Comment
and then Of_Kind
/= N_Comment_Zones
then
407 Project_Nodes
.Increment_Last
;
408 Project_Nodes
.Table
(Project_Nodes
.Last
) :=
409 (Kind
=> N_Comment_Zones
,
410 Expr_Kind
=> Undefined
,
411 Location
=> No_Location
,
412 Directory
=> No_Name
,
413 Variables
=> Empty_Node
,
414 Packages
=> Empty_Node
,
415 Pkg_Id
=> Empty_Package
,
418 Path_Name
=> No_Name
,
420 Field1
=> Empty_Node
,
421 Field2
=> Empty_Node
,
422 Field3
=> Empty_Node
,
425 Comments
=> Empty_Node
);
427 Zone
:= Project_Nodes
.Last
;
428 Project_Nodes
.Table
(Result
).Comments
:= Zone
;
429 Previous
:= Empty_Node
;
431 for J
in 1 .. Comments
.Last
loop
433 -- Create a new N_Comment node
435 Project_Nodes
.Increment_Last
;
436 Project_Nodes
.Table
(Project_Nodes
.Last
) :=
438 Expr_Kind
=> Undefined
,
439 Flag1
=> Comments
.Table
(J
).Follows_Empty_Line
,
441 Comments
.Table
(J
).Is_Followed_By_Empty_Line
,
442 Location
=> No_Location
,
443 Directory
=> No_Name
,
444 Variables
=> Empty_Node
,
445 Packages
=> Empty_Node
,
446 Pkg_Id
=> Empty_Package
,
449 Path_Name
=> No_Name
,
450 Value
=> Comments
.Table
(J
).Value
,
451 Field1
=> Empty_Node
,
452 Field2
=> Empty_Node
,
453 Field3
=> Empty_Node
,
454 Comments
=> Empty_Node
);
456 -- Link it to the N_Comment_Zones node, if it is the first,
457 -- otherwise to the previous one.
459 if Previous
= Empty_Node
then
460 Project_Nodes
.Table
(Zone
).Field1
:= Project_Nodes
.Last
;
463 Project_Nodes
.Table
(Previous
).Comments
:=
467 -- This new node will be the previous one for the next
468 -- N_Comment node, if there is one.
470 Previous
:= Project_Nodes
.Last
;
473 -- Empty the Comments table after all comments have been processed
475 Comments
.Set_Last
(0);
480 end Default_Project_Node
;
486 function Directory_Of
(Node
: Project_Node_Id
) return Name_Id
is
491 Project_Nodes
.Table
(Node
).Kind
= N_Project
);
492 return Project_Nodes
.Table
(Node
).Directory
;
495 -------------------------
496 -- End_Of_Line_Comment --
497 -------------------------
499 function End_Of_Line_Comment
(Node
: Project_Node_Id
) return Name_Id
is
500 Zone
: Project_Node_Id
:= Empty_Node
;
503 pragma Assert
(Node
/= Empty_Node
);
504 Zone
:= Project_Nodes
.Table
(Node
).Comments
;
506 if Zone
= Empty_Node
then
509 return Project_Nodes
.Table
(Zone
).Value
;
511 end End_Of_Line_Comment
;
513 ------------------------
514 -- Expression_Kind_Of --
515 ------------------------
517 function Expression_Kind_Of
(Node
: Project_Node_Id
) return Variable_Kind
is
522 (Project_Nodes
.Table
(Node
).Kind
= N_Literal_String
524 Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
526 Project_Nodes
.Table
(Node
).Kind
= N_Variable_Declaration
528 Project_Nodes
.Table
(Node
).Kind
= N_Typed_Variable_Declaration
530 Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
532 Project_Nodes
.Table
(Node
).Kind
= N_Expression
534 Project_Nodes
.Table
(Node
).Kind
= N_Term
536 Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
538 Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
540 return Project_Nodes
.Table
(Node
).Expr_Kind
;
541 end Expression_Kind_Of
;
547 function Expression_Of
548 (Node
: Project_Node_Id
) return Project_Node_Id
554 (Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
556 Project_Nodes
.Table
(Node
).Kind
= N_Typed_Variable_Declaration
558 Project_Nodes
.Table
(Node
).Kind
= N_Variable_Declaration
));
560 return Project_Nodes
.Table
(Node
).Field1
;
563 -------------------------
564 -- Extended_Project_Of --
565 -------------------------
567 function Extended_Project_Of
568 (Node
: Project_Node_Id
) return Project_Node_Id
574 Project_Nodes
.Table
(Node
).Kind
= N_Project_Declaration
);
575 return Project_Nodes
.Table
(Node
).Field2
;
576 end Extended_Project_Of
;
578 ------------------------------
579 -- Extended_Project_Path_Of --
580 ------------------------------
582 function Extended_Project_Path_Of
583 (Node
: Project_Node_Id
) return Name_Id
589 Project_Nodes
.Table
(Node
).Kind
= N_Project
);
590 return Project_Nodes
.Table
(Node
).Value
;
591 end Extended_Project_Path_Of
;
593 --------------------------
594 -- Extending_Project_Of --
595 --------------------------
596 function Extending_Project_Of
597 (Node
: Project_Node_Id
) return Project_Node_Id
603 Project_Nodes
.Table
(Node
).Kind
= N_Project_Declaration
);
604 return Project_Nodes
.Table
(Node
).Field3
;
605 end Extending_Project_Of
;
607 ---------------------------
608 -- External_Reference_Of --
609 ---------------------------
611 function External_Reference_Of
612 (Node
: Project_Node_Id
) return Project_Node_Id
618 Project_Nodes
.Table
(Node
).Kind
= N_External_Value
);
619 return Project_Nodes
.Table
(Node
).Field1
;
620 end External_Reference_Of
;
622 -------------------------
623 -- External_Default_Of --
624 -------------------------
626 function External_Default_Of
627 (Node
: Project_Node_Id
)
628 return Project_Node_Id
634 Project_Nodes
.Table
(Node
).Kind
= N_External_Value
);
635 return Project_Nodes
.Table
(Node
).Field2
;
636 end External_Default_Of
;
638 ------------------------
639 -- First_Case_Item_Of --
640 ------------------------
642 function First_Case_Item_Of
643 (Node
: Project_Node_Id
) return Project_Node_Id
649 Project_Nodes
.Table
(Node
).Kind
= N_Case_Construction
);
650 return Project_Nodes
.Table
(Node
).Field2
;
651 end First_Case_Item_Of
;
653 ---------------------
654 -- First_Choice_Of --
655 ---------------------
657 function First_Choice_Of
658 (Node
: Project_Node_Id
)
659 return Project_Node_Id
665 Project_Nodes
.Table
(Node
).Kind
= N_Case_Item
);
666 return Project_Nodes
.Table
(Node
).Field1
;
669 -------------------------
670 -- First_Comment_After --
671 -------------------------
673 function First_Comment_After
674 (Node
: Project_Node_Id
) return Project_Node_Id
676 Zone
: Project_Node_Id
:= Empty_Node
;
678 pragma Assert
(Node
/= Empty_Node
);
679 Zone
:= Project_Nodes
.Table
(Node
).Comments
;
681 if Zone
= Empty_Node
then
685 return Project_Nodes
.Table
(Zone
).Field2
;
687 end First_Comment_After
;
689 -----------------------------
690 -- First_Comment_After_End --
691 -----------------------------
693 function First_Comment_After_End
694 (Node
: Project_Node_Id
)
695 return Project_Node_Id
697 Zone
: Project_Node_Id
:= Empty_Node
;
700 pragma Assert
(Node
/= Empty_Node
);
701 Zone
:= Project_Nodes
.Table
(Node
).Comments
;
703 if Zone
= Empty_Node
then
707 return Project_Nodes
.Table
(Zone
).Comments
;
709 end First_Comment_After_End
;
711 --------------------------
712 -- First_Comment_Before --
713 --------------------------
715 function First_Comment_Before
716 (Node
: Project_Node_Id
) return Project_Node_Id
718 Zone
: Project_Node_Id
:= Empty_Node
;
721 pragma Assert
(Node
/= Empty_Node
);
722 Zone
:= Project_Nodes
.Table
(Node
).Comments
;
724 if Zone
= Empty_Node
then
728 return Project_Nodes
.Table
(Zone
).Field1
;
730 end First_Comment_Before
;
732 ------------------------------
733 -- First_Comment_Before_End --
734 ------------------------------
736 function First_Comment_Before_End
737 (Node
: Project_Node_Id
) return Project_Node_Id
739 Zone
: Project_Node_Id
:= Empty_Node
;
742 pragma Assert
(Node
/= Empty_Node
);
743 Zone
:= Project_Nodes
.Table
(Node
).Comments
;
745 if Zone
= Empty_Node
then
749 return Project_Nodes
.Table
(Zone
).Field3
;
751 end First_Comment_Before_End
;
753 -------------------------------
754 -- First_Declarative_Item_Of --
755 -------------------------------
757 function First_Declarative_Item_Of
758 (Node
: Project_Node_Id
) return Project_Node_Id
764 (Project_Nodes
.Table
(Node
).Kind
= N_Project_Declaration
766 Project_Nodes
.Table
(Node
).Kind
= N_Case_Item
768 Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
));
770 if Project_Nodes
.Table
(Node
).Kind
= N_Project_Declaration
then
771 return Project_Nodes
.Table
(Node
).Field1
;
773 return Project_Nodes
.Table
(Node
).Field2
;
775 end First_Declarative_Item_Of
;
777 ------------------------------
778 -- First_Expression_In_List --
779 ------------------------------
781 function First_Expression_In_List
782 (Node
: Project_Node_Id
) return Project_Node_Id
788 Project_Nodes
.Table
(Node
).Kind
= N_Literal_String_List
);
789 return Project_Nodes
.Table
(Node
).Field1
;
790 end First_Expression_In_List
;
792 --------------------------
793 -- First_Literal_String --
794 --------------------------
796 function First_Literal_String
797 (Node
: Project_Node_Id
) return Project_Node_Id
803 Project_Nodes
.Table
(Node
).Kind
= N_String_Type_Declaration
);
804 return Project_Nodes
.Table
(Node
).Field1
;
805 end First_Literal_String
;
807 ----------------------
808 -- First_Package_Of --
809 ----------------------
811 function First_Package_Of
812 (Node
: Project_Node_Id
) return Package_Declaration_Id
818 Project_Nodes
.Table
(Node
).Kind
= N_Project
);
819 return Project_Nodes
.Table
(Node
).Packages
;
820 end First_Package_Of
;
822 --------------------------
823 -- First_String_Type_Of --
824 --------------------------
826 function First_String_Type_Of
827 (Node
: Project_Node_Id
) return Project_Node_Id
833 Project_Nodes
.Table
(Node
).Kind
= N_Project
);
834 return Project_Nodes
.Table
(Node
).Field3
;
835 end First_String_Type_Of
;
842 (Node
: Project_Node_Id
) return Project_Node_Id
848 Project_Nodes
.Table
(Node
).Kind
= N_Expression
);
849 return Project_Nodes
.Table
(Node
).Field1
;
852 -----------------------
853 -- First_Variable_Of --
854 -----------------------
856 function First_Variable_Of
857 (Node
: Project_Node_Id
) return Variable_Node_Id
863 (Project_Nodes
.Table
(Node
).Kind
= N_Project
865 Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
));
867 return Project_Nodes
.Table
(Node
).Variables
;
868 end First_Variable_Of
;
870 --------------------------
871 -- First_With_Clause_Of --
872 --------------------------
874 function First_With_Clause_Of
875 (Node
: Project_Node_Id
) return Project_Node_Id
881 Project_Nodes
.Table
(Node
).Kind
= N_Project
);
882 return Project_Nodes
.Table
(Node
).Field1
;
883 end First_With_Clause_Of
;
885 ------------------------
886 -- Follows_Empty_Line --
887 ------------------------
889 function Follows_Empty_Line
(Node
: Project_Node_Id
) return Boolean is
894 Project_Nodes
.Table
(Node
).Kind
= N_Comment
);
895 return Project_Nodes
.Table
(Node
).Flag1
;
896 end Follows_Empty_Line
;
902 function Hash
(N
: Project_Node_Id
) return Header_Num
is
904 return Header_Num
(N
mod Project_Node_Id
(Header_Num
'Last));
911 procedure Initialize
is
913 Project_Nodes
.Set_Last
(Empty_Node
);
914 Projects_Htable
.Reset
;
917 -------------------------------
918 -- Is_Followed_By_Empty_Line --
919 -------------------------------
921 function Is_Followed_By_Empty_Line
922 (Node
: Project_Node_Id
) return Boolean
928 Project_Nodes
.Table
(Node
).Kind
= N_Comment
);
929 return Project_Nodes
.Table
(Node
).Flag2
;
930 end Is_Followed_By_Empty_Line
;
932 ----------------------
933 -- Is_Extending_All --
934 ----------------------
936 function Is_Extending_All
(Node
: Project_Node_Id
) return Boolean is
941 (Project_Nodes
.Table
(Node
).Kind
= N_Project
943 Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
));
944 return Project_Nodes
.Table
(Node
).Flag2
;
945 end Is_Extending_All
;
947 -------------------------------------
948 -- Imported_Or_Extended_Project_Of --
949 -------------------------------------
951 function Imported_Or_Extended_Project_Of
952 (Project
: Project_Node_Id
;
953 With_Name
: Name_Id
) return Project_Node_Id
955 With_Clause
: Project_Node_Id
:= First_With_Clause_Of
(Project
);
956 Result
: Project_Node_Id
:= Empty_Node
;
959 -- First check all the imported projects
961 while With_Clause
/= Empty_Node
loop
963 -- Only non limited imported project may be used as prefix
964 -- of variable or attributes.
966 Result
:= Non_Limited_Project_Node_Of
(With_Clause
);
967 exit when Result
/= Empty_Node
and then Name_Of
(Result
) = With_Name
;
968 With_Clause
:= Next_With_Clause_Of
(With_Clause
);
971 -- If it is not an imported project, it might be the imported project
973 if With_Clause
= Empty_Node
then
974 Result
:= Extended_Project_Of
(Project_Declaration_Of
(Project
));
976 if Result
/= Empty_Node
977 and then Name_Of
(Result
) /= With_Name
979 Result
:= Empty_Node
;
984 end Imported_Or_Extended_Project_Of
;
990 function Kind_Of
(Node
: Project_Node_Id
) return Project_Node_Kind
is
992 pragma Assert
(Node
/= Empty_Node
);
993 return Project_Nodes
.Table
(Node
).Kind
;
1000 function Location_Of
(Node
: Project_Node_Id
) return Source_Ptr
is
1002 pragma Assert
(Node
/= Empty_Node
);
1003 return Project_Nodes
.Table
(Node
).Location
;
1010 function Name_Of
(Node
: Project_Node_Id
) return Name_Id
is
1012 pragma Assert
(Node
/= Empty_Node
);
1013 return Project_Nodes
.Table
(Node
).Name
;
1016 --------------------
1017 -- Next_Case_Item --
1018 --------------------
1020 function Next_Case_Item
1021 (Node
: Project_Node_Id
) return Project_Node_Id
1027 Project_Nodes
.Table
(Node
).Kind
= N_Case_Item
);
1028 return Project_Nodes
.Table
(Node
).Field3
;
1035 function Next_Comment
(Node
: Project_Node_Id
) return Project_Node_Id
is
1040 Project_Nodes
.Table
(Node
).Kind
= N_Comment
);
1041 return Project_Nodes
.Table
(Node
).Comments
;
1044 ---------------------------
1045 -- Next_Declarative_Item --
1046 ---------------------------
1048 function Next_Declarative_Item
1049 (Node
: Project_Node_Id
) return Project_Node_Id
1055 Project_Nodes
.Table
(Node
).Kind
= N_Declarative_Item
);
1056 return Project_Nodes
.Table
(Node
).Field2
;
1057 end Next_Declarative_Item
;
1059 -----------------------------
1060 -- Next_Expression_In_List --
1061 -----------------------------
1063 function Next_Expression_In_List
1064 (Node
: Project_Node_Id
) return Project_Node_Id
1070 Project_Nodes
.Table
(Node
).Kind
= N_Expression
);
1071 return Project_Nodes
.Table
(Node
).Field2
;
1072 end Next_Expression_In_List
;
1074 -------------------------
1075 -- Next_Literal_String --
1076 -------------------------
1078 function Next_Literal_String
1079 (Node
: Project_Node_Id
)
1080 return Project_Node_Id
1086 Project_Nodes
.Table
(Node
).Kind
= N_Literal_String
);
1087 return Project_Nodes
.Table
(Node
).Field1
;
1088 end Next_Literal_String
;
1090 -----------------------------
1091 -- Next_Package_In_Project --
1092 -----------------------------
1094 function Next_Package_In_Project
1095 (Node
: Project_Node_Id
) return Project_Node_Id
1101 Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
);
1102 return Project_Nodes
.Table
(Node
).Field3
;
1103 end Next_Package_In_Project
;
1105 ----------------------
1106 -- Next_String_Type --
1107 ----------------------
1109 function Next_String_Type
1110 (Node
: Project_Node_Id
)
1111 return Project_Node_Id
1117 Project_Nodes
.Table
(Node
).Kind
= N_String_Type_Declaration
);
1118 return Project_Nodes
.Table
(Node
).Field2
;
1119 end Next_String_Type
;
1126 (Node
: Project_Node_Id
) return Project_Node_Id
1132 Project_Nodes
.Table
(Node
).Kind
= N_Term
);
1133 return Project_Nodes
.Table
(Node
).Field2
;
1140 function Next_Variable
1141 (Node
: Project_Node_Id
)
1142 return Project_Node_Id
1148 (Project_Nodes
.Table
(Node
).Kind
= N_Typed_Variable_Declaration
1150 Project_Nodes
.Table
(Node
).Kind
= N_Variable_Declaration
));
1152 return Project_Nodes
.Table
(Node
).Field3
;
1155 -------------------------
1156 -- Next_With_Clause_Of --
1157 -------------------------
1159 function Next_With_Clause_Of
1160 (Node
: Project_Node_Id
) return Project_Node_Id
1166 Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
);
1167 return Project_Nodes
.Table
(Node
).Field2
;
1168 end Next_With_Clause_Of
;
1170 ---------------------------------
1171 -- Non_Limited_Project_Node_Of --
1172 ---------------------------------
1174 function Non_Limited_Project_Node_Of
1175 (Node
: Project_Node_Id
) return Project_Node_Id
1181 (Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
));
1182 return Project_Nodes
.Table
(Node
).Field3
;
1183 end Non_Limited_Project_Node_Of
;
1189 function Package_Id_Of
(Node
: Project_Node_Id
) return Package_Node_Id
is
1194 Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
);
1195 return Project_Nodes
.Table
(Node
).Pkg_Id
;
1198 ---------------------
1199 -- Package_Node_Of --
1200 ---------------------
1202 function Package_Node_Of
1203 (Node
: Project_Node_Id
) return Project_Node_Id
1209 (Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
1211 Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
1212 return Project_Nodes
.Table
(Node
).Field2
;
1213 end Package_Node_Of
;
1219 function Path_Name_Of
(Node
: Project_Node_Id
) return Name_Id
is
1224 (Project_Nodes
.Table
(Node
).Kind
= N_Project
1226 Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
));
1227 return Project_Nodes
.Table
(Node
).Path_Name
;
1230 ----------------------------
1231 -- Project_Declaration_Of --
1232 ----------------------------
1234 function Project_Declaration_Of
1235 (Node
: Project_Node_Id
) return Project_Node_Id
1241 Project_Nodes
.Table
(Node
).Kind
= N_Project
);
1242 return Project_Nodes
.Table
(Node
).Field2
;
1243 end Project_Declaration_Of
;
1245 -------------------------------------------
1246 -- Project_File_Includes_Unkept_Comments --
1247 -------------------------------------------
1249 function Project_File_Includes_Unkept_Comments
1250 (Node
: Project_Node_Id
) return Boolean
1252 Declaration
: constant Project_Node_Id
:= Project_Declaration_Of
(Node
);
1254 return Project_Nodes
.Table
(Declaration
).Flag1
;
1255 end Project_File_Includes_Unkept_Comments
;
1257 ---------------------
1258 -- Project_Node_Of --
1259 ---------------------
1261 function Project_Node_Of
1262 (Node
: Project_Node_Id
) return Project_Node_Id
1268 (Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
1270 Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
1272 Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
1273 return Project_Nodes
.Table
(Node
).Field1
;
1274 end Project_Node_Of
;
1276 -----------------------------------
1277 -- Project_Of_Renamed_Package_Of --
1278 -----------------------------------
1280 function Project_Of_Renamed_Package_Of
1281 (Node
: Project_Node_Id
) return Project_Node_Id
1287 Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
);
1288 return Project_Nodes
.Table
(Node
).Field1
;
1289 end Project_Of_Renamed_Package_Of
;
1291 --------------------------
1292 -- Remove_Next_End_Node --
1293 --------------------------
1295 procedure Remove_Next_End_Node
is
1297 Next_End_Nodes
.Decrement_Last
;
1298 end Remove_Next_End_Node
;
1304 procedure Reset_State
is
1306 End_Of_Line_Node
:= Empty_Node
;
1307 Previous_Line_Node
:= Empty_Node
;
1308 Previous_End_Node
:= Empty_Node
;
1309 Unkept_Comments
:= False;
1310 Comments
.Set_Last
(0);
1317 procedure Restore
(S
: in Comment_State
) is
1319 End_Of_Line_Node
:= S
.End_Of_Line_Node
;
1320 Previous_Line_Node
:= S
.Previous_Line_Node
;
1321 Previous_End_Node
:= S
.Previous_End_Node
;
1322 Next_End_Nodes
.Set_Last
(0);
1323 Unkept_Comments
:= S
.Unkept_Comments
;
1325 Comments
.Set_Last
(0);
1327 for J
in S
.Comments
'Range loop
1328 Comments
.Increment_Last
;
1329 Comments
.Table
(Comments
.Last
) := S
.Comments
(J
);
1337 procedure Save
(S
: out Comment_State
) is
1338 Cmts
: constant Comments_Ptr
:= new Comment_Array
(1 .. Comments
.Last
);
1341 for J
in 1 .. Comments
.Last
loop
1342 Cmts
(J
) := Comments
.Table
(J
);
1346 (End_Of_Line_Node
=> End_Of_Line_Node
,
1347 Previous_Line_Node
=> Previous_Line_Node
,
1348 Previous_End_Node
=> Previous_End_Node
,
1349 Unkept_Comments
=> Unkept_Comments
,
1358 Empty_Line
: Boolean := False;
1360 -- If there are comments, then they will not be kept. Set the flag and
1361 -- clear the comments.
1363 if Comments
.Last
> 0 then
1364 Unkept_Comments
:= True;
1365 Comments
.Set_Last
(0);
1368 -- Loop until a token other that End_Of_Line or Comment is found
1371 Prj
.Err
.Scanner
.Scan
;
1374 when Tok_End_Of_Line
=>
1375 if Prev_Token
= Tok_End_Of_Line
then
1378 if Comments
.Last
> 0 then
1379 Comments
.Table
(Comments
.Last
).Is_Followed_By_Empty_Line
1385 -- If this is a line comment, add it to the comment table
1387 if Prev_Token
= Tok_End_Of_Line
1388 or else Prev_Token
= No_Token
1390 Comments
.Increment_Last
;
1391 Comments
.Table
(Comments
.Last
) :=
1392 (Value
=> Comment_Id
,
1393 Follows_Empty_Line
=> Empty_Line
,
1394 Is_Followed_By_Empty_Line
=> False);
1396 -- Otherwise, it is an end of line comment. If there is
1397 -- an end of line node specified, associate the comment with
1400 elsif End_Of_Line_Node
/= Empty_Node
then
1402 Zones
: constant Project_Node_Id
:=
1403 Comment_Zones_Of
(End_Of_Line_Node
);
1405 Project_Nodes
.Table
(Zones
).Value
:= Comment_Id
;
1408 -- Otherwise, this end of line node cannot be kept
1411 Unkept_Comments
:= True;
1412 Comments
.Set_Last
(0);
1415 Empty_Line
:= False;
1418 -- If there are comments, where the first comment is not
1419 -- following an empty line, put the initial uninterrupted
1420 -- comment zone with the node of the preceding line (either
1421 -- a Previous_Line or a Previous_End node), if any.
1423 if Comments
.Last
> 0 and then
1424 not Comments
.Table
(1).Follows_Empty_Line
then
1425 if Previous_Line_Node
/= Empty_Node
then
1427 (To
=> Previous_Line_Node
, Where
=> After
);
1429 elsif Previous_End_Node
/= Empty_Node
then
1431 (To
=> Previous_End_Node
, Where
=> After_End
);
1435 -- If there are still comments and the token is "end", then
1436 -- put these comments with the Next_End node, if any;
1437 -- otherwise, these comments cannot be kept. Always clear
1440 if Comments
.Last
> 0 and then Token
= Tok_End
then
1441 if Next_End_Nodes
.Last
> 0 then
1443 (To
=> Next_End_Nodes
.Table
(Next_End_Nodes
.Last
),
1444 Where
=> Before_End
);
1447 Unkept_Comments
:= True;
1450 Comments
.Set_Last
(0);
1453 -- Reset the End_Of_Line, Previous_Line and Previous_End nodes
1454 -- so that they are not used again.
1456 End_Of_Line_Node
:= Empty_Node
;
1457 Previous_Line_Node
:= Empty_Node
;
1458 Previous_End_Node
:= Empty_Node
;
1467 ------------------------------------
1468 -- Set_Associative_Array_Index_Of --
1469 ------------------------------------
1471 procedure Set_Associative_Array_Index_Of
1472 (Node
: Project_Node_Id
;
1479 (Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
1481 Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
1482 Project_Nodes
.Table
(Node
).Value
:= To
;
1483 end Set_Associative_Array_Index_Of
;
1485 --------------------------------
1486 -- Set_Associative_Package_Of --
1487 --------------------------------
1489 procedure Set_Associative_Package_Of
1490 (Node
: Project_Node_Id
;
1491 To
: Project_Node_Id
)
1497 Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
);
1498 Project_Nodes
.Table
(Node
).Field3
:= To
;
1499 end Set_Associative_Package_Of
;
1501 --------------------------------
1502 -- Set_Associative_Project_Of --
1503 --------------------------------
1505 procedure Set_Associative_Project_Of
1506 (Node
: Project_Node_Id
;
1507 To
: Project_Node_Id
)
1513 (Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
));
1514 Project_Nodes
.Table
(Node
).Field2
:= To
;
1515 end Set_Associative_Project_Of
;
1517 --------------------------
1518 -- Set_Case_Insensitive --
1519 --------------------------
1521 procedure Set_Case_Insensitive
1522 (Node
: Project_Node_Id
;
1529 (Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
1531 Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
1532 Project_Nodes
.Table
(Node
).Flag1
:= To
;
1533 end Set_Case_Insensitive
;
1535 ------------------------------------
1536 -- Set_Case_Variable_Reference_Of --
1537 ------------------------------------
1539 procedure Set_Case_Variable_Reference_Of
1540 (Node
: Project_Node_Id
;
1541 To
: Project_Node_Id
)
1547 Project_Nodes
.Table
(Node
).Kind
= N_Case_Construction
);
1548 Project_Nodes
.Table
(Node
).Field1
:= To
;
1549 end Set_Case_Variable_Reference_Of
;
1551 ---------------------------
1552 -- Set_Current_Item_Node --
1553 ---------------------------
1555 procedure Set_Current_Item_Node
1556 (Node
: Project_Node_Id
;
1557 To
: Project_Node_Id
)
1563 Project_Nodes
.Table
(Node
).Kind
= N_Declarative_Item
);
1564 Project_Nodes
.Table
(Node
).Field1
:= To
;
1565 end Set_Current_Item_Node
;
1567 ----------------------
1568 -- Set_Current_Term --
1569 ----------------------
1571 procedure Set_Current_Term
1572 (Node
: Project_Node_Id
;
1573 To
: Project_Node_Id
)
1579 Project_Nodes
.Table
(Node
).Kind
= N_Term
);
1580 Project_Nodes
.Table
(Node
).Field1
:= To
;
1581 end Set_Current_Term
;
1583 ----------------------
1584 -- Set_Directory_Of --
1585 ----------------------
1587 procedure Set_Directory_Of
1588 (Node
: Project_Node_Id
;
1595 Project_Nodes
.Table
(Node
).Kind
= N_Project
);
1596 Project_Nodes
.Table
(Node
).Directory
:= To
;
1597 end Set_Directory_Of
;
1599 ---------------------
1600 -- Set_End_Of_Line --
1601 ---------------------
1603 procedure Set_End_Of_Line
(To
: Project_Node_Id
) is
1605 End_Of_Line_Node
:= To
;
1606 end Set_End_Of_Line
;
1608 ----------------------------
1609 -- Set_Expression_Kind_Of --
1610 ----------------------------
1612 procedure Set_Expression_Kind_Of
1613 (Node
: Project_Node_Id
;
1620 (Project_Nodes
.Table
(Node
).Kind
= N_Literal_String
1622 Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
1624 Project_Nodes
.Table
(Node
).Kind
= N_Variable_Declaration
1626 Project_Nodes
.Table
(Node
).Kind
= N_Typed_Variable_Declaration
1628 Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
1630 Project_Nodes
.Table
(Node
).Kind
= N_Expression
1632 Project_Nodes
.Table
(Node
).Kind
= N_Term
1634 Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
1636 Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
1637 Project_Nodes
.Table
(Node
).Expr_Kind
:= To
;
1638 end Set_Expression_Kind_Of
;
1640 -----------------------
1641 -- Set_Expression_Of --
1642 -----------------------
1644 procedure Set_Expression_Of
1645 (Node
: Project_Node_Id
;
1646 To
: Project_Node_Id
)
1652 (Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
1654 Project_Nodes
.Table
(Node
).Kind
= N_Typed_Variable_Declaration
1656 Project_Nodes
.Table
(Node
).Kind
= N_Variable_Declaration
));
1657 Project_Nodes
.Table
(Node
).Field1
:= To
;
1658 end Set_Expression_Of
;
1660 -------------------------------
1661 -- Set_External_Reference_Of --
1662 -------------------------------
1664 procedure Set_External_Reference_Of
1665 (Node
: Project_Node_Id
;
1666 To
: Project_Node_Id
)
1672 Project_Nodes
.Table
(Node
).Kind
= N_External_Value
);
1673 Project_Nodes
.Table
(Node
).Field1
:= To
;
1674 end Set_External_Reference_Of
;
1676 -----------------------------
1677 -- Set_External_Default_Of --
1678 -----------------------------
1680 procedure Set_External_Default_Of
1681 (Node
: Project_Node_Id
;
1682 To
: Project_Node_Id
)
1688 Project_Nodes
.Table
(Node
).Kind
= N_External_Value
);
1689 Project_Nodes
.Table
(Node
).Field2
:= To
;
1690 end Set_External_Default_Of
;
1692 ----------------------------
1693 -- Set_First_Case_Item_Of --
1694 ----------------------------
1696 procedure Set_First_Case_Item_Of
1697 (Node
: Project_Node_Id
;
1698 To
: Project_Node_Id
)
1704 Project_Nodes
.Table
(Node
).Kind
= N_Case_Construction
);
1705 Project_Nodes
.Table
(Node
).Field2
:= To
;
1706 end Set_First_Case_Item_Of
;
1708 -------------------------
1709 -- Set_First_Choice_Of --
1710 -------------------------
1712 procedure Set_First_Choice_Of
1713 (Node
: Project_Node_Id
;
1714 To
: Project_Node_Id
)
1720 Project_Nodes
.Table
(Node
).Kind
= N_Case_Item
);
1721 Project_Nodes
.Table
(Node
).Field1
:= To
;
1722 end Set_First_Choice_Of
;
1724 -----------------------------
1725 -- Set_First_Comment_After --
1726 -----------------------------
1728 procedure Set_First_Comment_After
1729 (Node
: Project_Node_Id
;
1730 To
: Project_Node_Id
)
1732 Zone
: constant Project_Node_Id
:= Comment_Zones_Of
(Node
);
1734 Project_Nodes
.Table
(Zone
).Field2
:= To
;
1735 end Set_First_Comment_After
;
1737 ---------------------------------
1738 -- Set_First_Comment_After_End --
1739 ---------------------------------
1741 procedure Set_First_Comment_After_End
1742 (Node
: Project_Node_Id
;
1743 To
: Project_Node_Id
)
1745 Zone
: constant Project_Node_Id
:= Comment_Zones_Of
(Node
);
1747 Project_Nodes
.Table
(Zone
).Comments
:= To
;
1748 end Set_First_Comment_After_End
;
1750 ------------------------------
1751 -- Set_First_Comment_Before --
1752 ------------------------------
1754 procedure Set_First_Comment_Before
1755 (Node
: Project_Node_Id
;
1756 To
: Project_Node_Id
)
1759 Zone
: constant Project_Node_Id
:= Comment_Zones_Of
(Node
);
1761 Project_Nodes
.Table
(Zone
).Field1
:= To
;
1762 end Set_First_Comment_Before
;
1764 ----------------------------------
1765 -- Set_First_Comment_Before_End --
1766 ----------------------------------
1768 procedure Set_First_Comment_Before_End
1769 (Node
: Project_Node_Id
;
1770 To
: Project_Node_Id
)
1772 Zone
: constant Project_Node_Id
:= Comment_Zones_Of
(Node
);
1774 Project_Nodes
.Table
(Zone
).Field2
:= To
;
1775 end Set_First_Comment_Before_End
;
1777 ------------------------
1778 -- Set_Next_Case_Item --
1779 ------------------------
1781 procedure Set_Next_Case_Item
1782 (Node
: Project_Node_Id
;
1783 To
: Project_Node_Id
)
1789 Project_Nodes
.Table
(Node
).Kind
= N_Case_Item
);
1790 Project_Nodes
.Table
(Node
).Field3
:= To
;
1791 end Set_Next_Case_Item
;
1793 ----------------------
1794 -- Set_Next_Comment --
1795 ----------------------
1797 procedure Set_Next_Comment
1798 (Node
: Project_Node_Id
;
1799 To
: Project_Node_Id
)
1805 Project_Nodes
.Table
(Node
).Kind
= N_Comment
);
1806 Project_Nodes
.Table
(Node
).Comments
:= To
;
1807 end Set_Next_Comment
;
1809 -----------------------------------
1810 -- Set_First_Declarative_Item_Of --
1811 -----------------------------------
1813 procedure Set_First_Declarative_Item_Of
1814 (Node
: Project_Node_Id
;
1815 To
: Project_Node_Id
)
1821 (Project_Nodes
.Table
(Node
).Kind
= N_Project_Declaration
1823 Project_Nodes
.Table
(Node
).Kind
= N_Case_Item
1825 Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
));
1827 if Project_Nodes
.Table
(Node
).Kind
= N_Project_Declaration
then
1828 Project_Nodes
.Table
(Node
).Field1
:= To
;
1830 Project_Nodes
.Table
(Node
).Field2
:= To
;
1832 end Set_First_Declarative_Item_Of
;
1834 ----------------------------------
1835 -- Set_First_Expression_In_List --
1836 ----------------------------------
1838 procedure Set_First_Expression_In_List
1839 (Node
: Project_Node_Id
;
1840 To
: Project_Node_Id
)
1846 Project_Nodes
.Table
(Node
).Kind
= N_Literal_String_List
);
1847 Project_Nodes
.Table
(Node
).Field1
:= To
;
1848 end Set_First_Expression_In_List
;
1850 ------------------------------
1851 -- Set_First_Literal_String --
1852 ------------------------------
1854 procedure Set_First_Literal_String
1855 (Node
: Project_Node_Id
;
1856 To
: Project_Node_Id
)
1862 Project_Nodes
.Table
(Node
).Kind
= N_String_Type_Declaration
);
1863 Project_Nodes
.Table
(Node
).Field1
:= To
;
1864 end Set_First_Literal_String
;
1866 --------------------------
1867 -- Set_First_Package_Of --
1868 --------------------------
1870 procedure Set_First_Package_Of
1871 (Node
: Project_Node_Id
;
1872 To
: Package_Declaration_Id
)
1878 Project_Nodes
.Table
(Node
).Kind
= N_Project
);
1879 Project_Nodes
.Table
(Node
).Packages
:= To
;
1880 end Set_First_Package_Of
;
1882 ------------------------------
1883 -- Set_First_String_Type_Of --
1884 ------------------------------
1886 procedure Set_First_String_Type_Of
1887 (Node
: Project_Node_Id
;
1888 To
: Project_Node_Id
)
1894 Project_Nodes
.Table
(Node
).Kind
= N_Project
);
1895 Project_Nodes
.Table
(Node
).Field3
:= To
;
1896 end Set_First_String_Type_Of
;
1898 --------------------
1899 -- Set_First_Term --
1900 --------------------
1902 procedure Set_First_Term
1903 (Node
: Project_Node_Id
;
1904 To
: Project_Node_Id
)
1910 Project_Nodes
.Table
(Node
).Kind
= N_Expression
);
1911 Project_Nodes
.Table
(Node
).Field1
:= To
;
1914 ---------------------------
1915 -- Set_First_Variable_Of --
1916 ---------------------------
1918 procedure Set_First_Variable_Of
1919 (Node
: Project_Node_Id
;
1920 To
: Variable_Node_Id
)
1926 (Project_Nodes
.Table
(Node
).Kind
= N_Project
1928 Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
));
1929 Project_Nodes
.Table
(Node
).Variables
:= To
;
1930 end Set_First_Variable_Of
;
1932 ------------------------------
1933 -- Set_First_With_Clause_Of --
1934 ------------------------------
1936 procedure Set_First_With_Clause_Of
1937 (Node
: Project_Node_Id
;
1938 To
: Project_Node_Id
)
1944 Project_Nodes
.Table
(Node
).Kind
= N_Project
);
1945 Project_Nodes
.Table
(Node
).Field1
:= To
;
1946 end Set_First_With_Clause_Of
;
1948 --------------------------
1949 -- Set_Is_Extending_All --
1950 --------------------------
1952 procedure Set_Is_Extending_All
(Node
: Project_Node_Id
) is
1957 (Project_Nodes
.Table
(Node
).Kind
= N_Project
1959 Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
));
1960 Project_Nodes
.Table
(Node
).Flag2
:= True;
1961 end Set_Is_Extending_All
;
1967 procedure Set_Kind_Of
1968 (Node
: Project_Node_Id
;
1969 To
: Project_Node_Kind
)
1972 pragma Assert
(Node
/= Empty_Node
);
1973 Project_Nodes
.Table
(Node
).Kind
:= To
;
1976 ---------------------
1977 -- Set_Location_Of --
1978 ---------------------
1980 procedure Set_Location_Of
1981 (Node
: Project_Node_Id
;
1985 pragma Assert
(Node
/= Empty_Node
);
1986 Project_Nodes
.Table
(Node
).Location
:= To
;
1987 end Set_Location_Of
;
1989 -----------------------------
1990 -- Set_Extended_Project_Of --
1991 -----------------------------
1993 procedure Set_Extended_Project_Of
1994 (Node
: Project_Node_Id
;
1995 To
: Project_Node_Id
)
2001 Project_Nodes
.Table
(Node
).Kind
= N_Project_Declaration
);
2002 Project_Nodes
.Table
(Node
).Field2
:= To
;
2003 end Set_Extended_Project_Of
;
2005 ----------------------------------
2006 -- Set_Extended_Project_Path_Of --
2007 ----------------------------------
2009 procedure Set_Extended_Project_Path_Of
2010 (Node
: Project_Node_Id
;
2017 Project_Nodes
.Table
(Node
).Kind
= N_Project
);
2018 Project_Nodes
.Table
(Node
).Value
:= To
;
2019 end Set_Extended_Project_Path_Of
;
2021 ------------------------------
2022 -- Set_Extending_Project_Of --
2023 ------------------------------
2025 procedure Set_Extending_Project_Of
2026 (Node
: Project_Node_Id
;
2027 To
: Project_Node_Id
)
2033 Project_Nodes
.Table
(Node
).Kind
= N_Project_Declaration
);
2034 Project_Nodes
.Table
(Node
).Field3
:= To
;
2035 end Set_Extending_Project_Of
;
2041 procedure Set_Name_Of
2042 (Node
: Project_Node_Id
;
2046 pragma Assert
(Node
/= Empty_Node
);
2047 Project_Nodes
.Table
(Node
).Name
:= To
;
2050 -------------------------------
2051 -- Set_Next_Declarative_Item --
2052 -------------------------------
2054 procedure Set_Next_Declarative_Item
2055 (Node
: Project_Node_Id
;
2056 To
: Project_Node_Id
)
2062 Project_Nodes
.Table
(Node
).Kind
= N_Declarative_Item
);
2063 Project_Nodes
.Table
(Node
).Field2
:= To
;
2064 end Set_Next_Declarative_Item
;
2066 -----------------------
2067 -- Set_Next_End_Node --
2068 -----------------------
2070 procedure Set_Next_End_Node
(To
: Project_Node_Id
) is
2072 Next_End_Nodes
.Increment_Last
;
2073 Next_End_Nodes
.Table
(Next_End_Nodes
.Last
) := To
;
2074 end Set_Next_End_Node
;
2076 ---------------------------------
2077 -- Set_Next_Expression_In_List --
2078 ---------------------------------
2080 procedure Set_Next_Expression_In_List
2081 (Node
: Project_Node_Id
;
2082 To
: Project_Node_Id
)
2088 Project_Nodes
.Table
(Node
).Kind
= N_Expression
);
2089 Project_Nodes
.Table
(Node
).Field2
:= To
;
2090 end Set_Next_Expression_In_List
;
2092 -----------------------------
2093 -- Set_Next_Literal_String --
2094 -----------------------------
2096 procedure Set_Next_Literal_String
2097 (Node
: Project_Node_Id
;
2098 To
: Project_Node_Id
)
2104 Project_Nodes
.Table
(Node
).Kind
= N_Literal_String
);
2105 Project_Nodes
.Table
(Node
).Field1
:= To
;
2106 end Set_Next_Literal_String
;
2108 ---------------------------------
2109 -- Set_Next_Package_In_Project --
2110 ---------------------------------
2112 procedure Set_Next_Package_In_Project
2113 (Node
: Project_Node_Id
;
2114 To
: Project_Node_Id
)
2120 Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
);
2121 Project_Nodes
.Table
(Node
).Field3
:= To
;
2122 end Set_Next_Package_In_Project
;
2124 --------------------------
2125 -- Set_Next_String_Type --
2126 --------------------------
2128 procedure Set_Next_String_Type
2129 (Node
: Project_Node_Id
;
2130 To
: Project_Node_Id
)
2136 Project_Nodes
.Table
(Node
).Kind
= N_String_Type_Declaration
);
2137 Project_Nodes
.Table
(Node
).Field2
:= To
;
2138 end Set_Next_String_Type
;
2144 procedure Set_Next_Term
2145 (Node
: Project_Node_Id
;
2146 To
: Project_Node_Id
)
2152 Project_Nodes
.Table
(Node
).Kind
= N_Term
);
2153 Project_Nodes
.Table
(Node
).Field2
:= To
;
2156 -----------------------
2157 -- Set_Next_Variable --
2158 -----------------------
2160 procedure Set_Next_Variable
2161 (Node
: Project_Node_Id
;
2162 To
: Project_Node_Id
)
2168 (Project_Nodes
.Table
(Node
).Kind
= N_Typed_Variable_Declaration
2170 Project_Nodes
.Table
(Node
).Kind
= N_Variable_Declaration
));
2171 Project_Nodes
.Table
(Node
).Field3
:= To
;
2172 end Set_Next_Variable
;
2174 -----------------------------
2175 -- Set_Next_With_Clause_Of --
2176 -----------------------------
2178 procedure Set_Next_With_Clause_Of
2179 (Node
: Project_Node_Id
;
2180 To
: Project_Node_Id
)
2186 Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
);
2187 Project_Nodes
.Table
(Node
).Field2
:= To
;
2188 end Set_Next_With_Clause_Of
;
2190 -----------------------
2191 -- Set_Package_Id_Of --
2192 -----------------------
2194 procedure Set_Package_Id_Of
2195 (Node
: Project_Node_Id
;
2196 To
: Package_Node_Id
)
2202 Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
);
2203 Project_Nodes
.Table
(Node
).Pkg_Id
:= To
;
2204 end Set_Package_Id_Of
;
2206 -------------------------
2207 -- Set_Package_Node_Of --
2208 -------------------------
2210 procedure Set_Package_Node_Of
2211 (Node
: Project_Node_Id
;
2212 To
: Project_Node_Id
)
2218 (Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
2220 Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
2221 Project_Nodes
.Table
(Node
).Field2
:= To
;
2222 end Set_Package_Node_Of
;
2224 ----------------------
2225 -- Set_Path_Name_Of --
2226 ----------------------
2228 procedure Set_Path_Name_Of
2229 (Node
: Project_Node_Id
;
2236 (Project_Nodes
.Table
(Node
).Kind
= N_Project
2238 Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
));
2239 Project_Nodes
.Table
(Node
).Path_Name
:= To
;
2240 end Set_Path_Name_Of
;
2242 ---------------------------
2243 -- Set_Previous_End_Node --
2244 ---------------------------
2245 procedure Set_Previous_End_Node
(To
: Project_Node_Id
) is
2247 Previous_End_Node
:= To
;
2248 end Set_Previous_End_Node
;
2250 ----------------------------
2251 -- Set_Previous_Line_Node --
2252 ----------------------------
2254 procedure Set_Previous_Line_Node
(To
: Project_Node_Id
) is
2256 Previous_Line_Node
:= To
;
2257 end Set_Previous_Line_Node
;
2259 --------------------------------
2260 -- Set_Project_Declaration_Of --
2261 --------------------------------
2263 procedure Set_Project_Declaration_Of
2264 (Node
: Project_Node_Id
;
2265 To
: Project_Node_Id
)
2271 Project_Nodes
.Table
(Node
).Kind
= N_Project
);
2272 Project_Nodes
.Table
(Node
).Field2
:= To
;
2273 end Set_Project_Declaration_Of
;
2275 -----------------------------------------------
2276 -- Set_Project_File_Includes_Unkept_Comments --
2277 -----------------------------------------------
2279 procedure Set_Project_File_Includes_Unkept_Comments
2280 (Node
: Project_Node_Id
;
2283 Declaration
: constant Project_Node_Id
:= Project_Declaration_Of
(Node
);
2285 Project_Nodes
.Table
(Declaration
).Flag1
:= To
;
2286 end Set_Project_File_Includes_Unkept_Comments
;
2288 -------------------------
2289 -- Set_Project_Node_Of --
2290 -------------------------
2292 procedure Set_Project_Node_Of
2293 (Node
: Project_Node_Id
;
2294 To
: Project_Node_Id
;
2295 Limited_With
: Boolean := False)
2301 (Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
2303 Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
2305 Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
2306 Project_Nodes
.Table
(Node
).Field1
:= To
;
2308 if Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
2309 and then not Limited_With
2311 Project_Nodes
.Table
(Node
).Field3
:= To
;
2313 end Set_Project_Node_Of
;
2315 ---------------------------------------
2316 -- Set_Project_Of_Renamed_Package_Of --
2317 ---------------------------------------
2319 procedure Set_Project_Of_Renamed_Package_Of
2320 (Node
: Project_Node_Id
;
2321 To
: Project_Node_Id
)
2327 Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
);
2328 Project_Nodes
.Table
(Node
).Field1
:= To
;
2329 end Set_Project_Of_Renamed_Package_Of
;
2331 -------------------------
2332 -- Set_Source_Index_Of --
2333 -------------------------
2335 procedure Set_Source_Index_Of
2336 (Node
: Project_Node_Id
;
2343 (Project_Nodes
.Table
(Node
).Kind
= N_Literal_String
2345 Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
));
2346 Project_Nodes
.Table
(Node
).Src_Index
:= To
;
2347 end Set_Source_Index_Of
;
2349 ------------------------
2350 -- Set_String_Type_Of --
2351 ------------------------
2353 procedure Set_String_Type_Of
2354 (Node
: Project_Node_Id
;
2355 To
: Project_Node_Id
)
2361 (Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
2363 Project_Nodes
.Table
(Node
).Kind
= N_Typed_Variable_Declaration
)
2365 Project_Nodes
.Table
(To
).Kind
= N_String_Type_Declaration
);
2367 if Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
then
2368 Project_Nodes
.Table
(Node
).Field3
:= To
;
2370 Project_Nodes
.Table
(Node
).Field2
:= To
;
2372 end Set_String_Type_Of
;
2374 -------------------------
2375 -- Set_String_Value_Of --
2376 -------------------------
2378 procedure Set_String_Value_Of
2379 (Node
: Project_Node_Id
;
2386 (Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
2388 Project_Nodes
.Table
(Node
).Kind
= N_Comment
2390 Project_Nodes
.Table
(Node
).Kind
= N_Literal_String
));
2391 Project_Nodes
.Table
(Node
).Value
:= To
;
2392 end Set_String_Value_Of
;
2394 ---------------------
2395 -- Source_Index_Of --
2396 ---------------------
2398 function Source_Index_Of
(Node
: Project_Node_Id
) return Int
is
2403 (Project_Nodes
.Table
(Node
).Kind
= N_Literal_String
2405 Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
));
2406 return Project_Nodes
.Table
(Node
).Src_Index
;
2407 end Source_Index_Of
;
2409 --------------------
2410 -- String_Type_Of --
2411 --------------------
2413 function String_Type_Of
(Node
: Project_Node_Id
) return Project_Node_Id
is
2418 (Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
2420 Project_Nodes
.Table
(Node
).Kind
= N_Typed_Variable_Declaration
));
2422 if Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
then
2423 return Project_Nodes
.Table
(Node
).Field3
;
2425 return Project_Nodes
.Table
(Node
).Field2
;
2429 ---------------------
2430 -- String_Value_Of --
2431 ---------------------
2433 function String_Value_Of
(Node
: Project_Node_Id
) return Name_Id
is
2438 (Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
2440 Project_Nodes
.Table
(Node
).Kind
= N_Comment
2442 Project_Nodes
.Table
(Node
).Kind
= N_Literal_String
));
2443 return Project_Nodes
.Table
(Node
).Value
;
2444 end String_Value_Of
;
2446 --------------------
2447 -- Value_Is_Valid --
2448 --------------------
2450 function Value_Is_Valid
2451 (For_Typed_Variable
: Project_Node_Id
;
2452 Value
: Name_Id
) return Boolean
2456 (For_Typed_Variable
/= Empty_Node
2458 (Project_Nodes
.Table
(For_Typed_Variable
).Kind
=
2459 N_Typed_Variable_Declaration
));
2462 Current_String
: Project_Node_Id
:=
2463 First_Literal_String
2464 (String_Type_Of
(For_Typed_Variable
));
2467 while Current_String
/= Empty_Node
2469 String_Value_Of
(Current_String
) /= Value
2472 Next_Literal_String
(Current_String
);
2475 return Current_String
/= Empty_Node
;
2480 -------------------------------
2481 -- There_Are_Unkept_Comments --
2482 -------------------------------
2484 function There_Are_Unkept_Comments
return Boolean is
2486 return Unkept_Comments
;
2487 end There_Are_Unkept_Comments
;