2003-12-26 Guilhem Lavaux <guilhem@kaffe.org>
[official-gcc.git] / gcc / ada / prj-tree.adb
blob7e548e8ce2e63c4330897564d02d51f431c63fae
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- P R J . T R E E --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2001-2003 Free Software Foundation, Inc. --
10 -- --
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. --
21 -- --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 -- --
25 ------------------------------------------------------------------------------
27 with Prj.Err;
29 package body Prj.Tree is
31 Node_With_Comments : constant array (Project_Node_Kind) of Boolean :=
32 (N_Project => True,
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,
43 N_Term => 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,
49 N_Case_Item => True,
50 N_Comment_Zones => True,
51 N_Comment => 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,
57 Table_Low_Bound => 1,
58 Table_Initial => 10,
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
73 -- associated with.
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.
84 ------------------
85 -- Add_Comments --
86 ------------------
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;
92 begin
93 pragma Assert
94 (To /= Empty_Node
95 and then
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,
113 Name => No_Name,
114 Path_Name => No_Name,
115 Value => No_Name,
116 Field1 => Empty_Node,
117 Field2 => Empty_Node,
118 Field3 => Empty_Node,
119 Flag1 => False,
120 Flag2 => False,
121 Comments => Empty_Node);
123 Zone := Project_Nodes.Last;
124 Project_Nodes.Table (To).Comments := Zone;
125 end if;
127 if Where = End_Of_Line then
128 Project_Nodes.Table (Zone).Value := Comments.Table (1).Value;
130 else
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
140 then
141 Comments.Table (1 .. Comments.Last - J + 1) :=
142 Comments.Table (J .. Comments.Last);
143 Comments.Set_Last (Comments.Last - J + 1);
144 return;
145 end if;
147 Project_Nodes.Increment_Last;
148 Project_Nodes.Table (Project_Nodes.Last) :=
149 (Kind => N_Comment,
150 Expr_Kind => Undefined,
151 Flag1 => Comments.Table (J).Follows_Empty_Line,
152 Flag2 =>
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,
159 Name => No_Name,
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
168 -- the node Zone.
170 if Previous = Empty_Node then
171 case Where is
172 when Before =>
173 Project_Nodes.Table (Zone).Field1 := Project_Nodes.Last;
175 when After =>
176 Project_Nodes.Table (Zone).Field2 := Project_Nodes.Last;
178 when Before_End =>
179 Project_Nodes.Table (Zone).Field3 := Project_Nodes.Last;
181 when After_End =>
182 Project_Nodes.Table (Zone).Comments := Project_Nodes.Last;
184 when End_Of_Line =>
185 null;
186 end case;
188 else
189 -- When it is not the first, link it to the previous one
191 Project_Nodes.Table (Previous).Comments := Project_Nodes.Last;
192 end if;
194 -- This node becomes the previous one for the next comment, if
195 -- there is one.
197 Previous := Project_Nodes.Last;
198 end loop;
199 end if;
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);
205 end Add_Comments;
208 --------------------------------
209 -- Associative_Array_Index_Of --
210 --------------------------------
212 function Associative_Array_Index_Of
213 (Node : Project_Node_Id) return Name_Id
215 begin
216 pragma Assert
217 (Node /= Empty_Node
218 and then
219 (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
220 or else
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
232 begin
233 pragma Assert
234 (Node /= Empty_Node
235 and then
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
247 begin
248 pragma Assert
249 (Node /= Empty_Node
250 and then
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
260 begin
261 pragma Assert
262 (Node /= Empty_Node
263 and then
264 (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
265 or else
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
277 begin
278 pragma Assert
279 (Node /= Empty_Node
280 and then
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;
294 begin
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,
312 Name => No_Name,
313 Path_Name => No_Name,
314 Value => No_Name,
315 Field1 => Empty_Node,
316 Field2 => Empty_Node,
317 Field3 => Empty_Node,
318 Flag1 => False,
319 Flag2 => False,
320 Comments => Empty_Node);
321 Project_Nodes.Table (Node).Comments := Zone;
322 end if;
324 return 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
334 begin
335 pragma Assert
336 (Node /= Empty_Node
337 and then
338 Project_Nodes.Table (Node).Kind = N_Declarative_Item);
339 return Project_Nodes.Table (Node).Field1;
340 end Current_Item_Node;
342 ------------------
343 -- Current_Term --
344 ------------------
346 function Current_Term
347 (Node : Project_Node_Id) return Project_Node_Id
349 begin
350 pragma Assert
351 (Node /= Empty_Node
352 and then
353 Project_Nodes.Table (Node).Kind = N_Term);
354 return Project_Nodes.Table (Node).Field1;
355 end Current_Term;
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;
369 begin
370 -- Create new node with specified kind and expression kind
372 Project_Nodes.Increment_Last;
373 Project_Nodes.Table (Project_Nodes.Last) :=
374 (Kind => Of_Kind,
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,
381 Name => No_Name,
382 Path_Name => No_Name,
383 Value => No_Name,
384 Field1 => Empty_Node,
385 Field2 => Empty_Node,
386 Field3 => Empty_Node,
387 Flag1 => False,
388 Flag2 => False,
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,
413 Name => No_Name,
414 Path_Name => No_Name,
415 Value => No_Name,
416 Field1 => Empty_Node,
417 Field2 => Empty_Node,
418 Field3 => Empty_Node,
419 Flag1 => False,
420 Flag2 => False,
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) :=
433 (Kind => N_Comment,
434 Expr_Kind => Undefined,
435 Flag1 => Comments.Table (J).Follows_Empty_Line,
436 Flag2 =>
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,
443 Name => No_Name,
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;
457 else
458 Project_Nodes.Table (Previous).Comments :=
459 Project_Nodes.Last;
460 end if;
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;
466 end loop;
468 -- Empty the Comments table after all comments have been processed
470 Comments.Set_Last (0);
471 end if;
472 end if;
474 return Result;
475 end Default_Project_Node;
477 ------------------
478 -- Directory_Of --
479 ------------------
481 function Directory_Of (Node : Project_Node_Id) return Name_Id is
482 begin
483 pragma Assert
484 (Node /= Empty_Node
485 and then
486 Project_Nodes.Table (Node).Kind = N_Project);
487 return Project_Nodes.Table (Node).Directory;
488 end Directory_Of;
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;
497 begin
498 pragma Assert (Node /= Empty_Node);
499 Zone := Project_Nodes.Table (Node).Comments;
501 if Zone = Empty_Node then
502 return No_Name;
503 else
504 return Project_Nodes.Table (Zone).Value;
505 end if;
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
513 begin
514 pragma Assert
515 (Node /= Empty_Node
516 and then
517 (Project_Nodes.Table (Node).Kind = N_Literal_String
518 or else
519 Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
520 or else
521 Project_Nodes.Table (Node).Kind = N_Variable_Declaration
522 or else
523 Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration
524 or else
525 Project_Nodes.Table (Node).Kind = N_Package_Declaration
526 or else
527 Project_Nodes.Table (Node).Kind = N_Expression
528 or else
529 Project_Nodes.Table (Node).Kind = N_Term
530 or else
531 Project_Nodes.Table (Node).Kind = N_Variable_Reference
532 or else
533 Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
535 return Project_Nodes.Table (Node).Expr_Kind;
536 end Expression_Kind_Of;
538 -------------------
539 -- Expression_Of --
540 -------------------
542 function Expression_Of
543 (Node : Project_Node_Id) return Project_Node_Id
545 begin
546 pragma Assert
547 (Node /= Empty_Node
548 and then
549 (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
550 or else
551 Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration
552 or else
553 Project_Nodes.Table (Node).Kind = N_Variable_Declaration));
555 return Project_Nodes.Table (Node).Field1;
556 end Expression_Of;
558 -------------------------
559 -- Extended_Project_Of --
560 -------------------------
562 function Extended_Project_Of
563 (Node : Project_Node_Id) return Project_Node_Id
565 begin
566 pragma Assert
567 (Node /= Empty_Node
568 and then
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
580 begin
581 pragma Assert
582 (Node /= Empty_Node
583 and then
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
594 begin
595 pragma Assert
596 (Node /= Empty_Node
597 and then
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
609 begin
610 pragma Assert
611 (Node /= Empty_Node
612 and then
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
625 begin
626 pragma Assert
627 (Node /= Empty_Node
628 and then
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
640 begin
641 pragma Assert
642 (Node /= Empty_Node
643 and then
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
656 begin
657 pragma Assert
658 (Node /= Empty_Node
659 and then
660 Project_Nodes.Table (Node).Kind = N_Case_Item);
661 return Project_Nodes.Table (Node).Field1;
662 end First_Choice_Of;
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;
672 begin
673 pragma Assert (Node /= Empty_Node);
674 Zone := Project_Nodes.Table (Node).Comments;
676 if Zone = Empty_Node then
677 return Empty_Node;
679 else
680 return Project_Nodes.Table (Zone).Field2;
681 end if;
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;
694 begin
695 pragma Assert (Node /= Empty_Node);
696 Zone := Project_Nodes.Table (Node).Comments;
698 if Zone = Empty_Node then
699 return Empty_Node;
701 else
702 return Project_Nodes.Table (Zone).Comments;
703 end if;
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;
715 begin
716 pragma Assert (Node /= Empty_Node);
717 Zone := Project_Nodes.Table (Node).Comments;
719 if Zone = Empty_Node then
720 return Empty_Node;
722 else
723 return Project_Nodes.Table (Zone).Field1;
724 end if;
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;
736 begin
737 pragma Assert (Node /= Empty_Node);
738 Zone := Project_Nodes.Table (Node).Comments;
740 if Zone = Empty_Node then
741 return Empty_Node;
743 else
744 return Project_Nodes.Table (Zone).Field3;
745 end if;
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
755 begin
756 pragma Assert
757 (Node /= Empty_Node
758 and then
759 (Project_Nodes.Table (Node).Kind = N_Project_Declaration
760 or else
761 Project_Nodes.Table (Node).Kind = N_Case_Item
762 or else
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;
767 else
768 return Project_Nodes.Table (Node).Field2;
769 end if;
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
779 begin
780 pragma Assert
781 (Node /= Empty_Node
782 and then
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
794 begin
795 pragma Assert
796 (Node /= Empty_Node
797 and then
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
809 begin
810 pragma Assert
811 (Node /= Empty_Node
812 and then
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
824 begin
825 pragma Assert
826 (Node /= Empty_Node
827 and then
828 Project_Nodes.Table (Node).Kind = N_Project);
829 return Project_Nodes.Table (Node).Field3;
830 end First_String_Type_Of;
832 ----------------
833 -- First_Term --
834 ----------------
836 function First_Term
837 (Node : Project_Node_Id) return Project_Node_Id
839 begin
840 pragma Assert
841 (Node /= Empty_Node
842 and then
843 Project_Nodes.Table (Node).Kind = N_Expression);
844 return Project_Nodes.Table (Node).Field1;
845 end First_Term;
847 -----------------------
848 -- First_Variable_Of --
849 -----------------------
851 function First_Variable_Of
852 (Node : Project_Node_Id) return Variable_Node_Id
854 begin
855 pragma Assert
856 (Node /= Empty_Node
857 and then
858 (Project_Nodes.Table (Node).Kind = N_Project
859 or else
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
872 begin
873 pragma Assert
874 (Node /= Empty_Node
875 and then
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
885 begin
886 pragma Assert
887 (Node /= Empty_Node
888 and then
889 Project_Nodes.Table (Node).Kind = N_Comment);
890 return Project_Nodes.Table (Node).Flag1;
891 end Follows_Empty_Line;
893 ----------
894 -- Hash --
895 ----------
897 function Hash (N : Project_Node_Id) return Header_Num is
898 begin
899 return Header_Num (N mod Project_Node_Id (Header_Num'Last));
900 end Hash;
902 ----------------
903 -- Initialize --
904 ----------------
906 procedure Initialize is
907 begin
908 Project_Nodes.Set_Last (Empty_Node);
909 Projects_Htable.Reset;
910 end Initialize;
912 -------------------------------
913 -- Is_Followed_By_Empty_Line --
914 -------------------------------
916 function Is_Followed_By_Empty_Line
917 (Node : Project_Node_Id) return Boolean
919 begin
920 pragma Assert
921 (Node /= Empty_Node
922 and then
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
932 begin
933 pragma Assert
934 (Node /= Empty_Node
935 and then
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;
951 begin
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);
962 end loop;
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
971 then
972 Result := Empty_Node;
973 end if;
974 end if;
976 return Result;
977 end Imported_Or_Extended_Project_Of;
979 -------------
980 -- Kind_Of --
981 -------------
983 function Kind_Of (Node : Project_Node_Id) return Project_Node_Kind is
984 begin
985 pragma Assert (Node /= Empty_Node);
986 return Project_Nodes.Table (Node).Kind;
987 end Kind_Of;
989 -----------------
990 -- Location_Of --
991 -----------------
993 function Location_Of (Node : Project_Node_Id) return Source_Ptr is
994 begin
995 pragma Assert (Node /= Empty_Node);
996 return Project_Nodes.Table (Node).Location;
997 end Location_Of;
999 -------------
1000 -- Name_Of --
1001 -------------
1003 function Name_Of (Node : Project_Node_Id) return Name_Id is
1004 begin
1005 pragma Assert (Node /= Empty_Node);
1006 return Project_Nodes.Table (Node).Name;
1007 end Name_Of;
1009 --------------------
1010 -- Next_Case_Item --
1011 --------------------
1013 function Next_Case_Item
1014 (Node : Project_Node_Id) return Project_Node_Id
1016 begin
1017 pragma Assert
1018 (Node /= Empty_Node
1019 and then
1020 Project_Nodes.Table (Node).Kind = N_Case_Item);
1021 return Project_Nodes.Table (Node).Field3;
1022 end Next_Case_Item;
1024 ------------------
1025 -- Next_Comment --
1026 ------------------
1028 function Next_Comment (Node : Project_Node_Id) return Project_Node_Id is
1029 begin
1030 pragma Assert
1031 (Node /= Empty_Node
1032 and then
1033 Project_Nodes.Table (Node).Kind = N_Comment);
1034 return Project_Nodes.Table (Node).Comments;
1035 end Next_Comment;
1037 ---------------------------
1038 -- Next_Declarative_Item --
1039 ---------------------------
1041 function Next_Declarative_Item
1042 (Node : Project_Node_Id) return Project_Node_Id
1044 begin
1045 pragma Assert
1046 (Node /= Empty_Node
1047 and then
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
1059 begin
1060 pragma Assert
1061 (Node /= Empty_Node
1062 and then
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
1075 begin
1076 pragma Assert
1077 (Node /= Empty_Node
1078 and then
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
1090 begin
1091 pragma Assert
1092 (Node /= Empty_Node
1093 and then
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
1106 begin
1107 pragma Assert
1108 (Node /= Empty_Node
1109 and then
1110 Project_Nodes.Table (Node).Kind = N_String_Type_Declaration);
1111 return Project_Nodes.Table (Node).Field2;
1112 end Next_String_Type;
1114 ---------------
1115 -- Next_Term --
1116 ---------------
1118 function Next_Term
1119 (Node : Project_Node_Id) return Project_Node_Id
1121 begin
1122 pragma Assert
1123 (Node /= Empty_Node
1124 and then
1125 Project_Nodes.Table (Node).Kind = N_Term);
1126 return Project_Nodes.Table (Node).Field2;
1127 end Next_Term;
1129 -------------------
1130 -- Next_Variable --
1131 -------------------
1133 function Next_Variable
1134 (Node : Project_Node_Id)
1135 return Project_Node_Id
1137 begin
1138 pragma Assert
1139 (Node /= Empty_Node
1140 and then
1141 (Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration
1142 or else
1143 Project_Nodes.Table (Node).Kind = N_Variable_Declaration));
1145 return Project_Nodes.Table (Node).Field3;
1146 end Next_Variable;
1148 -------------------------
1149 -- Next_With_Clause_Of --
1150 -------------------------
1152 function Next_With_Clause_Of
1153 (Node : Project_Node_Id) return Project_Node_Id
1155 begin
1156 pragma Assert
1157 (Node /= Empty_Node
1158 and then
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
1170 begin
1171 pragma Assert
1172 (Node /= Empty_Node
1173 and then
1174 (Project_Nodes.Table (Node).Kind = N_With_Clause));
1175 return Project_Nodes.Table (Node).Field3;
1176 end Non_Limited_Project_Node_Of;
1178 -------------------
1179 -- Package_Id_Of --
1180 -------------------
1182 function Package_Id_Of (Node : Project_Node_Id) return Package_Node_Id is
1183 begin
1184 pragma Assert
1185 (Node /= Empty_Node
1186 and then
1187 Project_Nodes.Table (Node).Kind = N_Package_Declaration);
1188 return Project_Nodes.Table (Node).Pkg_Id;
1189 end Package_Id_Of;
1191 ---------------------
1192 -- Package_Node_Of --
1193 ---------------------
1195 function Package_Node_Of
1196 (Node : Project_Node_Id) return Project_Node_Id
1198 begin
1199 pragma Assert
1200 (Node /= Empty_Node
1201 and then
1202 (Project_Nodes.Table (Node).Kind = N_Variable_Reference
1203 or else
1204 Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
1205 return Project_Nodes.Table (Node).Field2;
1206 end Package_Node_Of;
1208 ------------------
1209 -- Path_Name_Of --
1210 ------------------
1212 function Path_Name_Of (Node : Project_Node_Id) return Name_Id is
1213 begin
1214 pragma Assert
1215 (Node /= Empty_Node
1216 and then
1217 (Project_Nodes.Table (Node).Kind = N_Project
1218 or else
1219 Project_Nodes.Table (Node).Kind = N_With_Clause));
1220 return Project_Nodes.Table (Node).Path_Name;
1221 end Path_Name_Of;
1223 ----------------------------
1224 -- Project_Declaration_Of --
1225 ----------------------------
1227 function Project_Declaration_Of
1228 (Node : Project_Node_Id) return Project_Node_Id
1230 begin
1231 pragma Assert
1232 (Node /= Empty_Node
1233 and then
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);
1247 begin
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
1258 begin
1259 pragma Assert
1260 (Node /= Empty_Node
1261 and then
1262 (Project_Nodes.Table (Node).Kind = N_With_Clause
1263 or else
1264 Project_Nodes.Table (Node).Kind = N_Variable_Reference
1265 or else
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
1277 begin
1278 pragma Assert
1279 (Node /= Empty_Node
1280 and then
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
1290 begin
1291 Next_End_Nodes.Decrement_Last;
1292 end Remove_Next_End_Node;
1294 -----------------
1295 -- Reset_State --
1296 -----------------
1298 procedure Reset_State is
1299 begin
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);
1305 end Reset_State;
1307 -------------
1308 -- Restore --
1309 -------------
1311 procedure Restore (S : in Comment_State) is
1312 begin
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);
1324 end loop;
1325 end Restore;
1327 ----------
1328 -- Save --
1329 ----------
1331 procedure Save (S : out Comment_State) is
1332 Cmts : Comments_Ptr := new Comment_Array (1 .. Comments.Last);
1333 begin
1334 for J in 1 .. Comments.Last loop
1335 Cmts (J) := Comments.Table (J);
1336 end loop;
1338 S :=
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,
1343 Comments => Cmts);
1344 end Save;
1346 ----------
1347 -- Scan --
1348 ----------
1350 procedure Scan is
1351 Empty_Line : Boolean := False;
1352 begin
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);
1359 end if;
1361 -- Loop until a token other that End_Of_Line or Comment is found
1363 loop
1364 Prj.Err.Scanner.Scan;
1366 case Token is
1367 when Tok_End_Of_Line =>
1368 if Prev_Token = Tok_End_Of_Line then
1369 Empty_Line := True;
1371 if Comments.Last > 0 then
1372 Comments.Table (Comments.Last).Is_Followed_By_Empty_Line
1373 := True;
1374 end if;
1375 end if;
1377 when Tok_Comment =>
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
1382 then
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
1391 -- this node.
1393 elsif End_Of_Line_Node /= Empty_Node then
1394 declare
1395 Zones : constant Project_Node_Id :=
1396 Comment_Zones_Of (End_Of_Line_Node);
1397 begin
1398 Project_Nodes.Table (Zones).Value := Comment_Id;
1399 end;
1401 -- Otherwise, this end of line node cannot be kept
1403 else
1404 Unkept_Comments := True;
1405 Comments.Set_Last (0);
1406 end if;
1408 Empty_Line := False;
1410 when others =>
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
1419 Add_Comments
1420 (To => Previous_Line_Node, Where => After);
1422 elsif Previous_End_Node /= Empty_Node then
1423 Add_Comments
1424 (To => Previous_End_Node, Where => After_End);
1425 end if;
1426 end if;
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
1431 -- the comments.
1433 if Comments.Last > 0 and then Token = Tok_End then
1434 if Next_End_Nodes.Last > 0 then
1435 Add_Comments
1436 (To => Next_End_Nodes.Table (Next_End_Nodes.Last),
1437 Where => Before_End);
1439 else
1440 Unkept_Comments := True;
1441 end if;
1443 Comments.Set_Last (0);
1444 end if;
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;
1453 -- And return
1455 exit;
1456 end case;
1457 end loop;
1458 end Scan;
1460 ------------------------------------
1461 -- Set_Associative_Array_Index_Of --
1462 ------------------------------------
1464 procedure Set_Associative_Array_Index_Of
1465 (Node : Project_Node_Id;
1466 To : Name_Id)
1468 begin
1469 pragma Assert
1470 (Node /= Empty_Node
1471 and then
1472 (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
1473 or else
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)
1486 begin
1487 pragma Assert
1488 (Node /= Empty_Node
1489 and then
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)
1502 begin
1503 pragma Assert
1504 (Node /= Empty_Node
1505 and then
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;
1516 To : Boolean)
1518 begin
1519 pragma Assert
1520 (Node /= Empty_Node
1521 and then
1522 (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
1523 or else
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)
1536 begin
1537 pragma Assert
1538 (Node /= Empty_Node
1539 and then
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)
1552 begin
1553 pragma Assert
1554 (Node /= Empty_Node
1555 and then
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)
1568 begin
1569 pragma Assert
1570 (Node /= Empty_Node
1571 and then
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;
1582 To : Name_Id)
1584 begin
1585 pragma Assert
1586 (Node /= Empty_Node
1587 and then
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
1597 begin
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;
1607 To : Variable_Kind)
1609 begin
1610 pragma Assert
1611 (Node /= Empty_Node
1612 and then
1613 (Project_Nodes.Table (Node).Kind = N_Literal_String
1614 or else
1615 Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
1616 or else
1617 Project_Nodes.Table (Node).Kind = N_Variable_Declaration
1618 or else
1619 Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration
1620 or else
1621 Project_Nodes.Table (Node).Kind = N_Package_Declaration
1622 or else
1623 Project_Nodes.Table (Node).Kind = N_Expression
1624 or else
1625 Project_Nodes.Table (Node).Kind = N_Term
1626 or else
1627 Project_Nodes.Table (Node).Kind = N_Variable_Reference
1628 or else
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)
1641 begin
1642 pragma Assert
1643 (Node /= Empty_Node
1644 and then
1645 (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
1646 or else
1647 Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration
1648 or else
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)
1661 begin
1662 pragma Assert
1663 (Node /= Empty_Node
1664 and then
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)
1677 begin
1678 pragma Assert
1679 (Node /= Empty_Node
1680 and then
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)
1693 begin
1694 pragma Assert
1695 (Node /= Empty_Node
1696 and then
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)
1709 begin
1710 pragma Assert
1711 (Node /= Empty_Node
1712 and then
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);
1727 begin
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);
1741 begin
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);
1756 begin
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);
1770 begin
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)
1782 begin
1783 pragma Assert
1784 (Node /= Empty_Node
1785 and then
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)
1798 begin
1799 pragma Assert
1800 (Node /= Empty_Node
1801 and then
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)
1814 begin
1815 pragma Assert
1816 (Node /= Empty_Node
1817 and then
1818 (Project_Nodes.Table (Node).Kind = N_Project_Declaration
1819 or else
1820 Project_Nodes.Table (Node).Kind = N_Case_Item
1821 or else
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;
1826 else
1827 Project_Nodes.Table (Node).Field2 := To;
1828 end if;
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)
1839 begin
1840 pragma Assert
1841 (Node /= Empty_Node
1842 and then
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)
1855 begin
1856 pragma Assert
1857 (Node /= Empty_Node
1858 and then
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)
1871 begin
1872 pragma Assert
1873 (Node /= Empty_Node
1874 and then
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)
1887 begin
1888 pragma Assert
1889 (Node /= Empty_Node
1890 and then
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)
1903 begin
1904 pragma Assert
1905 (Node /= Empty_Node
1906 and then
1907 Project_Nodes.Table (Node).Kind = N_Expression);
1908 Project_Nodes.Table (Node).Field1 := To;
1909 end Set_First_Term;
1911 ---------------------------
1912 -- Set_First_Variable_Of --
1913 ---------------------------
1915 procedure Set_First_Variable_Of
1916 (Node : Project_Node_Id;
1917 To : Variable_Node_Id)
1919 begin
1920 pragma Assert
1921 (Node /= Empty_Node
1922 and then
1923 (Project_Nodes.Table (Node).Kind = N_Project
1924 or else
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)
1937 begin
1938 pragma Assert
1939 (Node /= Empty_Node
1940 and then
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
1950 begin
1951 pragma Assert
1952 (Node /= Empty_Node
1953 and then
1954 Project_Nodes.Table (Node).Kind = N_Project);
1955 Project_Nodes.Table (Node).Flag2 := True;
1956 end Set_Is_Extending_All;
1958 -----------------
1959 -- Set_Kind_Of --
1960 -----------------
1962 procedure Set_Kind_Of
1963 (Node : Project_Node_Id;
1964 To : Project_Node_Kind)
1966 begin
1967 pragma Assert (Node /= Empty_Node);
1968 Project_Nodes.Table (Node).Kind := To;
1969 end Set_Kind_Of;
1971 ---------------------
1972 -- Set_Location_Of --
1973 ---------------------
1975 procedure Set_Location_Of
1976 (Node : Project_Node_Id;
1977 To : Source_Ptr)
1979 begin
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)
1992 begin
1993 pragma Assert
1994 (Node /= Empty_Node
1995 and then
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;
2006 To : Name_Id)
2008 begin
2009 pragma Assert
2010 (Node /= Empty_Node
2011 and then
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)
2024 begin
2025 pragma Assert
2026 (Node /= Empty_Node
2027 and then
2028 Project_Nodes.Table (Node).Kind = N_Project_Declaration);
2029 Project_Nodes.Table (Node).Field3 := To;
2030 end Set_Extending_Project_Of;
2032 -----------------
2033 -- Set_Name_Of --
2034 -----------------
2036 procedure Set_Name_Of
2037 (Node : Project_Node_Id;
2038 To : Name_Id)
2040 begin
2041 pragma Assert (Node /= Empty_Node);
2042 Project_Nodes.Table (Node).Name := To;
2043 end Set_Name_Of;
2045 -------------------------------
2046 -- Set_Next_Declarative_Item --
2047 -------------------------------
2049 procedure Set_Next_Declarative_Item
2050 (Node : Project_Node_Id;
2051 To : Project_Node_Id)
2053 begin
2054 pragma Assert
2055 (Node /= Empty_Node
2056 and then
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
2066 begin
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)
2079 begin
2080 pragma Assert
2081 (Node /= Empty_Node
2082 and then
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)
2095 begin
2096 pragma Assert
2097 (Node /= Empty_Node
2098 and then
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)
2111 begin
2112 pragma Assert
2113 (Node /= Empty_Node
2114 and then
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)
2127 begin
2128 pragma Assert
2129 (Node /= Empty_Node
2130 and then
2131 Project_Nodes.Table (Node).Kind = N_String_Type_Declaration);
2132 Project_Nodes.Table (Node).Field2 := To;
2133 end Set_Next_String_Type;
2135 -------------------
2136 -- Set_Next_Term --
2137 -------------------
2139 procedure Set_Next_Term
2140 (Node : Project_Node_Id;
2141 To : Project_Node_Id)
2143 begin
2144 pragma Assert
2145 (Node /= Empty_Node
2146 and then
2147 Project_Nodes.Table (Node).Kind = N_Term);
2148 Project_Nodes.Table (Node).Field2 := To;
2149 end Set_Next_Term;
2151 -----------------------
2152 -- Set_Next_Variable --
2153 -----------------------
2155 procedure Set_Next_Variable
2156 (Node : Project_Node_Id;
2157 To : Project_Node_Id)
2159 begin
2160 pragma Assert
2161 (Node /= Empty_Node
2162 and then
2163 (Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration
2164 or else
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)
2177 begin
2178 pragma Assert
2179 (Node /= Empty_Node
2180 and then
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)
2193 begin
2194 pragma Assert
2195 (Node /= Empty_Node
2196 and then
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)
2209 begin
2210 pragma Assert
2211 (Node /= Empty_Node
2212 and then
2213 (Project_Nodes.Table (Node).Kind = N_Variable_Reference
2214 or else
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;
2225 To : Name_Id)
2227 begin
2228 pragma Assert
2229 (Node /= Empty_Node
2230 and then
2231 (Project_Nodes.Table (Node).Kind = N_Project
2232 or else
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
2241 begin
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
2250 begin
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)
2262 begin
2263 pragma Assert
2264 (Node /= Empty_Node
2265 and then
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;
2276 To : Boolean)
2278 Declaration : constant Project_Node_Id :=
2279 Project_Declaration_Of (Node);
2280 begin
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)
2293 begin
2294 pragma Assert
2295 (Node /= Empty_Node
2296 and then
2297 (Project_Nodes.Table (Node).Kind = N_With_Clause
2298 or else
2299 Project_Nodes.Table (Node).Kind = N_Variable_Reference
2300 or else
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
2306 then
2307 Project_Nodes.Table (Node).Field3 := To;
2308 end if;
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)
2319 begin
2320 pragma Assert
2321 (Node /= Empty_Node
2322 and then
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)
2335 begin
2336 pragma Assert
2337 (Node /= Empty_Node
2338 and then
2339 (Project_Nodes.Table (Node).Kind = N_Variable_Reference
2340 or else
2341 Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration)
2342 and then
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;
2347 else
2348 Project_Nodes.Table (Node).Field2 := To;
2349 end if;
2350 end Set_String_Type_Of;
2352 -------------------------
2353 -- Set_String_Value_Of --
2354 -------------------------
2356 procedure Set_String_Value_Of
2357 (Node : Project_Node_Id;
2358 To : Name_Id)
2360 begin
2361 pragma Assert
2362 (Node /= Empty_Node
2363 and then
2364 (Project_Nodes.Table (Node).Kind = N_With_Clause
2365 or else
2366 Project_Nodes.Table (Node).Kind = N_Comment
2367 or else
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
2379 begin
2380 pragma Assert
2381 (Node /= Empty_Node
2382 and then
2383 (Project_Nodes.Table (Node).Kind = N_Variable_Reference
2384 or else
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;
2389 else
2390 return Project_Nodes.Table (Node).Field2;
2391 end if;
2392 end String_Type_Of;
2394 ---------------------
2395 -- String_Value_Of --
2396 ---------------------
2398 function String_Value_Of (Node : Project_Node_Id) return Name_Id is
2399 begin
2400 pragma Assert
2401 (Node /= Empty_Node
2402 and then
2403 (Project_Nodes.Table (Node).Kind = N_With_Clause
2404 or else
2405 Project_Nodes.Table (Node).Kind = N_Comment
2406 or else
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
2419 begin
2420 pragma Assert
2421 (For_Typed_Variable /= Empty_Node
2422 and then
2423 (Project_Nodes.Table (For_Typed_Variable).Kind =
2424 N_Typed_Variable_Declaration));
2426 declare
2427 Current_String : Project_Node_Id :=
2428 First_Literal_String
2429 (String_Type_Of (For_Typed_Variable));
2431 begin
2432 while Current_String /= Empty_Node
2433 and then
2434 String_Value_Of (Current_String) /= Value
2435 loop
2436 Current_String :=
2437 Next_Literal_String (Current_String);
2438 end loop;
2440 return Current_String /= Empty_Node;
2441 end;
2443 end Value_Is_Valid;
2445 -------------------------------
2446 -- There_Are_Unkept_Comments --
2447 -------------------------------
2449 function There_Are_Unkept_Comments return Boolean is
2450 begin
2451 return Unkept_Comments;
2452 end There_Are_Unkept_Comments;
2455 end Prj.Tree;