1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
10 -- Copyright (C) 2001 Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- GNAT was originally developed by the GNAT team at New York University. --
24 -- Extensive contributions were provided by Ada Core Technologies Inc. --
26 ------------------------------------------------------------------------------
28 -- This package defines the structure of the Project File tree.
32 with Prj
.Attr
; use Prj
.Attr
;
33 with Prj
.Com
; use Prj
.Com
;
34 with Types
; use Types
;
39 Project_Nodes_Initial
: constant := 1_000
;
40 Project_Nodes_Increment
: constant := 100;
41 -- Allocation parameters for initializing and extending number
42 -- of nodes in table Tree_Private_Part.Project_Nodes
44 Project_Node_Low_Bound
: constant := 0;
45 Project_Node_High_Bound
: constant := 099_999_999
;
46 -- Range of values for project node id's (in practice infinite)
48 type Project_Node_Id
is range
49 Project_Node_Low_Bound
.. Project_Node_High_Bound
;
50 -- The index of table Tree_Private_Part.Project_Nodes
52 Empty_Node
: constant Project_Node_Id
:= Project_Node_Low_Bound
;
53 -- Designates no node in table Project_Nodes
55 First_Node_Id
: constant Project_Node_Id
:= Project_Node_Low_Bound
+ 1;
57 subtype Variable_Node_Id
is Project_Node_Id
;
58 -- Used to designate a node whose expected kind is one of
59 -- N_Typed_Variable_Declaration, N_Variable_Declaration or
60 -- N_Variable_Reference.
62 subtype Package_Declaration_Id
is Project_Node_Id
;
63 -- Used to designate a node whose expected kind is N_Proect_Declaration
65 type Project_Node_Kind
is
68 N_Project_Declaration
,
70 N_Package_Declaration
,
71 N_String_Type_Declaration
,
73 N_Attribute_Declaration
,
74 N_Typed_Variable_Declaration
,
75 N_Variable_Declaration
,
78 N_Literal_String_List
,
81 N_Attribute_Reference
,
84 -- Each node in the tree is of a Project_Node_Kind
85 -- For the signification of the fields in each node of a
86 -- Project_Node_Kind, look at package Tree_Private_Part.
89 -- Initialize the Project File tree: empty the Project_Nodes table
90 -- and reset the Projects_Htable.
92 function Default_Project_Node
93 (Of_Kind
: Project_Node_Kind
;
94 And_Expr_Kind
: Variable_Kind
:= Undefined
)
95 return Project_Node_Id
;
96 -- Returns a Project_Node_Record with the specified Kind and
97 -- Expr_Kind; all the other components have default nil values.
99 ----------------------
100 -- Access Functions --
101 ----------------------
103 -- The following query functions are part of the abstract interface
104 -- of the Project File tree
106 function Name_Of
(Node
: Project_Node_Id
) return Name_Id
;
107 -- Valid for all non empty nodes. May return No_Name for nodes that have
110 function Kind_Of
(Node
: Project_Node_Id
) return Project_Node_Kind
;
111 -- Valid for all non empty nodes
113 function Location_Of
(Node
: Project_Node_Id
) return Source_Ptr
;
114 -- Valid for all non empty nodes
116 function Directory_Of
(Node
: Project_Node_Id
) return Name_Id
;
117 -- Only valid for N_Project nodes.
119 function Expression_Kind_Of
(Node
: Project_Node_Id
) return Variable_Kind
;
120 -- Only valid for N_Literal_String, N_Attribute_Declaration,
121 -- N_Variable_Declaration, N_Typed_Variable_Declaration, N_Expression,
122 -- N_Term, N_Variable_Reference or N_Attribute_Reference nodes.
124 function First_Variable_Of
125 (Node
: Project_Node_Id
)
126 return Variable_Node_Id
;
127 -- Only valid for N_Project or N_Package_Declaration nodes
129 function First_Package_Of
130 (Node
: Project_Node_Id
)
131 return Package_Declaration_Id
;
132 -- Only valid for N_Project nodes
134 function Package_Id_Of
(Node
: Project_Node_Id
) return Package_Node_Id
;
135 -- Only valid for N_Package_Declaration nodes
137 function Path_Name_Of
(Node
: Project_Node_Id
) return Name_Id
;
138 -- Only valid for N_Project and N_With_Clause nodes.
140 function String_Value_Of
(Node
: Project_Node_Id
) return String_Id
;
141 -- Only valid for N_With_Clause or N_Literal_String nodes.
143 function First_With_Clause_Of
144 (Node
: Project_Node_Id
)
145 return Project_Node_Id
;
146 -- Only valid for N_Project nodes
148 function Project_Declaration_Of
149 (Node
: Project_Node_Id
)
150 return Project_Node_Id
;
151 -- Only valid for N_Project nodes
153 function First_String_Type_Of
154 (Node
: Project_Node_Id
)
155 return Project_Node_Id
;
156 -- Only valid for N_Project nodes
158 function Modified_Project_Path_Of
159 (Node
: Project_Node_Id
)
161 -- Only valid for N_With_Clause nodes
163 function Project_Node_Of
164 (Node
: Project_Node_Id
)
165 return Project_Node_Id
;
166 -- Only valid for N_Project nodes
168 function Next_With_Clause_Of
169 (Node
: Project_Node_Id
)
170 return Project_Node_Id
;
171 -- Only valid for N_With_Clause nodes
173 function First_Declarative_Item_Of
174 (Node
: Project_Node_Id
)
175 return Project_Node_Id
;
176 -- Only valid for N_With_Clause nodes
178 function Modified_Project_Of
179 (Node
: Project_Node_Id
)
180 return Project_Node_Id
;
181 -- Only valid for N_With_Clause nodes
183 function Current_Item_Node
184 (Node
: Project_Node_Id
)
185 return Project_Node_Id
;
186 -- Only valid for N_Declarative_Item nodes
188 function Next_Declarative_Item
189 (Node
: Project_Node_Id
)
190 return Project_Node_Id
;
191 -- Only valid for N_Declarative_Item node
193 function Project_Of_Renamed_Package_Of
194 (Node
: Project_Node_Id
)
195 return Project_Node_Id
;
196 -- Only valid for N_Package_Declaration nodes.
197 -- May return Empty_Node.
199 function Next_Package_In_Project
200 (Node
: Project_Node_Id
)
201 return Project_Node_Id
;
202 -- Only valid for N_Package_Declaration nodes
204 function First_Literal_String
205 (Node
: Project_Node_Id
)
206 return Project_Node_Id
;
207 -- Only valid for N_String_Type_Declaration nodes
209 function Next_String_Type
210 (Node
: Project_Node_Id
)
211 return Project_Node_Id
;
212 -- Only valid for N_String_Type_Declaration nodes
214 function Next_Literal_String
215 (Node
: Project_Node_Id
)
216 return Project_Node_Id
;
217 -- Only valid for N_Literal_String nodes
219 function Expression_Of
220 (Node
: Project_Node_Id
)
221 return Project_Node_Id
;
222 -- Only valid for N_Attribute_Declaration, N_Typed_Variable_Declaration
223 -- or N_Variable_Declaration nodes
225 function Value_Is_Valid
226 (For_Typed_Variable
: Project_Node_Id
;
229 -- Only valid for N_Typed_Variable_Declaration. Returns True if Value is
230 -- in the list of allowed strings for For_Typed_Variable. False otherwise.
232 function Associative_Array_Index_Of
233 (Node
: Project_Node_Id
)
235 -- Only valid for N_Attribute_Declaration and N_Attribute_Reference.
236 -- Returns No_String for non associative array attributes.
238 function Next_Variable
239 (Node
: Project_Node_Id
)
240 return Project_Node_Id
;
241 -- Only valid for N_Typed_Variable_Declaration or N_Variable_Declaration
245 (Node
: Project_Node_Id
)
246 return Project_Node_Id
;
247 -- Only valid for N_Expression nodes
249 function Next_Expression_In_List
250 (Node
: Project_Node_Id
)
251 return Project_Node_Id
;
252 -- Only valid for N_Expression nodes
254 function Current_Term
255 (Node
: Project_Node_Id
)
256 return Project_Node_Id
;
257 -- Only valid for N_Term nodes
260 (Node
: Project_Node_Id
)
261 return Project_Node_Id
;
262 -- Only valid for N_Term nodes
264 function First_Expression_In_List
265 (Node
: Project_Node_Id
)
266 return Project_Node_Id
;
267 -- Only valid for N_Literal_String_List nodes
269 function Package_Node_Of
270 (Node
: Project_Node_Id
)
271 return Project_Node_Id
;
272 -- Only valid for N_Variable_Reference or N_Attribute_Reference nodes.
273 -- May return Empty_Node.
275 function String_Type_Of
276 (Node
: Project_Node_Id
)
277 return Project_Node_Id
;
278 -- Only valid for N_Variable_Reference or N_Typed_Variable_Declaration
281 function External_Reference_Of
282 (Node
: Project_Node_Id
)
283 return Project_Node_Id
;
284 -- Only valid for N_External_Value nodes
286 function External_Default_Of
287 (Node
: Project_Node_Id
)
288 return Project_Node_Id
;
289 -- Only valid for N_External_Value nodes
291 function Case_Variable_Reference_Of
292 (Node
: Project_Node_Id
)
293 return Project_Node_Id
;
294 -- Only valid for N_Case_Construction nodes
296 function First_Case_Item_Of
297 (Node
: Project_Node_Id
)
298 return Project_Node_Id
;
299 -- Only valid for N_Case_Construction nodes
301 function First_Choice_Of
302 (Node
: Project_Node_Id
)
303 return Project_Node_Id
;
304 -- Return the first choice in a N_Case_Item, or Empty_Node if
305 -- this is when others.
307 function Next_Case_Item
308 (Node
: Project_Node_Id
)
309 return Project_Node_Id
;
310 -- Only valid for N_Case_Item nodes
312 function Case_Insensitive
(Node
: Project_Node_Id
) return Boolean;
313 -- Only valid for N_Attribute_Declaration and N_Attribute_Reference nodes
319 -- The following procedures are part of the abstract interface of
320 -- the Project File tree.
322 -- Each Set_* procedure is valid only for the same Project_Node_Kind
323 -- nodes as the corresponding query function above.
325 procedure Set_Name_Of
326 (Node
: Project_Node_Id
;
329 procedure Set_Kind_Of
330 (Node
: Project_Node_Id
;
331 To
: Project_Node_Kind
);
333 procedure Set_Location_Of
334 (Node
: Project_Node_Id
;
337 procedure Set_Directory_Of
338 (Node
: Project_Node_Id
;
341 procedure Set_Expression_Kind_Of
342 (Node
: Project_Node_Id
;
345 procedure Set_First_Variable_Of
346 (Node
: Project_Node_Id
;
347 To
: Variable_Node_Id
);
349 procedure Set_First_Package_Of
350 (Node
: Project_Node_Id
;
351 To
: Package_Declaration_Id
);
353 procedure Set_Package_Id_Of
354 (Node
: Project_Node_Id
;
355 To
: Package_Node_Id
);
357 procedure Set_Path_Name_Of
358 (Node
: Project_Node_Id
;
361 procedure Set_String_Value_Of
362 (Node
: Project_Node_Id
;
365 procedure Set_First_With_Clause_Of
366 (Node
: Project_Node_Id
;
367 To
: Project_Node_Id
);
369 procedure Set_Project_Declaration_Of
370 (Node
: Project_Node_Id
;
371 To
: Project_Node_Id
);
373 procedure Set_First_String_Type_Of
374 (Node
: Project_Node_Id
;
375 To
: Project_Node_Id
);
377 procedure Set_Modified_Project_Path_Of
378 (Node
: Project_Node_Id
;
381 procedure Set_Project_Node_Of
382 (Node
: Project_Node_Id
;
383 To
: Project_Node_Id
);
385 procedure Set_Next_With_Clause_Of
386 (Node
: Project_Node_Id
;
387 To
: Project_Node_Id
);
389 procedure Set_First_Declarative_Item_Of
390 (Node
: Project_Node_Id
;
391 To
: Project_Node_Id
);
393 procedure Set_Modified_Project_Of
394 (Node
: Project_Node_Id
;
395 To
: Project_Node_Id
);
397 procedure Set_Current_Item_Node
398 (Node
: Project_Node_Id
;
399 To
: Project_Node_Id
);
401 procedure Set_Next_Declarative_Item
402 (Node
: Project_Node_Id
;
403 To
: Project_Node_Id
);
405 procedure Set_Project_Of_Renamed_Package_Of
406 (Node
: Project_Node_Id
;
407 To
: Project_Node_Id
);
409 procedure Set_Next_Package_In_Project
410 (Node
: Project_Node_Id
;
411 To
: Project_Node_Id
);
413 procedure Set_First_Literal_String
414 (Node
: Project_Node_Id
;
415 To
: Project_Node_Id
);
417 procedure Set_Next_String_Type
418 (Node
: Project_Node_Id
;
419 To
: Project_Node_Id
);
421 procedure Set_Next_Literal_String
422 (Node
: Project_Node_Id
;
423 To
: Project_Node_Id
);
425 procedure Set_Expression_Of
426 (Node
: Project_Node_Id
;
427 To
: Project_Node_Id
);
429 procedure Set_Associative_Array_Index_Of
430 (Node
: Project_Node_Id
;
433 procedure Set_Next_Variable
434 (Node
: Project_Node_Id
;
435 To
: Project_Node_Id
);
437 procedure Set_First_Term
438 (Node
: Project_Node_Id
;
439 To
: Project_Node_Id
);
441 procedure Set_Next_Expression_In_List
442 (Node
: Project_Node_Id
;
443 To
: Project_Node_Id
);
445 procedure Set_Current_Term
446 (Node
: Project_Node_Id
;
447 To
: Project_Node_Id
);
449 procedure Set_Next_Term
450 (Node
: Project_Node_Id
;
451 To
: Project_Node_Id
);
453 procedure Set_First_Expression_In_List
454 (Node
: Project_Node_Id
;
455 To
: Project_Node_Id
);
457 procedure Set_Package_Node_Of
458 (Node
: Project_Node_Id
;
459 To
: Project_Node_Id
);
461 procedure Set_String_Type_Of
462 (Node
: Project_Node_Id
;
463 To
: Project_Node_Id
);
465 procedure Set_External_Reference_Of
466 (Node
: Project_Node_Id
;
467 To
: Project_Node_Id
);
469 procedure Set_External_Default_Of
470 (Node
: Project_Node_Id
;
471 To
: Project_Node_Id
);
473 procedure Set_Case_Variable_Reference_Of
474 (Node
: Project_Node_Id
;
475 To
: Project_Node_Id
);
477 procedure Set_First_Case_Item_Of
478 (Node
: Project_Node_Id
;
479 To
: Project_Node_Id
);
481 procedure Set_First_Choice_Of
482 (Node
: Project_Node_Id
;
483 To
: Project_Node_Id
);
485 procedure Set_Next_Case_Item
486 (Node
: Project_Node_Id
;
487 To
: Project_Node_Id
);
489 procedure Set_Case_Insensitive
490 (Node
: Project_Node_Id
;
493 -------------------------------
494 -- Restricted Access Section --
495 -------------------------------
497 package Tree_Private_Part
is
499 -- This is conceptually in the private part.
500 -- However, for efficiency, some packages are accessing it directly.
502 type Project_Node_Record
is record
504 Kind
: Project_Node_Kind
;
506 Location
: Source_Ptr
:= No_Location
;
508 Directory
: Name_Id
:= No_Name
;
509 -- Only for N_Project
511 Expr_Kind
: Variable_Kind
:= Undefined
;
512 -- See below for what Project_Node_Kind it is used
514 Variables
: Variable_Node_Id
:= Empty_Node
;
515 -- First variable in a project or a package
517 Packages
: Package_Declaration_Id
:= Empty_Node
;
518 -- First package declaration in a project
520 Pkg_Id
: Package_Node_Id
:= Empty_Package
;
521 -- Only used for N_Package_Declaration
522 -- The component Pkg_Id is an entry into the table Package_Attributes
523 -- (in Prj.Attr). It is used to indicate all the attributes of the
524 -- package with their characteristics.
526 -- The tables Prj.Attr.Attributes and Prj.Attr.Package_Attributes
527 -- are built once and for all through a call (from Prj.Initialize)
528 -- to procedure Prj.Attr.Initialize. It is never modified after that.
530 Name
: Name_Id
:= No_Name
;
531 -- See below for what Project_Node_Kind it is used
533 Path_Name
: Name_Id
:= No_Name
;
534 -- See below for what Project_Node_Kind it is used
536 Value
: String_Id
:= No_String
;
537 -- See below for what Project_Node_Kind it is used
539 Field1
: Project_Node_Id
:= Empty_Node
;
540 -- See below the meaning for each Project_Node_Kind
542 Field2
: Project_Node_Id
:= Empty_Node
;
543 -- See below the meaning for each Project_Node_Kind
545 Field3
: Project_Node_Id
:= Empty_Node
;
546 -- See below the meaning for each Project_Node_Kind
548 Case_Insensitive
: Boolean := False;
549 -- This flag is significant only for N_Attribute_Declaration and
550 -- N_Atribute_Reference. It indicates for an associative array
551 -- attribute, that the index is case insensitive.
555 -- type Project_Node_Kind is
558 -- -- Name: project name
559 -- -- Path_Name: project path name
560 -- -- Expr_Kind: Undefined
561 -- -- Field1: first with clause
562 -- -- Field2: project declaration
563 -- -- Field3: first string type
564 -- -- Value: modified project path name (if any)
567 -- -- Name: imported project name
568 -- -- Path_Name: imported project path name
569 -- -- Expr_Kind: Undefined
570 -- -- Field1: project node
571 -- -- Field2: next with clause
572 -- -- Field3: not used
573 -- -- Value: literal string withed
575 -- N_Project_Declaration,
577 -- -- Path_Name: not used
578 -- -- Expr_Kind: Undefined
579 -- -- Field1: first declarative item
580 -- -- Field2: modified project
581 -- -- Field3: not used
582 -- -- Value: not used
584 -- N_Declarative_Item,
586 -- -- Path_Name: not used
587 -- -- Expr_Kind: Undefined
588 -- -- Field1: current item node
589 -- -- Field2: next declarative item
590 -- -- Field3: not used
591 -- -- Value: not used
593 -- N_Package_Declaration,
594 -- -- Name: package name
595 -- -- Path_Name: not used
596 -- -- Expr_Kind: Undefined
597 -- -- Field1: project of renamed package (if any)
598 -- -- Field2: first declarative item
599 -- -- Field3: next package in project
600 -- -- Value: not used
602 -- N_String_Type_Declaration,
603 -- -- Name: type name
604 -- -- Path_Name: not used
605 -- -- Expr_Kind: Undefined
606 -- -- Field1: first literal string
607 -- -- Field2: next string type
608 -- -- Field3: not used
609 -- -- Value: not used
613 -- -- Path_Name: not used
614 -- -- Expr_Kind: Single
615 -- -- Field1: next literal string
616 -- -- Field2: not used
617 -- -- Field3: not used
618 -- -- Value: string value
620 -- N_Attribute_Declaration,
621 -- -- Name: attribute name
622 -- -- Path_Name: not used
623 -- -- Expr_Kind: attribute kind
624 -- -- Field1: expression
625 -- -- Field2: not used
626 -- -- Field3: not used
627 -- -- Value: associative array index
628 -- -- (if an associative array element)
630 -- N_Typed_Variable_Declaration,
631 -- -- Name: variable name
632 -- -- Path_Name: not used
633 -- -- Expr_Kind: Single
634 -- -- Field1: expression
635 -- -- Field2: type of variable (N_String_Type_Declaration)
636 -- -- Field3: next variable
637 -- -- Value: not used
639 -- N_Variable_Declaration,
640 -- -- Name: variable name
641 -- -- Path_Name: not used
642 -- -- Expr_Kind: variable kind
643 -- -- Field1: expression
644 -- -- Field2: not used
645 -- -- Field3 is used for next variable, instead of Field2,
646 -- -- so that it is the same field for
647 -- -- N_Variable_Declaration and
648 -- -- N_Typed_Variable_Declaration
649 -- -- Field3: next variable
650 -- -- Value: not used
654 -- -- Path_Name: not used
655 -- -- Expr_Kind: expression kind
656 -- -- Field1: first term
657 -- -- Field2: next expression in list
658 -- -- Field3: not used
659 -- -- Value: not used
663 -- -- Path_Name: not used
664 -- -- Expr_Kind: term kind
665 -- -- Field1: current term
666 -- -- Field2: next term in the expression
667 -- -- Field3: not used
668 -- -- Value: not used
670 -- N_Literal_String_List,
671 -- -- Designates a list of string expressions between brackets
672 -- -- separated by commas. The string expressions are not necessarily
673 -- -- literal strings.
675 -- -- Path_Name: not used
676 -- -- Expr_Kind: List
677 -- -- Field1: first expression
678 -- -- Field2: not used
679 -- -- Field3: not used
680 -- -- Value: not used
682 -- N_Variable_Reference,
683 -- -- Name: variable name
684 -- -- Path_Name: not used
685 -- -- Expr_Kind: variable kind
686 -- -- Field1: project (if specified)
687 -- -- Field2: package (if specified)
688 -- -- Field3: type of variable (N_String_Type_Declaration), if any
689 -- -- Value: not used
693 -- -- Path_Name: not used
694 -- -- Expr_Kind: Single
695 -- -- Field1: Name of the external reference (literal string)
696 -- -- Field2: Default (literal string)
697 -- -- Field3: not used
698 -- -- Value: not used
700 -- N_Attribute_Reference,
701 -- -- Name: attribute name
702 -- -- Path_Name: not used
703 -- -- Expr_Kind: attribute kind
704 -- -- Field1: project
705 -- -- Field2: package (if attribute of a package)
706 -- -- Field3: not used
707 -- -- Value: associative array index
708 -- -- (if an associative array element)
710 -- N_Case_Construction,
712 -- -- Path_Name: not used
713 -- -- Expr_Kind: Undefined
714 -- -- Field1: case variable reference
715 -- -- Field2: first case item
716 -- -- Field3: not used
717 -- -- Value: not used
721 -- -- Path_Name: not used
722 -- -- Expr_Kind: not used
723 -- -- Field1: first choice (literal string), or Empty_Node
724 -- -- for when others
725 -- -- Field2: first declarative item
726 -- -- Field3: next case item
727 -- -- Value: not used
729 package Project_Nodes
is
730 new Table
.Table
(Table_Component_Type
=> Project_Node_Record
,
731 Table_Index_Type
=> Project_Node_Id
,
732 Table_Low_Bound
=> First_Node_Id
,
733 Table_Initial
=> Project_Nodes_Initial
,
734 Table_Increment
=> Project_Nodes_Increment
,
735 Table_Name
=> "Project_Nodes");
736 -- This table contains the syntactic tree of project data
737 -- from project files.
739 type Project_Name_And_Node
is record
741 -- Name of the project
743 Node
: Project_Node_Id
;
744 -- Node of the project in table Project_Nodes
747 -- True when the project is being modified by another project
750 No_Project_Name_And_Node
: constant Project_Name_And_Node
:=
751 (Name
=> No_Name
, Node
=> Empty_Node
, Modified
=> True);
753 package Projects_Htable
is new GNAT
.HTable
.Simple_HTable
754 (Header_Num
=> Header_Num
,
755 Element
=> Project_Name_And_Node
,
756 No_Element
=> No_Project_Name_And_Node
,
760 -- This hash table contains a mapping of project names to project nodes.
761 -- Note that this hash table contains only the nodes whose Kind is
762 -- N_Project. It is used to find the node of a project from its
763 -- name, and to verify if a project has already been parsed, knowing
766 end Tree_Private_Part
;