1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2001-2003 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
,
114 Path_Name
=> No_Name
,
116 Field1
=> Empty_Node
,
117 Field2
=> Empty_Node
,
118 Field3
=> Empty_Node
,
121 Comments
=> Empty_Node
);
123 Zone
:= Project_Nodes
.Last
;
124 Project_Nodes
.Table
(To
).Comments
:= Zone
;
127 if Where
= End_Of_Line
then
128 Project_Nodes
.Table
(Zone
).Value
:= Comments
.Table
(1).Value
;
131 -- Get each comments in the Comments table and link them to node To
133 for J
in 1 .. Comments
.Last
loop
135 -- Create new N_Comment node
137 if (Where
= After
or else Where
= After_End
) and then
138 Token
/= Tok_EOF
and then
139 Comments
.Table
(J
).Follows_Empty_Line
141 Comments
.Table
(1 .. Comments
.Last
- J
+ 1) :=
142 Comments
.Table
(J
.. Comments
.Last
);
143 Comments
.Set_Last
(Comments
.Last
- J
+ 1);
147 Project_Nodes
.Increment_Last
;
148 Project_Nodes
.Table
(Project_Nodes
.Last
) :=
150 Expr_Kind
=> Undefined
,
151 Flag1
=> Comments
.Table
(J
).Follows_Empty_Line
,
153 Comments
.Table
(J
).Is_Followed_By_Empty_Line
,
154 Location
=> No_Location
,
155 Directory
=> No_Name
,
156 Variables
=> Empty_Node
,
157 Packages
=> Empty_Node
,
158 Pkg_Id
=> Empty_Package
,
160 Path_Name
=> No_Name
,
161 Value
=> Comments
.Table
(J
).Value
,
162 Field1
=> Empty_Node
,
163 Field2
=> Empty_Node
,
164 Field3
=> Empty_Node
,
165 Comments
=> Empty_Node
);
167 -- If this is the first comment, put it in the right field of
170 if Previous
= Empty_Node
then
173 Project_Nodes
.Table
(Zone
).Field1
:= Project_Nodes
.Last
;
176 Project_Nodes
.Table
(Zone
).Field2
:= Project_Nodes
.Last
;
179 Project_Nodes
.Table
(Zone
).Field3
:= Project_Nodes
.Last
;
182 Project_Nodes
.Table
(Zone
).Comments
:= Project_Nodes
.Last
;
189 -- When it is not the first, link it to the previous one
191 Project_Nodes
.Table
(Previous
).Comments
:= Project_Nodes
.Last
;
194 -- This node becomes the previous one for the next comment, if
197 Previous
:= Project_Nodes
.Last
;
201 -- Empty the Comments table, so that there is no risk to link the same
202 -- comments to another node.
204 Comments
.Set_Last
(0);
208 --------------------------------
209 -- Associative_Array_Index_Of --
210 --------------------------------
212 function Associative_Array_Index_Of
213 (Node
: Project_Node_Id
) return Name_Id
219 (Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
221 Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
222 return Project_Nodes
.Table
(Node
).Value
;
223 end Associative_Array_Index_Of
;
225 ----------------------------
226 -- Associative_Package_Of --
227 ----------------------------
229 function Associative_Package_Of
230 (Node
: Project_Node_Id
) return Project_Node_Id
236 (Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
));
237 return Project_Nodes
.Table
(Node
).Field3
;
238 end Associative_Package_Of
;
240 ----------------------------
241 -- Associative_Project_Of --
242 ----------------------------
244 function Associative_Project_Of
245 (Node
: Project_Node_Id
) return Project_Node_Id
251 (Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
));
252 return Project_Nodes
.Table
(Node
).Field2
;
253 end Associative_Project_Of
;
255 ----------------------
256 -- Case_Insensitive --
257 ----------------------
259 function Case_Insensitive
(Node
: Project_Node_Id
) return Boolean is
264 (Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
266 Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
267 return Project_Nodes
.Table
(Node
).Flag1
;
268 end Case_Insensitive
;
270 --------------------------------
271 -- Case_Variable_Reference_Of --
272 --------------------------------
274 function Case_Variable_Reference_Of
275 (Node
: Project_Node_Id
) return Project_Node_Id
281 Project_Nodes
.Table
(Node
).Kind
= N_Case_Construction
);
282 return Project_Nodes
.Table
(Node
).Field1
;
283 end Case_Variable_Reference_Of
;
285 ----------------------
286 -- Comment_Zones_Of --
287 ----------------------
289 function Comment_Zones_Of
290 (Node
: Project_Node_Id
) return Project_Node_Id
292 Zone
: Project_Node_Id
;
295 pragma Assert
(Node
/= Empty_Node
);
296 Zone
:= Project_Nodes
.Table
(Node
).Comments
;
298 -- If there is not already an N_Comment_Zones associated, create a new
299 -- one and associate it with node Node.
301 if Zone
= Empty_Node
then
302 Project_Nodes
.Increment_Last
;
303 Zone
:= Project_Nodes
.Last
;
304 Project_Nodes
.Table
(Zone
) :=
305 (Kind
=> N_Comment_Zones
,
306 Location
=> No_Location
,
307 Directory
=> No_Name
,
308 Expr_Kind
=> Undefined
,
309 Variables
=> Empty_Node
,
310 Packages
=> Empty_Node
,
311 Pkg_Id
=> Empty_Package
,
313 Path_Name
=> No_Name
,
315 Field1
=> Empty_Node
,
316 Field2
=> Empty_Node
,
317 Field3
=> Empty_Node
,
320 Comments
=> Empty_Node
);
321 Project_Nodes
.Table
(Node
).Comments
:= Zone
;
325 end Comment_Zones_Of
;
327 -----------------------
328 -- Current_Item_Node --
329 -----------------------
331 function Current_Item_Node
332 (Node
: Project_Node_Id
) return Project_Node_Id
338 Project_Nodes
.Table
(Node
).Kind
= N_Declarative_Item
);
339 return Project_Nodes
.Table
(Node
).Field1
;
340 end Current_Item_Node
;
346 function Current_Term
347 (Node
: Project_Node_Id
) return Project_Node_Id
353 Project_Nodes
.Table
(Node
).Kind
= N_Term
);
354 return Project_Nodes
.Table
(Node
).Field1
;
357 --------------------------
358 -- Default_Project_Node --
359 --------------------------
361 function Default_Project_Node
362 (Of_Kind
: Project_Node_Kind
;
363 And_Expr_Kind
: Variable_Kind
:= Undefined
) return Project_Node_Id
365 Result
: Project_Node_Id
;
366 Zone
: Project_Node_Id
;
367 Previous
: Project_Node_Id
;
370 -- Create new node with specified kind and expression kind
372 Project_Nodes
.Increment_Last
;
373 Project_Nodes
.Table
(Project_Nodes
.Last
) :=
375 Location
=> No_Location
,
376 Directory
=> No_Name
,
377 Expr_Kind
=> And_Expr_Kind
,
378 Variables
=> Empty_Node
,
379 Packages
=> Empty_Node
,
380 Pkg_Id
=> Empty_Package
,
382 Path_Name
=> No_Name
,
384 Field1
=> Empty_Node
,
385 Field2
=> Empty_Node
,
386 Field3
=> Empty_Node
,
389 Comments
=> Empty_Node
);
391 -- Save the new node for the returned value
393 Result
:= Project_Nodes
.Last
;
395 if Comments
.Last
> 0 then
397 -- If this is not a node with comments, then set the flag
399 if not Node_With_Comments
(Of_Kind
) then
400 Unkept_Comments
:= True;
402 elsif Of_Kind
/= N_Comment
and then Of_Kind
/= N_Comment_Zones
then
404 Project_Nodes
.Increment_Last
;
405 Project_Nodes
.Table
(Project_Nodes
.Last
) :=
406 (Kind
=> N_Comment_Zones
,
407 Expr_Kind
=> Undefined
,
408 Location
=> No_Location
,
409 Directory
=> No_Name
,
410 Variables
=> Empty_Node
,
411 Packages
=> Empty_Node
,
412 Pkg_Id
=> Empty_Package
,
414 Path_Name
=> No_Name
,
416 Field1
=> Empty_Node
,
417 Field2
=> Empty_Node
,
418 Field3
=> Empty_Node
,
421 Comments
=> Empty_Node
);
423 Zone
:= Project_Nodes
.Last
;
424 Project_Nodes
.Table
(Result
).Comments
:= Zone
;
425 Previous
:= Empty_Node
;
427 for J
in 1 .. Comments
.Last
loop
429 -- Create a new N_Comment node
431 Project_Nodes
.Increment_Last
;
432 Project_Nodes
.Table
(Project_Nodes
.Last
) :=
434 Expr_Kind
=> Undefined
,
435 Flag1
=> Comments
.Table
(J
).Follows_Empty_Line
,
437 Comments
.Table
(J
).Is_Followed_By_Empty_Line
,
438 Location
=> No_Location
,
439 Directory
=> No_Name
,
440 Variables
=> Empty_Node
,
441 Packages
=> Empty_Node
,
442 Pkg_Id
=> Empty_Package
,
444 Path_Name
=> No_Name
,
445 Value
=> Comments
.Table
(J
).Value
,
446 Field1
=> Empty_Node
,
447 Field2
=> Empty_Node
,
448 Field3
=> Empty_Node
,
449 Comments
=> Empty_Node
);
451 -- Link it to the N_Comment_Zones node, if it is the first,
452 -- otherwise to the previous one.
454 if Previous
= Empty_Node
then
455 Project_Nodes
.Table
(Zone
).Field1
:= Project_Nodes
.Last
;
458 Project_Nodes
.Table
(Previous
).Comments
:=
462 -- This new node will be the previous one for the next
463 -- N_Comment node, if there is one.
465 Previous
:= Project_Nodes
.Last
;
468 -- Empty the Comments table after all comments have been processed
470 Comments
.Set_Last
(0);
475 end Default_Project_Node
;
481 function Directory_Of
(Node
: Project_Node_Id
) return Name_Id
is
486 Project_Nodes
.Table
(Node
).Kind
= N_Project
);
487 return Project_Nodes
.Table
(Node
).Directory
;
490 -------------------------
491 -- End_Of_Line_Comment --
492 -------------------------
494 function End_Of_Line_Comment
(Node
: Project_Node_Id
) return Name_Id
is
495 Zone
: Project_Node_Id
:= Empty_Node
;
498 pragma Assert
(Node
/= Empty_Node
);
499 Zone
:= Project_Nodes
.Table
(Node
).Comments
;
501 if Zone
= Empty_Node
then
504 return Project_Nodes
.Table
(Zone
).Value
;
506 end End_Of_Line_Comment
;
508 ------------------------
509 -- Expression_Kind_Of --
510 ------------------------
512 function Expression_Kind_Of
(Node
: Project_Node_Id
) return Variable_Kind
is
517 (Project_Nodes
.Table
(Node
).Kind
= N_Literal_String
519 Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
521 Project_Nodes
.Table
(Node
).Kind
= N_Variable_Declaration
523 Project_Nodes
.Table
(Node
).Kind
= N_Typed_Variable_Declaration
525 Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
527 Project_Nodes
.Table
(Node
).Kind
= N_Expression
529 Project_Nodes
.Table
(Node
).Kind
= N_Term
531 Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
533 Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
535 return Project_Nodes
.Table
(Node
).Expr_Kind
;
536 end Expression_Kind_Of
;
542 function Expression_Of
543 (Node
: Project_Node_Id
) return Project_Node_Id
549 (Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
551 Project_Nodes
.Table
(Node
).Kind
= N_Typed_Variable_Declaration
553 Project_Nodes
.Table
(Node
).Kind
= N_Variable_Declaration
));
555 return Project_Nodes
.Table
(Node
).Field1
;
558 -------------------------
559 -- Extended_Project_Of --
560 -------------------------
562 function Extended_Project_Of
563 (Node
: Project_Node_Id
) return Project_Node_Id
569 Project_Nodes
.Table
(Node
).Kind
= N_Project_Declaration
);
570 return Project_Nodes
.Table
(Node
).Field2
;
571 end Extended_Project_Of
;
573 ------------------------------
574 -- Extended_Project_Path_Of --
575 ------------------------------
577 function Extended_Project_Path_Of
578 (Node
: Project_Node_Id
) return Name_Id
584 Project_Nodes
.Table
(Node
).Kind
= N_Project
);
585 return Project_Nodes
.Table
(Node
).Value
;
586 end Extended_Project_Path_Of
;
588 --------------------------
589 -- Extending_Project_Of --
590 --------------------------
591 function Extending_Project_Of
592 (Node
: Project_Node_Id
) return Project_Node_Id
598 Project_Nodes
.Table
(Node
).Kind
= N_Project_Declaration
);
599 return Project_Nodes
.Table
(Node
).Field3
;
600 end Extending_Project_Of
;
602 ---------------------------
603 -- External_Reference_Of --
604 ---------------------------
606 function External_Reference_Of
607 (Node
: Project_Node_Id
) return Project_Node_Id
613 Project_Nodes
.Table
(Node
).Kind
= N_External_Value
);
614 return Project_Nodes
.Table
(Node
).Field1
;
615 end External_Reference_Of
;
617 -------------------------
618 -- External_Default_Of --
619 -------------------------
621 function External_Default_Of
622 (Node
: Project_Node_Id
)
623 return Project_Node_Id
629 Project_Nodes
.Table
(Node
).Kind
= N_External_Value
);
630 return Project_Nodes
.Table
(Node
).Field2
;
631 end External_Default_Of
;
633 ------------------------
634 -- First_Case_Item_Of --
635 ------------------------
637 function First_Case_Item_Of
638 (Node
: Project_Node_Id
) return Project_Node_Id
644 Project_Nodes
.Table
(Node
).Kind
= N_Case_Construction
);
645 return Project_Nodes
.Table
(Node
).Field2
;
646 end First_Case_Item_Of
;
648 ---------------------
649 -- First_Choice_Of --
650 ---------------------
652 function First_Choice_Of
653 (Node
: Project_Node_Id
)
654 return Project_Node_Id
660 Project_Nodes
.Table
(Node
).Kind
= N_Case_Item
);
661 return Project_Nodes
.Table
(Node
).Field1
;
664 -------------------------
665 -- First_Comment_After --
666 -------------------------
668 function First_Comment_After
669 (Node
: Project_Node_Id
) return Project_Node_Id
671 Zone
: Project_Node_Id
:= Empty_Node
;
673 pragma Assert
(Node
/= Empty_Node
);
674 Zone
:= Project_Nodes
.Table
(Node
).Comments
;
676 if Zone
= Empty_Node
then
680 return Project_Nodes
.Table
(Zone
).Field2
;
682 end First_Comment_After
;
684 -----------------------------
685 -- First_Comment_After_End --
686 -----------------------------
688 function First_Comment_After_End
689 (Node
: Project_Node_Id
)
690 return Project_Node_Id
692 Zone
: Project_Node_Id
:= Empty_Node
;
695 pragma Assert
(Node
/= Empty_Node
);
696 Zone
:= Project_Nodes
.Table
(Node
).Comments
;
698 if Zone
= Empty_Node
then
702 return Project_Nodes
.Table
(Zone
).Comments
;
704 end First_Comment_After_End
;
706 --------------------------
707 -- First_Comment_Before --
708 --------------------------
710 function First_Comment_Before
711 (Node
: Project_Node_Id
) return Project_Node_Id
713 Zone
: Project_Node_Id
:= Empty_Node
;
716 pragma Assert
(Node
/= Empty_Node
);
717 Zone
:= Project_Nodes
.Table
(Node
).Comments
;
719 if Zone
= Empty_Node
then
723 return Project_Nodes
.Table
(Zone
).Field1
;
725 end First_Comment_Before
;
727 ------------------------------
728 -- First_Comment_Before_End --
729 ------------------------------
731 function First_Comment_Before_End
732 (Node
: Project_Node_Id
) return Project_Node_Id
734 Zone
: Project_Node_Id
:= Empty_Node
;
737 pragma Assert
(Node
/= Empty_Node
);
738 Zone
:= Project_Nodes
.Table
(Node
).Comments
;
740 if Zone
= Empty_Node
then
744 return Project_Nodes
.Table
(Zone
).Field3
;
746 end First_Comment_Before_End
;
748 -------------------------------
749 -- First_Declarative_Item_Of --
750 -------------------------------
752 function First_Declarative_Item_Of
753 (Node
: Project_Node_Id
) return Project_Node_Id
759 (Project_Nodes
.Table
(Node
).Kind
= N_Project_Declaration
761 Project_Nodes
.Table
(Node
).Kind
= N_Case_Item
763 Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
));
765 if Project_Nodes
.Table
(Node
).Kind
= N_Project_Declaration
then
766 return Project_Nodes
.Table
(Node
).Field1
;
768 return Project_Nodes
.Table
(Node
).Field2
;
770 end First_Declarative_Item_Of
;
772 ------------------------------
773 -- First_Expression_In_List --
774 ------------------------------
776 function First_Expression_In_List
777 (Node
: Project_Node_Id
) return Project_Node_Id
783 Project_Nodes
.Table
(Node
).Kind
= N_Literal_String_List
);
784 return Project_Nodes
.Table
(Node
).Field1
;
785 end First_Expression_In_List
;
787 --------------------------
788 -- First_Literal_String --
789 --------------------------
791 function First_Literal_String
792 (Node
: Project_Node_Id
) return Project_Node_Id
798 Project_Nodes
.Table
(Node
).Kind
= N_String_Type_Declaration
);
799 return Project_Nodes
.Table
(Node
).Field1
;
800 end First_Literal_String
;
802 ----------------------
803 -- First_Package_Of --
804 ----------------------
806 function First_Package_Of
807 (Node
: Project_Node_Id
) return Package_Declaration_Id
813 Project_Nodes
.Table
(Node
).Kind
= N_Project
);
814 return Project_Nodes
.Table
(Node
).Packages
;
815 end First_Package_Of
;
817 --------------------------
818 -- First_String_Type_Of --
819 --------------------------
821 function First_String_Type_Of
822 (Node
: Project_Node_Id
) return Project_Node_Id
828 Project_Nodes
.Table
(Node
).Kind
= N_Project
);
829 return Project_Nodes
.Table
(Node
).Field3
;
830 end First_String_Type_Of
;
837 (Node
: Project_Node_Id
) return Project_Node_Id
843 Project_Nodes
.Table
(Node
).Kind
= N_Expression
);
844 return Project_Nodes
.Table
(Node
).Field1
;
847 -----------------------
848 -- First_Variable_Of --
849 -----------------------
851 function First_Variable_Of
852 (Node
: Project_Node_Id
) return Variable_Node_Id
858 (Project_Nodes
.Table
(Node
).Kind
= N_Project
860 Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
));
862 return Project_Nodes
.Table
(Node
).Variables
;
863 end First_Variable_Of
;
865 --------------------------
866 -- First_With_Clause_Of --
867 --------------------------
869 function First_With_Clause_Of
870 (Node
: Project_Node_Id
) return Project_Node_Id
876 Project_Nodes
.Table
(Node
).Kind
= N_Project
);
877 return Project_Nodes
.Table
(Node
).Field1
;
878 end First_With_Clause_Of
;
880 ------------------------
881 -- Follows_Empty_Line --
882 ------------------------
884 function Follows_Empty_Line
(Node
: Project_Node_Id
) return Boolean is
889 Project_Nodes
.Table
(Node
).Kind
= N_Comment
);
890 return Project_Nodes
.Table
(Node
).Flag1
;
891 end Follows_Empty_Line
;
897 function Hash
(N
: Project_Node_Id
) return Header_Num
is
899 return Header_Num
(N
mod Project_Node_Id
(Header_Num
'Last));
906 procedure Initialize
is
908 Project_Nodes
.Set_Last
(Empty_Node
);
909 Projects_Htable
.Reset
;
912 -------------------------------
913 -- Is_Followed_By_Empty_Line --
914 -------------------------------
916 function Is_Followed_By_Empty_Line
917 (Node
: Project_Node_Id
) return Boolean
923 Project_Nodes
.Table
(Node
).Kind
= N_Comment
);
924 return Project_Nodes
.Table
(Node
).Flag2
;
925 end Is_Followed_By_Empty_Line
;
927 ----------------------
928 -- Is_Extending_All --
929 ----------------------
931 function Is_Extending_All
(Node
: Project_Node_Id
) return Boolean is
936 Project_Nodes
.Table
(Node
).Kind
= N_Project
);
937 return Project_Nodes
.Table
(Node
).Flag2
;
938 end Is_Extending_All
;
940 -------------------------------------
941 -- Imported_Or_Extended_Project_Of --
942 -------------------------------------
944 function Imported_Or_Extended_Project_Of
945 (Project
: Project_Node_Id
;
946 With_Name
: Name_Id
) return Project_Node_Id
948 With_Clause
: Project_Node_Id
:= First_With_Clause_Of
(Project
);
949 Result
: Project_Node_Id
:= Empty_Node
;
952 -- First check all the imported projects
954 while With_Clause
/= Empty_Node
loop
956 -- Only non limited imported project may be used as prefix
957 -- of variable or attributes.
959 Result
:= Non_Limited_Project_Node_Of
(With_Clause
);
960 exit when Result
/= Empty_Node
and then Name_Of
(Result
) = With_Name
;
961 With_Clause
:= Next_With_Clause_Of
(With_Clause
);
964 -- If it is not an imported project, it might be the imported project
966 if With_Clause
= Empty_Node
then
967 Result
:= Extended_Project_Of
(Project_Declaration_Of
(Project
));
969 if Result
/= Empty_Node
970 and then Name_Of
(Result
) /= With_Name
972 Result
:= Empty_Node
;
977 end Imported_Or_Extended_Project_Of
;
983 function Kind_Of
(Node
: Project_Node_Id
) return Project_Node_Kind
is
985 pragma Assert
(Node
/= Empty_Node
);
986 return Project_Nodes
.Table
(Node
).Kind
;
993 function Location_Of
(Node
: Project_Node_Id
) return Source_Ptr
is
995 pragma Assert
(Node
/= Empty_Node
);
996 return Project_Nodes
.Table
(Node
).Location
;
1003 function Name_Of
(Node
: Project_Node_Id
) return Name_Id
is
1005 pragma Assert
(Node
/= Empty_Node
);
1006 return Project_Nodes
.Table
(Node
).Name
;
1009 --------------------
1010 -- Next_Case_Item --
1011 --------------------
1013 function Next_Case_Item
1014 (Node
: Project_Node_Id
) return Project_Node_Id
1020 Project_Nodes
.Table
(Node
).Kind
= N_Case_Item
);
1021 return Project_Nodes
.Table
(Node
).Field3
;
1028 function Next_Comment
(Node
: Project_Node_Id
) return Project_Node_Id
is
1033 Project_Nodes
.Table
(Node
).Kind
= N_Comment
);
1034 return Project_Nodes
.Table
(Node
).Comments
;
1037 ---------------------------
1038 -- Next_Declarative_Item --
1039 ---------------------------
1041 function Next_Declarative_Item
1042 (Node
: Project_Node_Id
) return Project_Node_Id
1048 Project_Nodes
.Table
(Node
).Kind
= N_Declarative_Item
);
1049 return Project_Nodes
.Table
(Node
).Field2
;
1050 end Next_Declarative_Item
;
1052 -----------------------------
1053 -- Next_Expression_In_List --
1054 -----------------------------
1056 function Next_Expression_In_List
1057 (Node
: Project_Node_Id
) return Project_Node_Id
1063 Project_Nodes
.Table
(Node
).Kind
= N_Expression
);
1064 return Project_Nodes
.Table
(Node
).Field2
;
1065 end Next_Expression_In_List
;
1067 -------------------------
1068 -- Next_Literal_String --
1069 -------------------------
1071 function Next_Literal_String
1072 (Node
: Project_Node_Id
)
1073 return Project_Node_Id
1079 Project_Nodes
.Table
(Node
).Kind
= N_Literal_String
);
1080 return Project_Nodes
.Table
(Node
).Field1
;
1081 end Next_Literal_String
;
1083 -----------------------------
1084 -- Next_Package_In_Project --
1085 -----------------------------
1087 function Next_Package_In_Project
1088 (Node
: Project_Node_Id
) return Project_Node_Id
1094 Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
);
1095 return Project_Nodes
.Table
(Node
).Field3
;
1096 end Next_Package_In_Project
;
1098 ----------------------
1099 -- Next_String_Type --
1100 ----------------------
1102 function Next_String_Type
1103 (Node
: Project_Node_Id
)
1104 return Project_Node_Id
1110 Project_Nodes
.Table
(Node
).Kind
= N_String_Type_Declaration
);
1111 return Project_Nodes
.Table
(Node
).Field2
;
1112 end Next_String_Type
;
1119 (Node
: Project_Node_Id
) return Project_Node_Id
1125 Project_Nodes
.Table
(Node
).Kind
= N_Term
);
1126 return Project_Nodes
.Table
(Node
).Field2
;
1133 function Next_Variable
1134 (Node
: Project_Node_Id
)
1135 return Project_Node_Id
1141 (Project_Nodes
.Table
(Node
).Kind
= N_Typed_Variable_Declaration
1143 Project_Nodes
.Table
(Node
).Kind
= N_Variable_Declaration
));
1145 return Project_Nodes
.Table
(Node
).Field3
;
1148 -------------------------
1149 -- Next_With_Clause_Of --
1150 -------------------------
1152 function Next_With_Clause_Of
1153 (Node
: Project_Node_Id
) return Project_Node_Id
1159 Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
);
1160 return Project_Nodes
.Table
(Node
).Field2
;
1161 end Next_With_Clause_Of
;
1163 ---------------------------------
1164 -- Non_Limited_Project_Node_Of --
1165 ---------------------------------
1167 function Non_Limited_Project_Node_Of
1168 (Node
: Project_Node_Id
) return Project_Node_Id
1174 (Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
));
1175 return Project_Nodes
.Table
(Node
).Field3
;
1176 end Non_Limited_Project_Node_Of
;
1182 function Package_Id_Of
(Node
: Project_Node_Id
) return Package_Node_Id
is
1187 Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
);
1188 return Project_Nodes
.Table
(Node
).Pkg_Id
;
1191 ---------------------
1192 -- Package_Node_Of --
1193 ---------------------
1195 function Package_Node_Of
1196 (Node
: Project_Node_Id
) return Project_Node_Id
1202 (Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
1204 Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
1205 return Project_Nodes
.Table
(Node
).Field2
;
1206 end Package_Node_Of
;
1212 function Path_Name_Of
(Node
: Project_Node_Id
) return Name_Id
is
1217 (Project_Nodes
.Table
(Node
).Kind
= N_Project
1219 Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
));
1220 return Project_Nodes
.Table
(Node
).Path_Name
;
1223 ----------------------------
1224 -- Project_Declaration_Of --
1225 ----------------------------
1227 function Project_Declaration_Of
1228 (Node
: Project_Node_Id
) return Project_Node_Id
1234 Project_Nodes
.Table
(Node
).Kind
= N_Project
);
1235 return Project_Nodes
.Table
(Node
).Field2
;
1236 end Project_Declaration_Of
;
1238 -------------------------------------------
1239 -- Project_File_Includes_Unkept_Comments --
1240 -------------------------------------------
1242 function Project_File_Includes_Unkept_Comments
1243 (Node
: Project_Node_Id
) return Boolean
1245 Declaration
: constant Project_Node_Id
:=
1246 Project_Declaration_Of
(Node
);
1248 return Project_Nodes
.Table
(Declaration
).Flag1
;
1249 end Project_File_Includes_Unkept_Comments
;
1251 ---------------------
1252 -- Project_Node_Of --
1253 ---------------------
1255 function Project_Node_Of
1256 (Node
: Project_Node_Id
) return Project_Node_Id
1262 (Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
1264 Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
1266 Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
1267 return Project_Nodes
.Table
(Node
).Field1
;
1268 end Project_Node_Of
;
1270 -----------------------------------
1271 -- Project_Of_Renamed_Package_Of --
1272 -----------------------------------
1274 function Project_Of_Renamed_Package_Of
1275 (Node
: Project_Node_Id
) return Project_Node_Id
1281 Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
);
1282 return Project_Nodes
.Table
(Node
).Field1
;
1283 end Project_Of_Renamed_Package_Of
;
1285 --------------------------
1286 -- Remove_Next_End_Node --
1287 --------------------------
1289 procedure Remove_Next_End_Node
is
1291 Next_End_Nodes
.Decrement_Last
;
1292 end Remove_Next_End_Node
;
1298 procedure Reset_State
is
1300 End_Of_Line_Node
:= Empty_Node
;
1301 Previous_Line_Node
:= Empty_Node
;
1302 Previous_End_Node
:= Empty_Node
;
1303 Unkept_Comments
:= False;
1304 Comments
.Set_Last
(0);
1311 procedure Restore
(S
: in Comment_State
) is
1313 End_Of_Line_Node
:= S
.End_Of_Line_Node
;
1314 Previous_Line_Node
:= S
.Previous_Line_Node
;
1315 Previous_End_Node
:= S
.Previous_End_Node
;
1316 Next_End_Nodes
.Set_Last
(0);
1317 Unkept_Comments
:= S
.Unkept_Comments
;
1319 Comments
.Set_Last
(0);
1321 for J
in S
.Comments
'Range loop
1322 Comments
.Increment_Last
;
1323 Comments
.Table
(Comments
.Last
) := S
.Comments
(J
);
1331 procedure Save
(S
: out Comment_State
) is
1332 Cmts
: Comments_Ptr
:= new Comment_Array
(1 .. Comments
.Last
);
1334 for J
in 1 .. Comments
.Last
loop
1335 Cmts
(J
) := Comments
.Table
(J
);
1339 (End_Of_Line_Node
=> End_Of_Line_Node
,
1340 Previous_Line_Node
=> Previous_Line_Node
,
1341 Previous_End_Node
=> Previous_End_Node
,
1342 Unkept_Comments
=> Unkept_Comments
,
1351 Empty_Line
: Boolean := False;
1353 -- If there are comments, then they will not be kept. Set the flag and
1354 -- clear the comments.
1356 if Comments
.Last
> 0 then
1357 Unkept_Comments
:= True;
1358 Comments
.Set_Last
(0);
1361 -- Loop until a token other that End_Of_Line or Comment is found
1364 Prj
.Err
.Scanner
.Scan
;
1367 when Tok_End_Of_Line
=>
1368 if Prev_Token
= Tok_End_Of_Line
then
1371 if Comments
.Last
> 0 then
1372 Comments
.Table
(Comments
.Last
).Is_Followed_By_Empty_Line
1378 -- If this is a line comment, add it to the comment table
1380 if Prev_Token
= Tok_End_Of_Line
1381 or else Prev_Token
= No_Token
1383 Comments
.Increment_Last
;
1384 Comments
.Table
(Comments
.Last
) :=
1385 (Value
=> Comment_Id
,
1386 Follows_Empty_Line
=> Empty_Line
,
1387 Is_Followed_By_Empty_Line
=> False);
1389 -- Otherwise, it is an end of line comment. If there is
1390 -- an end of line node specified, associate the comment with
1393 elsif End_Of_Line_Node
/= Empty_Node
then
1395 Zones
: constant Project_Node_Id
:=
1396 Comment_Zones_Of
(End_Of_Line_Node
);
1398 Project_Nodes
.Table
(Zones
).Value
:= Comment_Id
;
1401 -- Otherwise, this end of line node cannot be kept
1404 Unkept_Comments
:= True;
1405 Comments
.Set_Last
(0);
1408 Empty_Line
:= False;
1411 -- If there are comments, where the first comment is not
1412 -- following an empty line, put the initial uninterrupted
1413 -- comment zone with the node of the preceding line (either
1414 -- a Previous_Line or a Previous_End node), if any.
1416 if Comments
.Last
> 0 and then
1417 not Comments
.Table
(1).Follows_Empty_Line
then
1418 if Previous_Line_Node
/= Empty_Node
then
1420 (To
=> Previous_Line_Node
, Where
=> After
);
1422 elsif Previous_End_Node
/= Empty_Node
then
1424 (To
=> Previous_End_Node
, Where
=> After_End
);
1428 -- If there are still comments and the token is "end", then
1429 -- put these comments with the Next_End node, if any;
1430 -- otherwise, these comments cannot be kept. Always clear
1433 if Comments
.Last
> 0 and then Token
= Tok_End
then
1434 if Next_End_Nodes
.Last
> 0 then
1436 (To
=> Next_End_Nodes
.Table
(Next_End_Nodes
.Last
),
1437 Where
=> Before_End
);
1440 Unkept_Comments
:= True;
1443 Comments
.Set_Last
(0);
1446 -- Reset the End_Of_Line, Previous_Line and Previous_End nodes
1447 -- so that they are not used again.
1449 End_Of_Line_Node
:= Empty_Node
;
1450 Previous_Line_Node
:= Empty_Node
;
1451 Previous_End_Node
:= Empty_Node
;
1460 ------------------------------------
1461 -- Set_Associative_Array_Index_Of --
1462 ------------------------------------
1464 procedure Set_Associative_Array_Index_Of
1465 (Node
: Project_Node_Id
;
1472 (Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
1474 Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
1475 Project_Nodes
.Table
(Node
).Value
:= To
;
1476 end Set_Associative_Array_Index_Of
;
1478 --------------------------------
1479 -- Set_Associative_Package_Of --
1480 --------------------------------
1482 procedure Set_Associative_Package_Of
1483 (Node
: Project_Node_Id
;
1484 To
: Project_Node_Id
)
1490 Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
);
1491 Project_Nodes
.Table
(Node
).Field3
:= To
;
1492 end Set_Associative_Package_Of
;
1494 --------------------------------
1495 -- Set_Associative_Project_Of --
1496 --------------------------------
1498 procedure Set_Associative_Project_Of
1499 (Node
: Project_Node_Id
;
1500 To
: Project_Node_Id
)
1506 (Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
));
1507 Project_Nodes
.Table
(Node
).Field2
:= To
;
1508 end Set_Associative_Project_Of
;
1510 --------------------------
1511 -- Set_Case_Insensitive --
1512 --------------------------
1514 procedure Set_Case_Insensitive
1515 (Node
: Project_Node_Id
;
1522 (Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
1524 Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
1525 Project_Nodes
.Table
(Node
).Flag1
:= To
;
1526 end Set_Case_Insensitive
;
1528 ------------------------------------
1529 -- Set_Case_Variable_Reference_Of --
1530 ------------------------------------
1532 procedure Set_Case_Variable_Reference_Of
1533 (Node
: Project_Node_Id
;
1534 To
: Project_Node_Id
)
1540 Project_Nodes
.Table
(Node
).Kind
= N_Case_Construction
);
1541 Project_Nodes
.Table
(Node
).Field1
:= To
;
1542 end Set_Case_Variable_Reference_Of
;
1544 ---------------------------
1545 -- Set_Current_Item_Node --
1546 ---------------------------
1548 procedure Set_Current_Item_Node
1549 (Node
: Project_Node_Id
;
1550 To
: Project_Node_Id
)
1556 Project_Nodes
.Table
(Node
).Kind
= N_Declarative_Item
);
1557 Project_Nodes
.Table
(Node
).Field1
:= To
;
1558 end Set_Current_Item_Node
;
1560 ----------------------
1561 -- Set_Current_Term --
1562 ----------------------
1564 procedure Set_Current_Term
1565 (Node
: Project_Node_Id
;
1566 To
: Project_Node_Id
)
1572 Project_Nodes
.Table
(Node
).Kind
= N_Term
);
1573 Project_Nodes
.Table
(Node
).Field1
:= To
;
1574 end Set_Current_Term
;
1576 ----------------------
1577 -- Set_Directory_Of --
1578 ----------------------
1580 procedure Set_Directory_Of
1581 (Node
: Project_Node_Id
;
1588 Project_Nodes
.Table
(Node
).Kind
= N_Project
);
1589 Project_Nodes
.Table
(Node
).Directory
:= To
;
1590 end Set_Directory_Of
;
1592 ---------------------
1593 -- Set_End_Of_Line --
1594 ---------------------
1596 procedure Set_End_Of_Line
(To
: Project_Node_Id
) is
1598 End_Of_Line_Node
:= To
;
1599 end Set_End_Of_Line
;
1601 ----------------------------
1602 -- Set_Expression_Kind_Of --
1603 ----------------------------
1605 procedure Set_Expression_Kind_Of
1606 (Node
: Project_Node_Id
;
1613 (Project_Nodes
.Table
(Node
).Kind
= N_Literal_String
1615 Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
1617 Project_Nodes
.Table
(Node
).Kind
= N_Variable_Declaration
1619 Project_Nodes
.Table
(Node
).Kind
= N_Typed_Variable_Declaration
1621 Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
1623 Project_Nodes
.Table
(Node
).Kind
= N_Expression
1625 Project_Nodes
.Table
(Node
).Kind
= N_Term
1627 Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
1629 Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
1630 Project_Nodes
.Table
(Node
).Expr_Kind
:= To
;
1631 end Set_Expression_Kind_Of
;
1633 -----------------------
1634 -- Set_Expression_Of --
1635 -----------------------
1637 procedure Set_Expression_Of
1638 (Node
: Project_Node_Id
;
1639 To
: Project_Node_Id
)
1645 (Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Declaration
1647 Project_Nodes
.Table
(Node
).Kind
= N_Typed_Variable_Declaration
1649 Project_Nodes
.Table
(Node
).Kind
= N_Variable_Declaration
));
1650 Project_Nodes
.Table
(Node
).Field1
:= To
;
1651 end Set_Expression_Of
;
1653 -------------------------------
1654 -- Set_External_Reference_Of --
1655 -------------------------------
1657 procedure Set_External_Reference_Of
1658 (Node
: Project_Node_Id
;
1659 To
: Project_Node_Id
)
1665 Project_Nodes
.Table
(Node
).Kind
= N_External_Value
);
1666 Project_Nodes
.Table
(Node
).Field1
:= To
;
1667 end Set_External_Reference_Of
;
1669 -----------------------------
1670 -- Set_External_Default_Of --
1671 -----------------------------
1673 procedure Set_External_Default_Of
1674 (Node
: Project_Node_Id
;
1675 To
: Project_Node_Id
)
1681 Project_Nodes
.Table
(Node
).Kind
= N_External_Value
);
1682 Project_Nodes
.Table
(Node
).Field2
:= To
;
1683 end Set_External_Default_Of
;
1685 ----------------------------
1686 -- Set_First_Case_Item_Of --
1687 ----------------------------
1689 procedure Set_First_Case_Item_Of
1690 (Node
: Project_Node_Id
;
1691 To
: Project_Node_Id
)
1697 Project_Nodes
.Table
(Node
).Kind
= N_Case_Construction
);
1698 Project_Nodes
.Table
(Node
).Field2
:= To
;
1699 end Set_First_Case_Item_Of
;
1701 -------------------------
1702 -- Set_First_Choice_Of --
1703 -------------------------
1705 procedure Set_First_Choice_Of
1706 (Node
: Project_Node_Id
;
1707 To
: Project_Node_Id
)
1713 Project_Nodes
.Table
(Node
).Kind
= N_Case_Item
);
1714 Project_Nodes
.Table
(Node
).Field1
:= To
;
1715 end Set_First_Choice_Of
;
1717 -----------------------------
1718 -- Set_First_Comment_After --
1719 -----------------------------
1721 procedure Set_First_Comment_After
1722 (Node
: Project_Node_Id
;
1723 To
: Project_Node_Id
)
1725 Zone
: constant Project_Node_Id
:=
1726 Comment_Zones_Of
(Node
);
1728 Project_Nodes
.Table
(Zone
).Field2
:= To
;
1729 end Set_First_Comment_After
;
1731 ---------------------------------
1732 -- Set_First_Comment_After_End --
1733 ---------------------------------
1735 procedure Set_First_Comment_After_End
1736 (Node
: Project_Node_Id
;
1737 To
: Project_Node_Id
)
1739 Zone
: constant Project_Node_Id
:=
1740 Comment_Zones_Of
(Node
);
1742 Project_Nodes
.Table
(Zone
).Comments
:= To
;
1743 end Set_First_Comment_After_End
;
1745 ------------------------------
1746 -- Set_First_Comment_Before --
1747 ------------------------------
1749 procedure Set_First_Comment_Before
1750 (Node
: Project_Node_Id
;
1751 To
: Project_Node_Id
)
1754 Zone
: constant Project_Node_Id
:=
1755 Comment_Zones_Of
(Node
);
1757 Project_Nodes
.Table
(Zone
).Field1
:= To
;
1758 end Set_First_Comment_Before
;
1760 ----------------------------------
1761 -- Set_First_Comment_Before_End --
1762 ----------------------------------
1764 procedure Set_First_Comment_Before_End
1765 (Node
: Project_Node_Id
;
1766 To
: Project_Node_Id
)
1768 Zone
: constant Project_Node_Id
:=
1769 Comment_Zones_Of
(Node
);
1771 Project_Nodes
.Table
(Zone
).Field2
:= To
;
1772 end Set_First_Comment_Before_End
;
1774 ------------------------
1775 -- Set_Next_Case_Item --
1776 ------------------------
1778 procedure Set_Next_Case_Item
1779 (Node
: Project_Node_Id
;
1780 To
: Project_Node_Id
)
1786 Project_Nodes
.Table
(Node
).Kind
= N_Case_Item
);
1787 Project_Nodes
.Table
(Node
).Field3
:= To
;
1788 end Set_Next_Case_Item
;
1790 ----------------------
1791 -- Set_Next_Comment --
1792 ----------------------
1794 procedure Set_Next_Comment
1795 (Node
: Project_Node_Id
;
1796 To
: Project_Node_Id
)
1802 Project_Nodes
.Table
(Node
).Kind
= N_Comment
);
1803 Project_Nodes
.Table
(Node
).Comments
:= To
;
1804 end Set_Next_Comment
;
1806 -----------------------------------
1807 -- Set_First_Declarative_Item_Of --
1808 -----------------------------------
1810 procedure Set_First_Declarative_Item_Of
1811 (Node
: Project_Node_Id
;
1812 To
: Project_Node_Id
)
1818 (Project_Nodes
.Table
(Node
).Kind
= N_Project_Declaration
1820 Project_Nodes
.Table
(Node
).Kind
= N_Case_Item
1822 Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
));
1824 if Project_Nodes
.Table
(Node
).Kind
= N_Project_Declaration
then
1825 Project_Nodes
.Table
(Node
).Field1
:= To
;
1827 Project_Nodes
.Table
(Node
).Field2
:= To
;
1829 end Set_First_Declarative_Item_Of
;
1831 ----------------------------------
1832 -- Set_First_Expression_In_List --
1833 ----------------------------------
1835 procedure Set_First_Expression_In_List
1836 (Node
: Project_Node_Id
;
1837 To
: Project_Node_Id
)
1843 Project_Nodes
.Table
(Node
).Kind
= N_Literal_String_List
);
1844 Project_Nodes
.Table
(Node
).Field1
:= To
;
1845 end Set_First_Expression_In_List
;
1847 ------------------------------
1848 -- Set_First_Literal_String --
1849 ------------------------------
1851 procedure Set_First_Literal_String
1852 (Node
: Project_Node_Id
;
1853 To
: Project_Node_Id
)
1859 Project_Nodes
.Table
(Node
).Kind
= N_String_Type_Declaration
);
1860 Project_Nodes
.Table
(Node
).Field1
:= To
;
1861 end Set_First_Literal_String
;
1863 --------------------------
1864 -- Set_First_Package_Of --
1865 --------------------------
1867 procedure Set_First_Package_Of
1868 (Node
: Project_Node_Id
;
1869 To
: Package_Declaration_Id
)
1875 Project_Nodes
.Table
(Node
).Kind
= N_Project
);
1876 Project_Nodes
.Table
(Node
).Packages
:= To
;
1877 end Set_First_Package_Of
;
1879 ------------------------------
1880 -- Set_First_String_Type_Of --
1881 ------------------------------
1883 procedure Set_First_String_Type_Of
1884 (Node
: Project_Node_Id
;
1885 To
: Project_Node_Id
)
1891 Project_Nodes
.Table
(Node
).Kind
= N_Project
);
1892 Project_Nodes
.Table
(Node
).Field3
:= To
;
1893 end Set_First_String_Type_Of
;
1895 --------------------
1896 -- Set_First_Term --
1897 --------------------
1899 procedure Set_First_Term
1900 (Node
: Project_Node_Id
;
1901 To
: Project_Node_Id
)
1907 Project_Nodes
.Table
(Node
).Kind
= N_Expression
);
1908 Project_Nodes
.Table
(Node
).Field1
:= To
;
1911 ---------------------------
1912 -- Set_First_Variable_Of --
1913 ---------------------------
1915 procedure Set_First_Variable_Of
1916 (Node
: Project_Node_Id
;
1917 To
: Variable_Node_Id
)
1923 (Project_Nodes
.Table
(Node
).Kind
= N_Project
1925 Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
));
1926 Project_Nodes
.Table
(Node
).Variables
:= To
;
1927 end Set_First_Variable_Of
;
1929 ------------------------------
1930 -- Set_First_With_Clause_Of --
1931 ------------------------------
1933 procedure Set_First_With_Clause_Of
1934 (Node
: Project_Node_Id
;
1935 To
: Project_Node_Id
)
1941 Project_Nodes
.Table
(Node
).Kind
= N_Project
);
1942 Project_Nodes
.Table
(Node
).Field1
:= To
;
1943 end Set_First_With_Clause_Of
;
1945 --------------------------
1946 -- Set_Is_Extending_All --
1947 --------------------------
1949 procedure Set_Is_Extending_All
(Node
: Project_Node_Id
) is
1954 Project_Nodes
.Table
(Node
).Kind
= N_Project
);
1955 Project_Nodes
.Table
(Node
).Flag2
:= True;
1956 end Set_Is_Extending_All
;
1962 procedure Set_Kind_Of
1963 (Node
: Project_Node_Id
;
1964 To
: Project_Node_Kind
)
1967 pragma Assert
(Node
/= Empty_Node
);
1968 Project_Nodes
.Table
(Node
).Kind
:= To
;
1971 ---------------------
1972 -- Set_Location_Of --
1973 ---------------------
1975 procedure Set_Location_Of
1976 (Node
: Project_Node_Id
;
1980 pragma Assert
(Node
/= Empty_Node
);
1981 Project_Nodes
.Table
(Node
).Location
:= To
;
1982 end Set_Location_Of
;
1984 -----------------------------
1985 -- Set_Extended_Project_Of --
1986 -----------------------------
1988 procedure Set_Extended_Project_Of
1989 (Node
: Project_Node_Id
;
1990 To
: Project_Node_Id
)
1996 Project_Nodes
.Table
(Node
).Kind
= N_Project_Declaration
);
1997 Project_Nodes
.Table
(Node
).Field2
:= To
;
1998 end Set_Extended_Project_Of
;
2000 ----------------------------------
2001 -- Set_Extended_Project_Path_Of --
2002 ----------------------------------
2004 procedure Set_Extended_Project_Path_Of
2005 (Node
: Project_Node_Id
;
2012 Project_Nodes
.Table
(Node
).Kind
= N_Project
);
2013 Project_Nodes
.Table
(Node
).Value
:= To
;
2014 end Set_Extended_Project_Path_Of
;
2016 ------------------------------
2017 -- Set_Extending_Project_Of --
2018 ------------------------------
2020 procedure Set_Extending_Project_Of
2021 (Node
: Project_Node_Id
;
2022 To
: Project_Node_Id
)
2028 Project_Nodes
.Table
(Node
).Kind
= N_Project_Declaration
);
2029 Project_Nodes
.Table
(Node
).Field3
:= To
;
2030 end Set_Extending_Project_Of
;
2036 procedure Set_Name_Of
2037 (Node
: Project_Node_Id
;
2041 pragma Assert
(Node
/= Empty_Node
);
2042 Project_Nodes
.Table
(Node
).Name
:= To
;
2045 -------------------------------
2046 -- Set_Next_Declarative_Item --
2047 -------------------------------
2049 procedure Set_Next_Declarative_Item
2050 (Node
: Project_Node_Id
;
2051 To
: Project_Node_Id
)
2057 Project_Nodes
.Table
(Node
).Kind
= N_Declarative_Item
);
2058 Project_Nodes
.Table
(Node
).Field2
:= To
;
2059 end Set_Next_Declarative_Item
;
2061 -----------------------
2062 -- Set_Next_End_Node --
2063 -----------------------
2065 procedure Set_Next_End_Node
(To
: Project_Node_Id
) is
2067 Next_End_Nodes
.Increment_Last
;
2068 Next_End_Nodes
.Table
(Next_End_Nodes
.Last
) := To
;
2069 end Set_Next_End_Node
;
2071 ---------------------------------
2072 -- Set_Next_Expression_In_List --
2073 ---------------------------------
2075 procedure Set_Next_Expression_In_List
2076 (Node
: Project_Node_Id
;
2077 To
: Project_Node_Id
)
2083 Project_Nodes
.Table
(Node
).Kind
= N_Expression
);
2084 Project_Nodes
.Table
(Node
).Field2
:= To
;
2085 end Set_Next_Expression_In_List
;
2087 -----------------------------
2088 -- Set_Next_Literal_String --
2089 -----------------------------
2091 procedure Set_Next_Literal_String
2092 (Node
: Project_Node_Id
;
2093 To
: Project_Node_Id
)
2099 Project_Nodes
.Table
(Node
).Kind
= N_Literal_String
);
2100 Project_Nodes
.Table
(Node
).Field1
:= To
;
2101 end Set_Next_Literal_String
;
2103 ---------------------------------
2104 -- Set_Next_Package_In_Project --
2105 ---------------------------------
2107 procedure Set_Next_Package_In_Project
2108 (Node
: Project_Node_Id
;
2109 To
: Project_Node_Id
)
2115 Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
);
2116 Project_Nodes
.Table
(Node
).Field3
:= To
;
2117 end Set_Next_Package_In_Project
;
2119 --------------------------
2120 -- Set_Next_String_Type --
2121 --------------------------
2123 procedure Set_Next_String_Type
2124 (Node
: Project_Node_Id
;
2125 To
: Project_Node_Id
)
2131 Project_Nodes
.Table
(Node
).Kind
= N_String_Type_Declaration
);
2132 Project_Nodes
.Table
(Node
).Field2
:= To
;
2133 end Set_Next_String_Type
;
2139 procedure Set_Next_Term
2140 (Node
: Project_Node_Id
;
2141 To
: Project_Node_Id
)
2147 Project_Nodes
.Table
(Node
).Kind
= N_Term
);
2148 Project_Nodes
.Table
(Node
).Field2
:= To
;
2151 -----------------------
2152 -- Set_Next_Variable --
2153 -----------------------
2155 procedure Set_Next_Variable
2156 (Node
: Project_Node_Id
;
2157 To
: Project_Node_Id
)
2163 (Project_Nodes
.Table
(Node
).Kind
= N_Typed_Variable_Declaration
2165 Project_Nodes
.Table
(Node
).Kind
= N_Variable_Declaration
));
2166 Project_Nodes
.Table
(Node
).Field3
:= To
;
2167 end Set_Next_Variable
;
2169 -----------------------------
2170 -- Set_Next_With_Clause_Of --
2171 -----------------------------
2173 procedure Set_Next_With_Clause_Of
2174 (Node
: Project_Node_Id
;
2175 To
: Project_Node_Id
)
2181 Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
);
2182 Project_Nodes
.Table
(Node
).Field2
:= To
;
2183 end Set_Next_With_Clause_Of
;
2185 -----------------------
2186 -- Set_Package_Id_Of --
2187 -----------------------
2189 procedure Set_Package_Id_Of
2190 (Node
: Project_Node_Id
;
2191 To
: Package_Node_Id
)
2197 Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
);
2198 Project_Nodes
.Table
(Node
).Pkg_Id
:= To
;
2199 end Set_Package_Id_Of
;
2201 -------------------------
2202 -- Set_Package_Node_Of --
2203 -------------------------
2205 procedure Set_Package_Node_Of
2206 (Node
: Project_Node_Id
;
2207 To
: Project_Node_Id
)
2213 (Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
2215 Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
2216 Project_Nodes
.Table
(Node
).Field2
:= To
;
2217 end Set_Package_Node_Of
;
2219 ----------------------
2220 -- Set_Path_Name_Of --
2221 ----------------------
2223 procedure Set_Path_Name_Of
2224 (Node
: Project_Node_Id
;
2231 (Project_Nodes
.Table
(Node
).Kind
= N_Project
2233 Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
));
2234 Project_Nodes
.Table
(Node
).Path_Name
:= To
;
2235 end Set_Path_Name_Of
;
2237 ---------------------------
2238 -- Set_Previous_End_Node --
2239 ---------------------------
2240 procedure Set_Previous_End_Node
(To
: Project_Node_Id
) is
2242 Previous_End_Node
:= To
;
2243 end Set_Previous_End_Node
;
2245 ----------------------------
2246 -- Set_Previous_Line_Node --
2247 ----------------------------
2249 procedure Set_Previous_Line_Node
(To
: Project_Node_Id
) is
2251 Previous_Line_Node
:= To
;
2252 end Set_Previous_Line_Node
;
2254 --------------------------------
2255 -- Set_Project_Declaration_Of --
2256 --------------------------------
2258 procedure Set_Project_Declaration_Of
2259 (Node
: Project_Node_Id
;
2260 To
: Project_Node_Id
)
2266 Project_Nodes
.Table
(Node
).Kind
= N_Project
);
2267 Project_Nodes
.Table
(Node
).Field2
:= To
;
2268 end Set_Project_Declaration_Of
;
2270 -----------------------------------------------
2271 -- Set_Project_File_Includes_Unkept_Comments --
2272 -----------------------------------------------
2274 procedure Set_Project_File_Includes_Unkept_Comments
2275 (Node
: Project_Node_Id
;
2278 Declaration
: constant Project_Node_Id
:=
2279 Project_Declaration_Of
(Node
);
2281 Project_Nodes
.Table
(Declaration
).Flag1
:= To
;
2282 end Set_Project_File_Includes_Unkept_Comments
;
2284 -------------------------
2285 -- Set_Project_Node_Of --
2286 -------------------------
2288 procedure Set_Project_Node_Of
2289 (Node
: Project_Node_Id
;
2290 To
: Project_Node_Id
;
2291 Limited_With
: Boolean := False)
2297 (Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
2299 Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
2301 Project_Nodes
.Table
(Node
).Kind
= N_Attribute_Reference
));
2302 Project_Nodes
.Table
(Node
).Field1
:= To
;
2304 if Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
2305 and then not Limited_With
2307 Project_Nodes
.Table
(Node
).Field3
:= To
;
2309 end Set_Project_Node_Of
;
2311 ---------------------------------------
2312 -- Set_Project_Of_Renamed_Package_Of --
2313 ---------------------------------------
2315 procedure Set_Project_Of_Renamed_Package_Of
2316 (Node
: Project_Node_Id
;
2317 To
: Project_Node_Id
)
2323 Project_Nodes
.Table
(Node
).Kind
= N_Package_Declaration
);
2324 Project_Nodes
.Table
(Node
).Field1
:= To
;
2325 end Set_Project_Of_Renamed_Package_Of
;
2327 ------------------------
2328 -- Set_String_Type_Of --
2329 ------------------------
2331 procedure Set_String_Type_Of
2332 (Node
: Project_Node_Id
;
2333 To
: Project_Node_Id
)
2339 (Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
2341 Project_Nodes
.Table
(Node
).Kind
= N_Typed_Variable_Declaration
)
2343 Project_Nodes
.Table
(To
).Kind
= N_String_Type_Declaration
);
2345 if Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
then
2346 Project_Nodes
.Table
(Node
).Field3
:= To
;
2348 Project_Nodes
.Table
(Node
).Field2
:= To
;
2350 end Set_String_Type_Of
;
2352 -------------------------
2353 -- Set_String_Value_Of --
2354 -------------------------
2356 procedure Set_String_Value_Of
2357 (Node
: Project_Node_Id
;
2364 (Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
2366 Project_Nodes
.Table
(Node
).Kind
= N_Comment
2368 Project_Nodes
.Table
(Node
).Kind
= N_Literal_String
));
2369 Project_Nodes
.Table
(Node
).Value
:= To
;
2370 end Set_String_Value_Of
;
2372 --------------------
2373 -- String_Type_Of --
2374 --------------------
2376 function String_Type_Of
2377 (Node
: Project_Node_Id
) return Project_Node_Id
2383 (Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
2385 Project_Nodes
.Table
(Node
).Kind
= N_Typed_Variable_Declaration
));
2387 if Project_Nodes
.Table
(Node
).Kind
= N_Variable_Reference
then
2388 return Project_Nodes
.Table
(Node
).Field3
;
2390 return Project_Nodes
.Table
(Node
).Field2
;
2394 ---------------------
2395 -- String_Value_Of --
2396 ---------------------
2398 function String_Value_Of
(Node
: Project_Node_Id
) return Name_Id
is
2403 (Project_Nodes
.Table
(Node
).Kind
= N_With_Clause
2405 Project_Nodes
.Table
(Node
).Kind
= N_Comment
2407 Project_Nodes
.Table
(Node
).Kind
= N_Literal_String
));
2408 return Project_Nodes
.Table
(Node
).Value
;
2409 end String_Value_Of
;
2411 --------------------
2412 -- Value_Is_Valid --
2413 --------------------
2415 function Value_Is_Valid
2416 (For_Typed_Variable
: Project_Node_Id
;
2417 Value
: Name_Id
) return Boolean
2421 (For_Typed_Variable
/= Empty_Node
2423 (Project_Nodes
.Table
(For_Typed_Variable
).Kind
=
2424 N_Typed_Variable_Declaration
));
2427 Current_String
: Project_Node_Id
:=
2428 First_Literal_String
2429 (String_Type_Of
(For_Typed_Variable
));
2432 while Current_String
/= Empty_Node
2434 String_Value_Of
(Current_String
) /= Value
2437 Next_Literal_String
(Current_String
);
2440 return Current_String
/= Empty_Node
;
2445 -------------------------------
2446 -- There_Are_Unkept_Comments --
2447 -------------------------------
2449 function There_Are_Unkept_Comments
return Boolean is
2451 return Unkept_Comments
;
2452 end There_Are_Unkept_Comments
;