1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2001 Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
27 -- This package defines the structure of the Project File tree.
31 with Prj
.Attr
; use Prj
.Attr
;
32 with Prj
.Com
; use Prj
.Com
;
33 with Types
; use Types
;
38 Project_Nodes_Initial
: constant := 1_000
;
39 Project_Nodes_Increment
: constant := 100;
40 -- Allocation parameters for initializing and extending number
41 -- of nodes in table Tree_Private_Part.Project_Nodes
43 Project_Node_Low_Bound
: constant := 0;
44 Project_Node_High_Bound
: constant := 099_999_999
;
45 -- Range of values for project node id's (in practice infinite)
47 type Project_Node_Id
is range
48 Project_Node_Low_Bound
.. Project_Node_High_Bound
;
49 -- The index of table Tree_Private_Part.Project_Nodes
51 Empty_Node
: constant Project_Node_Id
:= Project_Node_Low_Bound
;
52 -- Designates no node in table Project_Nodes
54 First_Node_Id
: constant Project_Node_Id
:= Project_Node_Low_Bound
+ 1;
56 subtype Variable_Node_Id
is Project_Node_Id
;
57 -- Used to designate a node whose expected kind is one of
58 -- N_Typed_Variable_Declaration, N_Variable_Declaration or
59 -- N_Variable_Reference.
61 subtype Package_Declaration_Id
is Project_Node_Id
;
62 -- Used to designate a node whose expected kind is N_Proect_Declaration
64 type Project_Node_Kind
is
67 N_Project_Declaration
,
69 N_Package_Declaration
,
70 N_String_Type_Declaration
,
72 N_Attribute_Declaration
,
73 N_Typed_Variable_Declaration
,
74 N_Variable_Declaration
,
77 N_Literal_String_List
,
80 N_Attribute_Reference
,
83 -- Each node in the tree is of a Project_Node_Kind
84 -- For the signification of the fields in each node of a
85 -- Project_Node_Kind, look at package Tree_Private_Part.
88 -- Initialize the Project File tree: empty the Project_Nodes table
89 -- and reset the Projects_Htable.
91 function Default_Project_Node
92 (Of_Kind
: Project_Node_Kind
;
93 And_Expr_Kind
: Variable_Kind
:= Undefined
)
94 return Project_Node_Id
;
95 -- Returns a Project_Node_Record with the specified Kind and
96 -- Expr_Kind; all the other components have default nil values.
98 ----------------------
99 -- Access Functions --
100 ----------------------
102 -- The following query functions are part of the abstract interface
103 -- of the Project File tree
105 function Name_Of
(Node
: Project_Node_Id
) return Name_Id
;
106 -- Valid for all non empty nodes. May return No_Name for nodes that have
109 function Kind_Of
(Node
: Project_Node_Id
) return Project_Node_Kind
;
110 -- Valid for all non empty nodes
112 function Location_Of
(Node
: Project_Node_Id
) return Source_Ptr
;
113 -- Valid for all non empty nodes
115 function Directory_Of
(Node
: Project_Node_Id
) return Name_Id
;
116 -- Only valid for N_Project nodes.
118 function Expression_Kind_Of
(Node
: Project_Node_Id
) return Variable_Kind
;
119 -- Only valid for N_Literal_String, N_Attribute_Declaration,
120 -- N_Variable_Declaration, N_Typed_Variable_Declaration, N_Expression,
121 -- N_Term, N_Variable_Reference or N_Attribute_Reference nodes.
123 function First_Variable_Of
124 (Node
: Project_Node_Id
)
125 return Variable_Node_Id
;
126 -- Only valid for N_Project or N_Package_Declaration nodes
128 function First_Package_Of
129 (Node
: Project_Node_Id
)
130 return Package_Declaration_Id
;
131 -- Only valid for N_Project nodes
133 function Package_Id_Of
(Node
: Project_Node_Id
) return Package_Node_Id
;
134 -- Only valid for N_Package_Declaration nodes
136 function Path_Name_Of
(Node
: Project_Node_Id
) return Name_Id
;
137 -- Only valid for N_Project and N_With_Clause nodes.
139 function String_Value_Of
(Node
: Project_Node_Id
) return String_Id
;
140 -- Only valid for N_With_Clause or N_Literal_String nodes.
142 function First_With_Clause_Of
143 (Node
: Project_Node_Id
)
144 return Project_Node_Id
;
145 -- Only valid for N_Project nodes
147 function Project_Declaration_Of
148 (Node
: Project_Node_Id
)
149 return Project_Node_Id
;
150 -- Only valid for N_Project nodes
152 function First_String_Type_Of
153 (Node
: Project_Node_Id
)
154 return Project_Node_Id
;
155 -- Only valid for N_Project nodes
157 function Modified_Project_Path_Of
158 (Node
: Project_Node_Id
)
160 -- Only valid for N_With_Clause nodes
162 function Project_Node_Of
163 (Node
: Project_Node_Id
)
164 return Project_Node_Id
;
165 -- Only valid for N_Project nodes
167 function Next_With_Clause_Of
168 (Node
: Project_Node_Id
)
169 return Project_Node_Id
;
170 -- Only valid for N_With_Clause nodes
172 function First_Declarative_Item_Of
173 (Node
: Project_Node_Id
)
174 return Project_Node_Id
;
175 -- Only valid for N_With_Clause nodes
177 function Modified_Project_Of
178 (Node
: Project_Node_Id
)
179 return Project_Node_Id
;
180 -- Only valid for N_With_Clause nodes
182 function Current_Item_Node
183 (Node
: Project_Node_Id
)
184 return Project_Node_Id
;
185 -- Only valid for N_Declarative_Item nodes
187 function Next_Declarative_Item
188 (Node
: Project_Node_Id
)
189 return Project_Node_Id
;
190 -- Only valid for N_Declarative_Item node
192 function Project_Of_Renamed_Package_Of
193 (Node
: Project_Node_Id
)
194 return Project_Node_Id
;
195 -- Only valid for N_Package_Declaration nodes.
196 -- May return Empty_Node.
198 function Next_Package_In_Project
199 (Node
: Project_Node_Id
)
200 return Project_Node_Id
;
201 -- Only valid for N_Package_Declaration nodes
203 function First_Literal_String
204 (Node
: Project_Node_Id
)
205 return Project_Node_Id
;
206 -- Only valid for N_String_Type_Declaration nodes
208 function Next_String_Type
209 (Node
: Project_Node_Id
)
210 return Project_Node_Id
;
211 -- Only valid for N_String_Type_Declaration nodes
213 function Next_Literal_String
214 (Node
: Project_Node_Id
)
215 return Project_Node_Id
;
216 -- Only valid for N_Literal_String nodes
218 function Expression_Of
219 (Node
: Project_Node_Id
)
220 return Project_Node_Id
;
221 -- Only valid for N_Attribute_Declaration, N_Typed_Variable_Declaration
222 -- or N_Variable_Declaration nodes
224 function Value_Is_Valid
225 (For_Typed_Variable
: Project_Node_Id
;
228 -- Only valid for N_Typed_Variable_Declaration. Returns True if Value is
229 -- in the list of allowed strings for For_Typed_Variable. False otherwise.
231 function Associative_Array_Index_Of
232 (Node
: Project_Node_Id
)
234 -- Only valid for N_Attribute_Declaration and N_Attribute_Reference.
235 -- Returns No_String for non associative array attributes.
237 function Next_Variable
238 (Node
: Project_Node_Id
)
239 return Project_Node_Id
;
240 -- Only valid for N_Typed_Variable_Declaration or N_Variable_Declaration
244 (Node
: Project_Node_Id
)
245 return Project_Node_Id
;
246 -- Only valid for N_Expression nodes
248 function Next_Expression_In_List
249 (Node
: Project_Node_Id
)
250 return Project_Node_Id
;
251 -- Only valid for N_Expression nodes
253 function Current_Term
254 (Node
: Project_Node_Id
)
255 return Project_Node_Id
;
256 -- Only valid for N_Term nodes
259 (Node
: Project_Node_Id
)
260 return Project_Node_Id
;
261 -- Only valid for N_Term nodes
263 function First_Expression_In_List
264 (Node
: Project_Node_Id
)
265 return Project_Node_Id
;
266 -- Only valid for N_Literal_String_List nodes
268 function Package_Node_Of
269 (Node
: Project_Node_Id
)
270 return Project_Node_Id
;
271 -- Only valid for N_Variable_Reference or N_Attribute_Reference nodes.
272 -- May return Empty_Node.
274 function String_Type_Of
275 (Node
: Project_Node_Id
)
276 return Project_Node_Id
;
277 -- Only valid for N_Variable_Reference or N_Typed_Variable_Declaration
280 function External_Reference_Of
281 (Node
: Project_Node_Id
)
282 return Project_Node_Id
;
283 -- Only valid for N_External_Value nodes
285 function External_Default_Of
286 (Node
: Project_Node_Id
)
287 return Project_Node_Id
;
288 -- Only valid for N_External_Value nodes
290 function Case_Variable_Reference_Of
291 (Node
: Project_Node_Id
)
292 return Project_Node_Id
;
293 -- Only valid for N_Case_Construction nodes
295 function First_Case_Item_Of
296 (Node
: Project_Node_Id
)
297 return Project_Node_Id
;
298 -- Only valid for N_Case_Construction nodes
300 function First_Choice_Of
301 (Node
: Project_Node_Id
)
302 return Project_Node_Id
;
303 -- Return the first choice in a N_Case_Item, or Empty_Node if
304 -- this is when others.
306 function Next_Case_Item
307 (Node
: Project_Node_Id
)
308 return Project_Node_Id
;
309 -- Only valid for N_Case_Item nodes
311 function Case_Insensitive
(Node
: Project_Node_Id
) return Boolean;
312 -- Only valid for N_Attribute_Declaration and N_Attribute_Reference nodes
318 -- The following procedures are part of the abstract interface of
319 -- the Project File tree.
321 -- Each Set_* procedure is valid only for the same Project_Node_Kind
322 -- nodes as the corresponding query function above.
324 procedure Set_Name_Of
325 (Node
: Project_Node_Id
;
328 procedure Set_Kind_Of
329 (Node
: Project_Node_Id
;
330 To
: Project_Node_Kind
);
332 procedure Set_Location_Of
333 (Node
: Project_Node_Id
;
336 procedure Set_Directory_Of
337 (Node
: Project_Node_Id
;
340 procedure Set_Expression_Kind_Of
341 (Node
: Project_Node_Id
;
344 procedure Set_First_Variable_Of
345 (Node
: Project_Node_Id
;
346 To
: Variable_Node_Id
);
348 procedure Set_First_Package_Of
349 (Node
: Project_Node_Id
;
350 To
: Package_Declaration_Id
);
352 procedure Set_Package_Id_Of
353 (Node
: Project_Node_Id
;
354 To
: Package_Node_Id
);
356 procedure Set_Path_Name_Of
357 (Node
: Project_Node_Id
;
360 procedure Set_String_Value_Of
361 (Node
: Project_Node_Id
;
364 procedure Set_First_With_Clause_Of
365 (Node
: Project_Node_Id
;
366 To
: Project_Node_Id
);
368 procedure Set_Project_Declaration_Of
369 (Node
: Project_Node_Id
;
370 To
: Project_Node_Id
);
372 procedure Set_First_String_Type_Of
373 (Node
: Project_Node_Id
;
374 To
: Project_Node_Id
);
376 procedure Set_Modified_Project_Path_Of
377 (Node
: Project_Node_Id
;
380 procedure Set_Project_Node_Of
381 (Node
: Project_Node_Id
;
382 To
: Project_Node_Id
);
384 procedure Set_Next_With_Clause_Of
385 (Node
: Project_Node_Id
;
386 To
: Project_Node_Id
);
388 procedure Set_First_Declarative_Item_Of
389 (Node
: Project_Node_Id
;
390 To
: Project_Node_Id
);
392 procedure Set_Modified_Project_Of
393 (Node
: Project_Node_Id
;
394 To
: Project_Node_Id
);
396 procedure Set_Current_Item_Node
397 (Node
: Project_Node_Id
;
398 To
: Project_Node_Id
);
400 procedure Set_Next_Declarative_Item
401 (Node
: Project_Node_Id
;
402 To
: Project_Node_Id
);
404 procedure Set_Project_Of_Renamed_Package_Of
405 (Node
: Project_Node_Id
;
406 To
: Project_Node_Id
);
408 procedure Set_Next_Package_In_Project
409 (Node
: Project_Node_Id
;
410 To
: Project_Node_Id
);
412 procedure Set_First_Literal_String
413 (Node
: Project_Node_Id
;
414 To
: Project_Node_Id
);
416 procedure Set_Next_String_Type
417 (Node
: Project_Node_Id
;
418 To
: Project_Node_Id
);
420 procedure Set_Next_Literal_String
421 (Node
: Project_Node_Id
;
422 To
: Project_Node_Id
);
424 procedure Set_Expression_Of
425 (Node
: Project_Node_Id
;
426 To
: Project_Node_Id
);
428 procedure Set_Associative_Array_Index_Of
429 (Node
: Project_Node_Id
;
432 procedure Set_Next_Variable
433 (Node
: Project_Node_Id
;
434 To
: Project_Node_Id
);
436 procedure Set_First_Term
437 (Node
: Project_Node_Id
;
438 To
: Project_Node_Id
);
440 procedure Set_Next_Expression_In_List
441 (Node
: Project_Node_Id
;
442 To
: Project_Node_Id
);
444 procedure Set_Current_Term
445 (Node
: Project_Node_Id
;
446 To
: Project_Node_Id
);
448 procedure Set_Next_Term
449 (Node
: Project_Node_Id
;
450 To
: Project_Node_Id
);
452 procedure Set_First_Expression_In_List
453 (Node
: Project_Node_Id
;
454 To
: Project_Node_Id
);
456 procedure Set_Package_Node_Of
457 (Node
: Project_Node_Id
;
458 To
: Project_Node_Id
);
460 procedure Set_String_Type_Of
461 (Node
: Project_Node_Id
;
462 To
: Project_Node_Id
);
464 procedure Set_External_Reference_Of
465 (Node
: Project_Node_Id
;
466 To
: Project_Node_Id
);
468 procedure Set_External_Default_Of
469 (Node
: Project_Node_Id
;
470 To
: Project_Node_Id
);
472 procedure Set_Case_Variable_Reference_Of
473 (Node
: Project_Node_Id
;
474 To
: Project_Node_Id
);
476 procedure Set_First_Case_Item_Of
477 (Node
: Project_Node_Id
;
478 To
: Project_Node_Id
);
480 procedure Set_First_Choice_Of
481 (Node
: Project_Node_Id
;
482 To
: Project_Node_Id
);
484 procedure Set_Next_Case_Item
485 (Node
: Project_Node_Id
;
486 To
: Project_Node_Id
);
488 procedure Set_Case_Insensitive
489 (Node
: Project_Node_Id
;
492 -------------------------------
493 -- Restricted Access Section --
494 -------------------------------
496 package Tree_Private_Part
is
498 -- This is conceptually in the private part.
499 -- However, for efficiency, some packages are accessing it directly.
501 type Project_Node_Record
is record
503 Kind
: Project_Node_Kind
;
505 Location
: Source_Ptr
:= No_Location
;
507 Directory
: Name_Id
:= No_Name
;
508 -- Only for N_Project
510 Expr_Kind
: Variable_Kind
:= Undefined
;
511 -- See below for what Project_Node_Kind it is used
513 Variables
: Variable_Node_Id
:= Empty_Node
;
514 -- First variable in a project or a package
516 Packages
: Package_Declaration_Id
:= Empty_Node
;
517 -- First package declaration in a project
519 Pkg_Id
: Package_Node_Id
:= Empty_Package
;
520 -- Only used for N_Package_Declaration
521 -- The component Pkg_Id is an entry into the table Package_Attributes
522 -- (in Prj.Attr). It is used to indicate all the attributes of the
523 -- package with their characteristics.
525 -- The tables Prj.Attr.Attributes and Prj.Attr.Package_Attributes
526 -- are built once and for all through a call (from Prj.Initialize)
527 -- to procedure Prj.Attr.Initialize. It is never modified after that.
529 Name
: Name_Id
:= No_Name
;
530 -- See below for what Project_Node_Kind it is used
532 Path_Name
: Name_Id
:= No_Name
;
533 -- See below for what Project_Node_Kind it is used
535 Value
: String_Id
:= No_String
;
536 -- See below for what Project_Node_Kind it is used
538 Field1
: Project_Node_Id
:= Empty_Node
;
539 -- See below the meaning for each Project_Node_Kind
541 Field2
: Project_Node_Id
:= Empty_Node
;
542 -- See below the meaning for each Project_Node_Kind
544 Field3
: Project_Node_Id
:= Empty_Node
;
545 -- See below the meaning for each Project_Node_Kind
547 Case_Insensitive
: Boolean := False;
548 -- This flag is significant only for N_Attribute_Declaration and
549 -- N_Atribute_Reference. It indicates for an associative array
550 -- attribute, that the index is case insensitive.
554 -- type Project_Node_Kind is
557 -- -- Name: project name
558 -- -- Path_Name: project path name
559 -- -- Expr_Kind: Undefined
560 -- -- Field1: first with clause
561 -- -- Field2: project declaration
562 -- -- Field3: first string type
563 -- -- Value: modified project path name (if any)
566 -- -- Name: imported project name
567 -- -- Path_Name: imported project path name
568 -- -- Expr_Kind: Undefined
569 -- -- Field1: project node
570 -- -- Field2: next with clause
571 -- -- Field3: not used
572 -- -- Value: literal string withed
574 -- N_Project_Declaration,
576 -- -- Path_Name: not used
577 -- -- Expr_Kind: Undefined
578 -- -- Field1: first declarative item
579 -- -- Field2: modified project
580 -- -- Field3: not used
581 -- -- Value: not used
583 -- N_Declarative_Item,
585 -- -- Path_Name: not used
586 -- -- Expr_Kind: Undefined
587 -- -- Field1: current item node
588 -- -- Field2: next declarative item
589 -- -- Field3: not used
590 -- -- Value: not used
592 -- N_Package_Declaration,
593 -- -- Name: package name
594 -- -- Path_Name: not used
595 -- -- Expr_Kind: Undefined
596 -- -- Field1: project of renamed package (if any)
597 -- -- Field2: first declarative item
598 -- -- Field3: next package in project
599 -- -- Value: not used
601 -- N_String_Type_Declaration,
602 -- -- Name: type name
603 -- -- Path_Name: not used
604 -- -- Expr_Kind: Undefined
605 -- -- Field1: first literal string
606 -- -- Field2: next string type
607 -- -- Field3: not used
608 -- -- Value: not used
612 -- -- Path_Name: not used
613 -- -- Expr_Kind: Single
614 -- -- Field1: next literal string
615 -- -- Field2: not used
616 -- -- Field3: not used
617 -- -- Value: string value
619 -- N_Attribute_Declaration,
620 -- -- Name: attribute name
621 -- -- Path_Name: not used
622 -- -- Expr_Kind: attribute kind
623 -- -- Field1: expression
624 -- -- Field2: not used
625 -- -- Field3: not used
626 -- -- Value: associative array index
627 -- -- (if an associative array element)
629 -- N_Typed_Variable_Declaration,
630 -- -- Name: variable name
631 -- -- Path_Name: not used
632 -- -- Expr_Kind: Single
633 -- -- Field1: expression
634 -- -- Field2: type of variable (N_String_Type_Declaration)
635 -- -- Field3: next variable
636 -- -- Value: not used
638 -- N_Variable_Declaration,
639 -- -- Name: variable name
640 -- -- Path_Name: not used
641 -- -- Expr_Kind: variable kind
642 -- -- Field1: expression
643 -- -- Field2: not used
644 -- -- Field3 is used for next variable, instead of Field2,
645 -- -- so that it is the same field for
646 -- -- N_Variable_Declaration and
647 -- -- N_Typed_Variable_Declaration
648 -- -- Field3: next variable
649 -- -- Value: not used
653 -- -- Path_Name: not used
654 -- -- Expr_Kind: expression kind
655 -- -- Field1: first term
656 -- -- Field2: next expression in list
657 -- -- Field3: not used
658 -- -- Value: not used
662 -- -- Path_Name: not used
663 -- -- Expr_Kind: term kind
664 -- -- Field1: current term
665 -- -- Field2: next term in the expression
666 -- -- Field3: not used
667 -- -- Value: not used
669 -- N_Literal_String_List,
670 -- -- Designates a list of string expressions between brackets
671 -- -- separated by commas. The string expressions are not necessarily
672 -- -- literal strings.
674 -- -- Path_Name: not used
675 -- -- Expr_Kind: List
676 -- -- Field1: first expression
677 -- -- Field2: not used
678 -- -- Field3: not used
679 -- -- Value: not used
681 -- N_Variable_Reference,
682 -- -- Name: variable name
683 -- -- Path_Name: not used
684 -- -- Expr_Kind: variable kind
685 -- -- Field1: project (if specified)
686 -- -- Field2: package (if specified)
687 -- -- Field3: type of variable (N_String_Type_Declaration), if any
688 -- -- Value: not used
692 -- -- Path_Name: not used
693 -- -- Expr_Kind: Single
694 -- -- Field1: Name of the external reference (literal string)
695 -- -- Field2: Default (literal string)
696 -- -- Field3: not used
697 -- -- Value: not used
699 -- N_Attribute_Reference,
700 -- -- Name: attribute name
701 -- -- Path_Name: not used
702 -- -- Expr_Kind: attribute kind
703 -- -- Field1: project
704 -- -- Field2: package (if attribute of a package)
705 -- -- Field3: not used
706 -- -- Value: associative array index
707 -- -- (if an associative array element)
709 -- N_Case_Construction,
711 -- -- Path_Name: not used
712 -- -- Expr_Kind: Undefined
713 -- -- Field1: case variable reference
714 -- -- Field2: first case item
715 -- -- Field3: not used
716 -- -- Value: not used
720 -- -- Path_Name: not used
721 -- -- Expr_Kind: not used
722 -- -- Field1: first choice (literal string), or Empty_Node
723 -- -- for when others
724 -- -- Field2: first declarative item
725 -- -- Field3: next case item
726 -- -- Value: not used
728 package Project_Nodes
is
729 new Table
.Table
(Table_Component_Type
=> Project_Node_Record
,
730 Table_Index_Type
=> Project_Node_Id
,
731 Table_Low_Bound
=> First_Node_Id
,
732 Table_Initial
=> Project_Nodes_Initial
,
733 Table_Increment
=> Project_Nodes_Increment
,
734 Table_Name
=> "Project_Nodes");
735 -- This table contains the syntactic tree of project data
736 -- from project files.
738 type Project_Name_And_Node
is record
740 -- Name of the project
742 Node
: Project_Node_Id
;
743 -- Node of the project in table Project_Nodes
746 -- True when the project is being modified by another project
749 No_Project_Name_And_Node
: constant Project_Name_And_Node
:=
750 (Name
=> No_Name
, Node
=> Empty_Node
, Modified
=> True);
752 package Projects_Htable
is new GNAT
.HTable
.Simple_HTable
753 (Header_Num
=> Header_Num
,
754 Element
=> Project_Name_And_Node
,
755 No_Element
=> No_Project_Name_And_Node
,
759 -- This hash table contains a mapping of project names to project nodes.
760 -- Note that this hash table contains only the nodes whose Kind is
761 -- N_Project. It is used to find the node of a project from its
762 -- name, and to verify if a project has already been parsed, knowing
765 end Tree_Private_Part
;