1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
11 -- Copyright (C) 2001 Free Software Foundation, Inc. --
13 -- GNAT is free software; you can redistribute it and/or modify it under --
14 -- terms of the GNU General Public License as published by the Free Soft- --
15 -- ware Foundation; either version 2, or (at your option) any later ver- --
16 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
17 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
18 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
19 -- for more details. You should have received a copy of the GNU General --
20 -- Public License distributed with GNAT; see file COPYING. If not, write --
21 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
22 -- MA 02111-1307, USA. --
24 -- GNAT was originally developed by the GNAT team at New York University. --
25 -- Extensive contributions were provided by Ada Core Technologies Inc. --
27 ------------------------------------------------------------------------------
29 -- This package defines the structure of the Project File tree.
33 with Prj
.Attr
; use Prj
.Attr
;
34 with Prj
.Com
; use Prj
.Com
;
35 with Types
; use Types
;
40 Project_Nodes_Initial
: constant := 1_000
;
41 Project_Nodes_Increment
: constant := 100;
42 -- Allocation parameters for initializing and extending number
43 -- of nodes in table Tree_Private_Part.Project_Nodes
45 Project_Node_Low_Bound
: constant := 0;
46 Project_Node_High_Bound
: constant := 099_999_999
;
47 -- Range of values for project node id's (in practice infinite)
49 type Project_Node_Id
is range
50 Project_Node_Low_Bound
.. Project_Node_High_Bound
;
51 -- The index of table Tree_Private_Part.Project_Nodes
53 Empty_Node
: constant Project_Node_Id
:= Project_Node_Low_Bound
;
54 -- Designates no node in table Project_Nodes
56 First_Node_Id
: constant Project_Node_Id
:= Project_Node_Low_Bound
;
58 subtype Variable_Node_Id
is Project_Node_Id
;
59 -- Used to designate a node whose expected kind is one of
60 -- N_Typed_Variable_Declaration, N_Variable_Declaration or
61 -- N_Variable_Reference.
63 subtype Package_Declaration_Id
is Project_Node_Id
;
64 -- Used to designate a node whose expected kind is N_Proect_Declaration
66 type Project_Node_Kind
is
69 N_Project_Declaration
,
71 N_Package_Declaration
,
72 N_String_Type_Declaration
,
74 N_Attribute_Declaration
,
75 N_Typed_Variable_Declaration
,
76 N_Variable_Declaration
,
79 N_Literal_String_List
,
82 N_Attribute_Reference
,
85 -- Each node in the tree is of a Project_Node_Kind
86 -- For the signification of the fields in each node of a
87 -- Project_Node_Kind, look at package Tree_Private_Part.
90 -- Initialize the Project File tree: empty the Project_Nodes table
91 -- and reset the Projects_Htable.
93 function Default_Project_Node
94 (Of_Kind
: Project_Node_Kind
;
95 And_Expr_Kind
: Variable_Kind
:= Undefined
)
96 return Project_Node_Id
;
97 -- Returns a Project_Node_Record with the specified Kind and
98 -- Expr_Kind; all the other components have default nil values.
100 ----------------------
101 -- Access Functions --
102 ----------------------
104 -- The following query functions are part of the abstract interface
105 -- of the Project File tree
107 function Name_Of
(Node
: Project_Node_Id
) return Name_Id
;
108 -- Valid for all non empty nodes. May return No_Name for nodes that have
111 function Kind_Of
(Node
: Project_Node_Id
) return Project_Node_Kind
;
112 -- Valid for all non empty nodes
114 function Location_Of
(Node
: Project_Node_Id
) return Source_Ptr
;
115 -- Valid for all non empty nodes
117 function Directory_Of
(Node
: Project_Node_Id
) return Name_Id
;
118 -- Only valid for N_Project nodes.
120 function Expression_Kind_Of
(Node
: Project_Node_Id
) return Variable_Kind
;
121 -- Only valid for N_Literal_String, N_Attribute_Declaration,
122 -- N_Variable_Declaration, N_Typed_Variable_Declaration, N_Expression,
123 -- N_Term, N_Variable_Reference or N_Attribute_Reference nodes.
125 function First_Variable_Of
126 (Node
: Project_Node_Id
)
127 return Variable_Node_Id
;
128 -- Only valid for N_Project or N_Package_Declaration nodes
130 function First_Package_Of
131 (Node
: Project_Node_Id
)
132 return Package_Declaration_Id
;
133 -- Only valid for N_Project nodes
135 function Package_Id_Of
(Node
: Project_Node_Id
) return Package_Node_Id
;
136 -- Only valid for N_Package_Declaration nodes
138 function Path_Name_Of
(Node
: Project_Node_Id
) return Name_Id
;
139 -- Only valid for N_Project and N_With_Clause nodes.
141 function String_Value_Of
(Node
: Project_Node_Id
) return String_Id
;
142 -- Only valid for N_With_Clause or N_Literal_String nodes.
144 function First_With_Clause_Of
145 (Node
: Project_Node_Id
)
146 return Project_Node_Id
;
147 -- Only valid for N_Project nodes
149 function Project_Declaration_Of
150 (Node
: Project_Node_Id
)
151 return Project_Node_Id
;
152 -- Only valid for N_Project nodes
154 function First_String_Type_Of
155 (Node
: Project_Node_Id
)
156 return Project_Node_Id
;
157 -- Only valid for N_Project nodes
159 function Modified_Project_Path_Of
160 (Node
: Project_Node_Id
)
162 -- Only valid for N_With_Clause nodes
164 function Project_Node_Of
165 (Node
: Project_Node_Id
)
166 return Project_Node_Id
;
167 -- Only valid for N_Project nodes
169 function Next_With_Clause_Of
170 (Node
: Project_Node_Id
)
171 return Project_Node_Id
;
172 -- Only valid for N_With_Clause nodes
174 function First_Declarative_Item_Of
175 (Node
: Project_Node_Id
)
176 return Project_Node_Id
;
177 -- Only valid for N_With_Clause nodes
179 function Modified_Project_Of
180 (Node
: Project_Node_Id
)
181 return Project_Node_Id
;
182 -- Only valid for N_With_Clause nodes
184 function Current_Item_Node
185 (Node
: Project_Node_Id
)
186 return Project_Node_Id
;
187 -- Only valid for N_Declarative_Item nodes
189 function Next_Declarative_Item
190 (Node
: Project_Node_Id
)
191 return Project_Node_Id
;
192 -- Only valid for N_Declarative_Item node
194 function Project_Of_Renamed_Package_Of
195 (Node
: Project_Node_Id
)
196 return Project_Node_Id
;
197 -- Only valid for N_Package_Declaration nodes.
198 -- May return Empty_Node.
200 function Next_Package_In_Project
201 (Node
: Project_Node_Id
)
202 return Project_Node_Id
;
203 -- Only valid for N_Package_Declaration nodes
205 function First_Literal_String
206 (Node
: Project_Node_Id
)
207 return Project_Node_Id
;
208 -- Only valid for N_String_Type_Declaration nodes
210 function Next_String_Type
211 (Node
: Project_Node_Id
)
212 return Project_Node_Id
;
213 -- Only valid for N_String_Type_Declaration nodes
215 function Next_Literal_String
216 (Node
: Project_Node_Id
)
217 return Project_Node_Id
;
218 -- Only valid for N_Literal_String nodes
220 function Expression_Of
221 (Node
: Project_Node_Id
)
222 return Project_Node_Id
;
223 -- Only valid for N_Attribute_Declaration, N_Typed_Variable_Declaration
224 -- or N_Variable_Declaration nodes
226 function Value_Is_Valid
227 (For_Typed_Variable
: Project_Node_Id
;
230 -- Only valid for N_Typed_Variable_Declaration. Returns True if Value is
231 -- in the list of allowed strings for For_Typed_Variable. False otherwise.
233 function Associative_Array_Index_Of
234 (Node
: Project_Node_Id
)
236 -- Only valid for N_Attribute_Declaration.
237 -- Returns No_String for non associative array attributes.
239 function Next_Variable
240 (Node
: Project_Node_Id
)
241 return Project_Node_Id
;
242 -- Only valid for N_Typed_Variable_Declaration or N_Variable_Declaration
246 (Node
: Project_Node_Id
)
247 return Project_Node_Id
;
248 -- Only valid for N_Expression nodes
250 function Next_Expression_In_List
251 (Node
: Project_Node_Id
)
252 return Project_Node_Id
;
253 -- Only valid for N_Expression nodes
255 function Current_Term
256 (Node
: Project_Node_Id
)
257 return Project_Node_Id
;
258 -- Only valid for N_Term nodes
261 (Node
: Project_Node_Id
)
262 return Project_Node_Id
;
263 -- Only valid for N_Term nodes
265 function First_Expression_In_List
266 (Node
: Project_Node_Id
)
267 return Project_Node_Id
;
268 -- Only valid for N_Literal_String_List nodes
270 function Package_Node_Of
271 (Node
: Project_Node_Id
)
272 return Project_Node_Id
;
273 -- Only valid for N_Variable_Reference or N_Attribute_Reference nodes.
274 -- May return Empty_Node.
276 function String_Type_Of
277 (Node
: Project_Node_Id
)
278 return Project_Node_Id
;
279 -- Only valid for N_Variable_Reference or N_Typed_Variable_Declaration
282 function External_Reference_Of
283 (Node
: Project_Node_Id
)
284 return Project_Node_Id
;
285 -- Only valid for N_External_Value nodes
287 function External_Default_Of
288 (Node
: Project_Node_Id
)
289 return Project_Node_Id
;
290 -- Only valid for N_External_Value nodes
292 function Case_Variable_Reference_Of
293 (Node
: Project_Node_Id
)
294 return Project_Node_Id
;
295 -- Only valid for N_Case_Construction nodes
297 function First_Case_Item_Of
298 (Node
: Project_Node_Id
)
299 return Project_Node_Id
;
300 -- Only valid for N_Case_Construction nodes
302 function First_Choice_Of
303 (Node
: Project_Node_Id
)
304 return Project_Node_Id
;
305 -- Return the first choice in a N_Case_Item, or Empty_Node if
306 -- this is when others.
308 function Next_Case_Item
309 (Node
: Project_Node_Id
)
310 return Project_Node_Id
;
311 -- Only valid for N_Case_Item nodes
313 function Case_Insensitive
(Node
: Project_Node_Id
) return Boolean;
314 -- Only valid for N_Attribute_Declaration nodes
320 -- The following procedures are part of the abstract interface of
321 -- the Project File tree.
323 -- Each Set_* procedure is valid only for the same Project_Node_Kind
324 -- nodes as the corresponding query function above.
326 procedure Set_Name_Of
327 (Node
: Project_Node_Id
;
330 procedure Set_Kind_Of
331 (Node
: Project_Node_Id
;
332 To
: Project_Node_Kind
);
334 procedure Set_Location_Of
335 (Node
: Project_Node_Id
;
338 procedure Set_Directory_Of
339 (Node
: Project_Node_Id
;
342 procedure Set_Expression_Kind_Of
343 (Node
: Project_Node_Id
;
346 procedure Set_First_Variable_Of
347 (Node
: Project_Node_Id
;
348 To
: Variable_Node_Id
);
350 procedure Set_First_Package_Of
351 (Node
: Project_Node_Id
;
352 To
: Package_Declaration_Id
);
354 procedure Set_Package_Id_Of
355 (Node
: Project_Node_Id
;
356 To
: Package_Node_Id
);
358 procedure Set_Path_Name_Of
359 (Node
: Project_Node_Id
;
362 procedure Set_String_Value_Of
363 (Node
: Project_Node_Id
;
366 procedure Set_First_With_Clause_Of
367 (Node
: Project_Node_Id
;
368 To
: Project_Node_Id
);
370 procedure Set_Project_Declaration_Of
371 (Node
: Project_Node_Id
;
372 To
: Project_Node_Id
);
374 procedure Set_First_String_Type_Of
375 (Node
: Project_Node_Id
;
376 To
: Project_Node_Id
);
378 procedure Set_Modified_Project_Path_Of
379 (Node
: Project_Node_Id
;
382 procedure Set_Project_Node_Of
383 (Node
: Project_Node_Id
;
384 To
: Project_Node_Id
);
386 procedure Set_Next_With_Clause_Of
387 (Node
: Project_Node_Id
;
388 To
: Project_Node_Id
);
390 procedure Set_First_Declarative_Item_Of
391 (Node
: Project_Node_Id
;
392 To
: Project_Node_Id
);
394 procedure Set_Modified_Project_Of
395 (Node
: Project_Node_Id
;
396 To
: Project_Node_Id
);
398 procedure Set_Current_Item_Node
399 (Node
: Project_Node_Id
;
400 To
: Project_Node_Id
);
402 procedure Set_Next_Declarative_Item
403 (Node
: Project_Node_Id
;
404 To
: Project_Node_Id
);
406 procedure Set_Project_Of_Renamed_Package_Of
407 (Node
: Project_Node_Id
;
408 To
: Project_Node_Id
);
410 procedure Set_Next_Package_In_Project
411 (Node
: Project_Node_Id
;
412 To
: Project_Node_Id
);
414 procedure Set_First_Literal_String
415 (Node
: Project_Node_Id
;
416 To
: Project_Node_Id
);
418 procedure Set_Next_String_Type
419 (Node
: Project_Node_Id
;
420 To
: Project_Node_Id
);
422 procedure Set_Next_Literal_String
423 (Node
: Project_Node_Id
;
424 To
: Project_Node_Id
);
426 procedure Set_Expression_Of
427 (Node
: Project_Node_Id
;
428 To
: Project_Node_Id
);
430 procedure Set_Associative_Array_Index_Of
431 (Node
: Project_Node_Id
;
434 procedure Set_Next_Variable
435 (Node
: Project_Node_Id
;
436 To
: Project_Node_Id
);
438 procedure Set_First_Term
439 (Node
: Project_Node_Id
;
440 To
: Project_Node_Id
);
442 procedure Set_Next_Expression_In_List
443 (Node
: Project_Node_Id
;
444 To
: Project_Node_Id
);
446 procedure Set_Current_Term
447 (Node
: Project_Node_Id
;
448 To
: Project_Node_Id
);
450 procedure Set_Next_Term
451 (Node
: Project_Node_Id
;
452 To
: Project_Node_Id
);
454 procedure Set_First_Expression_In_List
455 (Node
: Project_Node_Id
;
456 To
: Project_Node_Id
);
458 procedure Set_Package_Node_Of
459 (Node
: Project_Node_Id
;
460 To
: Project_Node_Id
);
462 procedure Set_String_Type_Of
463 (Node
: Project_Node_Id
;
464 To
: Project_Node_Id
);
466 procedure Set_External_Reference_Of
467 (Node
: Project_Node_Id
;
468 To
: Project_Node_Id
);
470 procedure Set_External_Default_Of
471 (Node
: Project_Node_Id
;
472 To
: Project_Node_Id
);
474 procedure Set_Case_Variable_Reference_Of
475 (Node
: Project_Node_Id
;
476 To
: Project_Node_Id
);
478 procedure Set_First_Case_Item_Of
479 (Node
: Project_Node_Id
;
480 To
: Project_Node_Id
);
482 procedure Set_First_Choice_Of
483 (Node
: Project_Node_Id
;
484 To
: Project_Node_Id
);
486 procedure Set_Next_Case_Item
487 (Node
: Project_Node_Id
;
488 To
: Project_Node_Id
);
490 procedure Set_Case_Insensitive
491 (Node
: Project_Node_Id
;
494 -------------------------------
495 -- Restricted Access Section --
496 -------------------------------
498 package Tree_Private_Part
is
500 -- This is conceptually in the private part.
501 -- However, for efficiency, some packages are accessing it directly.
503 type Project_Node_Record
is record
505 Kind
: Project_Node_Kind
;
507 Location
: Source_Ptr
:= No_Location
;
509 Directory
: Name_Id
:= No_Name
;
510 -- Only for N_Project
512 Expr_Kind
: Variable_Kind
:= Undefined
;
513 -- See below for what Project_Node_Kind it is used
515 Variables
: Variable_Node_Id
:= Empty_Node
;
516 -- First variable in a project or a package
518 Packages
: Package_Declaration_Id
:= Empty_Node
;
519 -- First package declaration in a project
521 Pkg_Id
: Package_Node_Id
:= Empty_Package
;
522 -- Only used for N_Package_Declaration
523 -- The component Pkg_Id is an entry into the table Package_Attributes
524 -- (in Prj.Attr). It is used to indicate all the attributes of the
525 -- package with their characteristics.
527 -- The tables Prj.Attr.Attributes and Prj.Attr.Package_Attributes
528 -- are built once and for all through a call (from Prj.Initialize)
529 -- to procedure Prj.Attr.Initialize. It is never modified after that.
531 Name
: Name_Id
:= No_Name
;
532 -- See below for what Project_Node_Kind it is used
534 Path_Name
: Name_Id
:= No_Name
;
535 -- See below for what Project_Node_Kind it is used
537 Value
: String_Id
:= No_String
;
538 -- See below for what Project_Node_Kind it is used
540 Field1
: Project_Node_Id
:= Empty_Node
;
541 -- See below the meaning for each Project_Node_Kind
543 Field2
: Project_Node_Id
:= Empty_Node
;
544 -- See below the meaning for each Project_Node_Kind
546 Field3
: Project_Node_Id
:= Empty_Node
;
547 -- See below the meaning for each Project_Node_Kind
549 Case_Insensitive
: Boolean := False;
550 -- Significant only for N_Attribute_Declaration
551 -- Indicates, for an associative array attribute, that the
552 -- index is case insensitive.
556 -- type Project_Node_Kind is
559 -- -- Name: project name
560 -- -- Path_Name: project path name
561 -- -- Expr_Kind: Undefined
562 -- -- Field1: first with clause
563 -- -- Field2: project declaration
564 -- -- Field3: first string type
565 -- -- Value: modified project path name (if any)
568 -- -- Name: imported project name
569 -- -- Path_Name: imported project path name
570 -- -- Expr_Kind: Undefined
571 -- -- Field1: project node
572 -- -- Field2: next with clause
573 -- -- Field3: not used
574 -- -- Value: literal string withed
576 -- N_Project_Declaration,
578 -- -- Path_Name: not used
579 -- -- Expr_Kind: Undefined
580 -- -- Field1: first declarative item
581 -- -- Field2: modified project
582 -- -- Field3: not used
583 -- -- Value: not used
585 -- N_Declarative_Item,
587 -- -- Path_Name: not used
588 -- -- Expr_Kind: Undefined
589 -- -- Field1: current item node
590 -- -- Field2: next declarative item
591 -- -- Field3: not used
592 -- -- Value: not used
594 -- N_Package_Declaration,
595 -- -- Name: package name
596 -- -- Path_Name: not used
597 -- -- Expr_Kind: Undefined
598 -- -- Field1: project of renamed package (if any)
599 -- -- Field2: first declarative item
600 -- -- Field3: next package in project
601 -- -- Value: not used
603 -- N_String_Type_Declaration,
604 -- -- Name: type name
605 -- -- Path_Name: not used
606 -- -- Expr_Kind: Undefined
607 -- -- Field1: first literal string
608 -- -- Field2: next string type
609 -- -- Field3: not used
610 -- -- Value: not used
614 -- -- Path_Name: not used
615 -- -- Expr_Kind: Single
616 -- -- Field1: next literal string
617 -- -- Field2: not used
618 -- -- Field3: not used
619 -- -- Value: string value
621 -- N_Attribute_Declaration,
622 -- -- Name: attribute name
623 -- -- Path_Name: not used
624 -- -- Expr_Kind: attribute kind
625 -- -- Field1: expression
626 -- -- Field2: not used
627 -- -- Field3: not used
628 -- -- Value: associative array index
629 -- -- (if an associative array element)
631 -- N_Typed_Variable_Declaration,
632 -- -- Name: variable name
633 -- -- Path_Name: not used
634 -- -- Expr_Kind: Single
635 -- -- Field1: expression
636 -- -- Field2: type of variable (N_String_Type_Declaration)
637 -- -- Field3: next variable
638 -- -- Value: not used
640 -- N_Variable_Declaration,
641 -- -- Name: variable name
642 -- -- Path_Name: not used
643 -- -- Expr_Kind: variable kind
644 -- -- Field1: expression
645 -- -- Field2: not used
646 -- -- Field3 is used for next variable, instead of Field2,
647 -- -- so that it is the same field for
648 -- -- N_Variable_Declaration and
649 -- -- N_Typed_Variable_Declaration
650 -- -- Field3: next variable
651 -- -- Value: not used
655 -- -- Path_Name: not used
656 -- -- Expr_Kind: expression kind
657 -- -- Field1: first term
658 -- -- Field2: next expression in list
659 -- -- Field3: not used
660 -- -- Value: not used
664 -- -- Path_Name: not used
665 -- -- Expr_Kind: term kind
666 -- -- Field1: current term
667 -- -- Field2: next term in the expression
668 -- -- Field3: not used
669 -- -- Value: not used
671 -- N_Literal_String_List,
672 -- -- Designates a list of string expressions between brackets
673 -- -- separated by commas. The string expressions are not necessarily
674 -- -- literal strings.
676 -- -- Path_Name: not used
677 -- -- Expr_Kind: List
678 -- -- Field1: first expression
679 -- -- Field2: not used
680 -- -- Field3: not used
681 -- -- Value: not used
683 -- N_Variable_Reference,
684 -- -- Name: variable name
685 -- -- Path_Name: not used
686 -- -- Expr_Kind: variable kind
687 -- -- Field1: project (if specified)
688 -- -- Field2: package (if specified)
689 -- -- Field3: type of variable (N_String_Type_Declaration), if any
690 -- -- Value: not used
694 -- -- Path_Name: not used
695 -- -- Expr_Kind: Single
696 -- -- Field1: Name of the external reference (literal string)
697 -- -- Field2: Default (literal string)
698 -- -- Field3: not used
699 -- -- Value: not used
701 -- N_Attribute_Reference,
702 -- -- Name: attribute name
703 -- -- Path_Name: not used
704 -- -- Expr_Kind: attribute kind
705 -- -- Field1: project
706 -- -- Field2: package (if attribute of a package)
707 -- -- Field3: not used
708 -- -- Value: not used
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
;