URL
https://opencores.org/ocsvn/openrisc/openrisc/trunk
Subversion Repositories openrisc
[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [prj-tree.adb] - Rev 749
Go to most recent revision | Compare with Previous | Blame | View Log
------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- P R J . T R E E -- -- -- -- B o d y -- -- -- -- Copyright (C) 2001-2011, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 3, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- -- for more details. You should have received a copy of the GNU General -- -- Public License distributed with GNAT; see file COPYING3. If not, go to -- -- http://www.gnu.org/licenses for a complete copy of the license. -- -- -- -- GNAT was originally developed by the GNAT team at New York University. -- -- Extensive contributions were provided by Ada Core Technologies Inc. -- -- -- ------------------------------------------------------------------------------ with Osint; use Osint; with Prj.Env; use Prj.Env; with Prj.Err; with Ada.Unchecked_Deallocation; package body Prj.Tree is Node_With_Comments : constant array (Project_Node_Kind) of Boolean := (N_Project => True, N_With_Clause => True, N_Project_Declaration => False, N_Declarative_Item => False, N_Package_Declaration => True, N_String_Type_Declaration => True, N_Literal_String => False, N_Attribute_Declaration => True, N_Typed_Variable_Declaration => True, N_Variable_Declaration => True, N_Expression => False, N_Term => False, N_Literal_String_List => False, N_Variable_Reference => False, N_External_Value => False, N_Attribute_Reference => False, N_Case_Construction => True, N_Case_Item => True, N_Comment_Zones => True, N_Comment => True); -- Indicates the kinds of node that may have associated comments package Next_End_Nodes is new Table.Table (Table_Component_Type => Project_Node_Id, Table_Index_Type => Natural, Table_Low_Bound => 1, Table_Initial => 10, Table_Increment => 100, Table_Name => "Next_End_Nodes"); -- A stack of nodes to indicates to what node the next "end" is associated use Tree_Private_Part; End_Of_Line_Node : Project_Node_Id := Empty_Node; -- The node an end of line comment may be associated with Previous_Line_Node : Project_Node_Id := Empty_Node; -- The node an immediately following comment may be associated with Previous_End_Node : Project_Node_Id := Empty_Node; -- The node comments immediately following an "end" line may be -- associated with. Unkept_Comments : Boolean := False; -- Set to True when some comments may not be associated with any node function Comment_Zones_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Project_Node_Id; -- Returns the ID of the N_Comment_Zones node associated with node Node. -- If there is not already an N_Comment_Zones node, create one and -- associate it with node Node. ------------------ -- Add_Comments -- ------------------ procedure Add_Comments (To : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; Where : Comment_Location) is Zone : Project_Node_Id := Empty_Node; Previous : Project_Node_Id := Empty_Node; begin pragma Assert (Present (To) and then In_Tree.Project_Nodes.Table (To).Kind /= N_Comment); Zone := In_Tree.Project_Nodes.Table (To).Comments; if No (Zone) then -- Create new N_Comment_Zones node Project_Node_Table.Increment_Last (In_Tree.Project_Nodes); In_Tree.Project_Nodes.Table (Project_Node_Table.Last (In_Tree.Project_Nodes)) := (Kind => N_Comment_Zones, Qualifier => Unspecified, Expr_Kind => Undefined, Location => No_Location, Directory => No_Path, Variables => Empty_Node, Packages => Empty_Node, Pkg_Id => Empty_Package, Name => No_Name, Src_Index => 0, Path_Name => No_Path, Value => No_Name, Field1 => Empty_Node, Field2 => Empty_Node, Field3 => Empty_Node, Field4 => Empty_Node, Flag1 => False, Flag2 => False, Comments => Empty_Node); Zone := Project_Node_Table.Last (In_Tree.Project_Nodes); In_Tree.Project_Nodes.Table (To).Comments := Zone; end if; if Where = End_Of_Line then In_Tree.Project_Nodes.Table (Zone).Value := Comments.Table (1).Value; else -- Get each comments in the Comments table and link them to node To for J in 1 .. Comments.Last loop -- Create new N_Comment node if (Where = After or else Where = After_End) and then Token /= Tok_EOF and then Comments.Table (J).Follows_Empty_Line then Comments.Table (1 .. Comments.Last - J + 1) := Comments.Table (J .. Comments.Last); Comments.Set_Last (Comments.Last - J + 1); return; end if; Project_Node_Table.Increment_Last (In_Tree.Project_Nodes); In_Tree.Project_Nodes.Table (Project_Node_Table.Last (In_Tree.Project_Nodes)) := (Kind => N_Comment, Qualifier => Unspecified, Expr_Kind => Undefined, Flag1 => Comments.Table (J).Follows_Empty_Line, Flag2 => Comments.Table (J).Is_Followed_By_Empty_Line, Location => No_Location, Directory => No_Path, Variables => Empty_Node, Packages => Empty_Node, Pkg_Id => Empty_Package, Name => No_Name, Src_Index => 0, Path_Name => No_Path, Value => Comments.Table (J).Value, Field1 => Empty_Node, Field2 => Empty_Node, Field3 => Empty_Node, Field4 => Empty_Node, Comments => Empty_Node); -- If this is the first comment, put it in the right field of -- the node Zone. if No (Previous) then case Where is when Before => In_Tree.Project_Nodes.Table (Zone).Field1 := Project_Node_Table.Last (In_Tree.Project_Nodes); when After => In_Tree.Project_Nodes.Table (Zone).Field2 := Project_Node_Table.Last (In_Tree.Project_Nodes); when Before_End => In_Tree.Project_Nodes.Table (Zone).Field3 := Project_Node_Table.Last (In_Tree.Project_Nodes); when After_End => In_Tree.Project_Nodes.Table (Zone).Comments := Project_Node_Table.Last (In_Tree.Project_Nodes); when End_Of_Line => null; end case; else -- When it is not the first, link it to the previous one In_Tree.Project_Nodes.Table (Previous).Comments := Project_Node_Table.Last (In_Tree.Project_Nodes); end if; -- This node becomes the previous one for the next comment, if -- there is one. Previous := Project_Node_Table.Last (In_Tree.Project_Nodes); end loop; end if; -- Empty the Comments table, so that there is no risk to link the same -- comments to another node. Comments.Set_Last (0); end Add_Comments; -------------------------------- -- Associative_Array_Index_Of -- -------------------------------- function Associative_Array_Index_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Name_Id is begin pragma Assert (Present (Node) and then (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration or else In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference)); return In_Tree.Project_Nodes.Table (Node).Value; end Associative_Array_Index_Of; ---------------------------- -- Associative_Package_Of -- ---------------------------- function Associative_Package_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Present (Node) and then (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration)); return In_Tree.Project_Nodes.Table (Node).Field3; end Associative_Package_Of; ---------------------------- -- Associative_Project_Of -- ---------------------------- function Associative_Project_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Present (Node) and then (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration)); return In_Tree.Project_Nodes.Table (Node).Field2; end Associative_Project_Of; ---------------------- -- Case_Insensitive -- ---------------------- function Case_Insensitive (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Boolean is begin pragma Assert (Present (Node) and then (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration or else In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference)); return In_Tree.Project_Nodes.Table (Node).Flag1; end Case_Insensitive; -------------------------------- -- Case_Variable_Reference_Of -- -------------------------------- function Case_Variable_Reference_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction); return In_Tree.Project_Nodes.Table (Node).Field1; end Case_Variable_Reference_Of; ---------------------- -- Comment_Zones_Of -- ---------------------- function Comment_Zones_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is Zone : Project_Node_Id; begin pragma Assert (Present (Node)); Zone := In_Tree.Project_Nodes.Table (Node).Comments; -- If there is not already an N_Comment_Zones associated, create a new -- one and associate it with node Node. if No (Zone) then Project_Node_Table.Increment_Last (In_Tree.Project_Nodes); Zone := Project_Node_Table.Last (In_Tree.Project_Nodes); In_Tree.Project_Nodes.Table (Zone) := (Kind => N_Comment_Zones, Qualifier => Unspecified, Location => No_Location, Directory => No_Path, Expr_Kind => Undefined, Variables => Empty_Node, Packages => Empty_Node, Pkg_Id => Empty_Package, Name => No_Name, Src_Index => 0, Path_Name => No_Path, Value => No_Name, Field1 => Empty_Node, Field2 => Empty_Node, Field3 => Empty_Node, Field4 => Empty_Node, Flag1 => False, Flag2 => False, Comments => Empty_Node); In_Tree.Project_Nodes.Table (Node).Comments := Zone; end if; return Zone; end Comment_Zones_Of; ----------------------- -- Current_Item_Node -- ----------------------- function Current_Item_Node (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item); return In_Tree.Project_Nodes.Table (Node).Field1; end Current_Item_Node; ------------------ -- Current_Term -- ------------------ function Current_Term (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Term); return In_Tree.Project_Nodes.Table (Node).Field1; end Current_Term; -------------------------- -- Default_Project_Node -- -------------------------- function Default_Project_Node (In_Tree : Project_Node_Tree_Ref; Of_Kind : Project_Node_Kind; And_Expr_Kind : Variable_Kind := Undefined) return Project_Node_Id is Result : Project_Node_Id; Zone : Project_Node_Id; Previous : Project_Node_Id; begin -- Create new node with specified kind and expression kind Project_Node_Table.Increment_Last (In_Tree.Project_Nodes); In_Tree.Project_Nodes.Table (Project_Node_Table.Last (In_Tree.Project_Nodes)) := (Kind => Of_Kind, Qualifier => Unspecified, Location => No_Location, Directory => No_Path, Expr_Kind => And_Expr_Kind, Variables => Empty_Node, Packages => Empty_Node, Pkg_Id => Empty_Package, Name => No_Name, Src_Index => 0, Path_Name => No_Path, Value => No_Name, Field1 => Empty_Node, Field2 => Empty_Node, Field3 => Empty_Node, Field4 => Empty_Node, Flag1 => False, Flag2 => False, Comments => Empty_Node); -- Save the new node for the returned value Result := Project_Node_Table.Last (In_Tree.Project_Nodes); if Comments.Last > 0 then -- If this is not a node with comments, then set the flag if not Node_With_Comments (Of_Kind) then Unkept_Comments := True; elsif Of_Kind /= N_Comment and then Of_Kind /= N_Comment_Zones then Project_Node_Table.Increment_Last (In_Tree.Project_Nodes); In_Tree.Project_Nodes.Table (Project_Node_Table.Last (In_Tree.Project_Nodes)) := (Kind => N_Comment_Zones, Qualifier => Unspecified, Expr_Kind => Undefined, Location => No_Location, Directory => No_Path, Variables => Empty_Node, Packages => Empty_Node, Pkg_Id => Empty_Package, Name => No_Name, Src_Index => 0, Path_Name => No_Path, Value => No_Name, Field1 => Empty_Node, Field2 => Empty_Node, Field3 => Empty_Node, Field4 => Empty_Node, Flag1 => False, Flag2 => False, Comments => Empty_Node); Zone := Project_Node_Table.Last (In_Tree.Project_Nodes); In_Tree.Project_Nodes.Table (Result).Comments := Zone; Previous := Empty_Node; for J in 1 .. Comments.Last loop -- Create a new N_Comment node Project_Node_Table.Increment_Last (In_Tree.Project_Nodes); In_Tree.Project_Nodes.Table (Project_Node_Table.Last (In_Tree.Project_Nodes)) := (Kind => N_Comment, Qualifier => Unspecified, Expr_Kind => Undefined, Flag1 => Comments.Table (J).Follows_Empty_Line, Flag2 => Comments.Table (J).Is_Followed_By_Empty_Line, Location => No_Location, Directory => No_Path, Variables => Empty_Node, Packages => Empty_Node, Pkg_Id => Empty_Package, Name => No_Name, Src_Index => 0, Path_Name => No_Path, Value => Comments.Table (J).Value, Field1 => Empty_Node, Field2 => Empty_Node, Field3 => Empty_Node, Field4 => Empty_Node, Comments => Empty_Node); -- Link it to the N_Comment_Zones node, if it is the first, -- otherwise to the previous one. if No (Previous) then In_Tree.Project_Nodes.Table (Zone).Field1 := Project_Node_Table.Last (In_Tree.Project_Nodes); else In_Tree.Project_Nodes.Table (Previous).Comments := Project_Node_Table.Last (In_Tree.Project_Nodes); end if; -- This new node will be the previous one for the next -- N_Comment node, if there is one. Previous := Project_Node_Table.Last (In_Tree.Project_Nodes); end loop; -- Empty the Comments table after all comments have been processed Comments.Set_Last (0); end if; end if; return Result; end Default_Project_Node; ------------------ -- Directory_Of -- ------------------ function Directory_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Path_Name_Type is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project); return In_Tree.Project_Nodes.Table (Node).Directory; end Directory_Of; ------------------------- -- End_Of_Line_Comment -- ------------------------- function End_Of_Line_Comment (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Name_Id is Zone : Project_Node_Id := Empty_Node; begin pragma Assert (Present (Node)); Zone := In_Tree.Project_Nodes.Table (Node).Comments; if No (Zone) then return No_Name; else return In_Tree.Project_Nodes.Table (Zone).Value; end if; end End_Of_Line_Comment; ------------------------ -- Expression_Kind_Of -- ------------------------ function Expression_Kind_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Variable_Kind is begin pragma Assert (Present (Node) and then -- should use Nkind_In here ??? why not??? (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String or else In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration or else In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Declaration or else In_Tree.Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration or else In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration or else In_Tree.Project_Nodes.Table (Node).Kind = N_Expression or else In_Tree.Project_Nodes.Table (Node).Kind = N_Term or else In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference or else In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference or else In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value)); return In_Tree.Project_Nodes.Table (Node).Expr_Kind; end Expression_Kind_Of; ------------------- -- Expression_Of -- ------------------- function Expression_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Present (Node) and then (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration or else In_Tree.Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration or else In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Declaration)); return In_Tree.Project_Nodes.Table (Node).Field1; end Expression_Of; ------------------------- -- Extended_Project_Of -- ------------------------- function Extended_Project_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration); return In_Tree.Project_Nodes.Table (Node).Field2; end Extended_Project_Of; ------------------------------ -- Extended_Project_Path_Of -- ------------------------------ function Extended_Project_Path_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Path_Name_Type is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project); return Path_Name_Type (In_Tree.Project_Nodes.Table (Node).Value); end Extended_Project_Path_Of; -------------------------- -- Extending_Project_Of -- -------------------------- function Extending_Project_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration); return In_Tree.Project_Nodes.Table (Node).Field3; end Extending_Project_Of; --------------------------- -- External_Reference_Of -- --------------------------- function External_Reference_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value); return In_Tree.Project_Nodes.Table (Node).Field1; end External_Reference_Of; ------------------------- -- External_Default_Of -- ------------------------- function External_Default_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value); return In_Tree.Project_Nodes.Table (Node).Field2; end External_Default_Of; ------------------------ -- First_Case_Item_Of -- ------------------------ function First_Case_Item_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction); return In_Tree.Project_Nodes.Table (Node).Field2; end First_Case_Item_Of; --------------------- -- First_Choice_Of -- --------------------- function First_Choice_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item); return In_Tree.Project_Nodes.Table (Node).Field1; end First_Choice_Of; ------------------------- -- First_Comment_After -- ------------------------- function First_Comment_After (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is Zone : Project_Node_Id := Empty_Node; begin pragma Assert (Present (Node)); Zone := In_Tree.Project_Nodes.Table (Node).Comments; if No (Zone) then return Empty_Node; else return In_Tree.Project_Nodes.Table (Zone).Field2; end if; end First_Comment_After; ----------------------------- -- First_Comment_After_End -- ----------------------------- function First_Comment_After_End (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is Zone : Project_Node_Id := Empty_Node; begin pragma Assert (Present (Node)); Zone := In_Tree.Project_Nodes.Table (Node).Comments; if No (Zone) then return Empty_Node; else return In_Tree.Project_Nodes.Table (Zone).Comments; end if; end First_Comment_After_End; -------------------------- -- First_Comment_Before -- -------------------------- function First_Comment_Before (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is Zone : Project_Node_Id := Empty_Node; begin pragma Assert (Present (Node)); Zone := In_Tree.Project_Nodes.Table (Node).Comments; if No (Zone) then return Empty_Node; else return In_Tree.Project_Nodes.Table (Zone).Field1; end if; end First_Comment_Before; ------------------------------ -- First_Comment_Before_End -- ------------------------------ function First_Comment_Before_End (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is Zone : Project_Node_Id := Empty_Node; begin pragma Assert (Present (Node)); Zone := In_Tree.Project_Nodes.Table (Node).Comments; if No (Zone) then return Empty_Node; else return In_Tree.Project_Nodes.Table (Zone).Field3; end if; end First_Comment_Before_End; ------------------------------- -- First_Declarative_Item_Of -- ------------------------------- function First_Declarative_Item_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Present (Node) and then (In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration or else In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item or else In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration)); if In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration then return In_Tree.Project_Nodes.Table (Node).Field1; else return In_Tree.Project_Nodes.Table (Node).Field2; end if; end First_Declarative_Item_Of; ------------------------------ -- First_Expression_In_List -- ------------------------------ function First_Expression_In_List (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String_List); return In_Tree.Project_Nodes.Table (Node).Field1; end First_Expression_In_List; -------------------------- -- First_Literal_String -- -------------------------- function First_Literal_String (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_String_Type_Declaration); return In_Tree.Project_Nodes.Table (Node).Field1; end First_Literal_String; ---------------------- -- First_Package_Of -- ---------------------- function First_Package_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Package_Declaration_Id is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project); return In_Tree.Project_Nodes.Table (Node).Packages; end First_Package_Of; -------------------------- -- First_String_Type_Of -- -------------------------- function First_String_Type_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project); return In_Tree.Project_Nodes.Table (Node).Field3; end First_String_Type_Of; ---------------- -- First_Term -- ---------------- function First_Term (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Expression); return In_Tree.Project_Nodes.Table (Node).Field1; end First_Term; ----------------------- -- First_Variable_Of -- ----------------------- function First_Variable_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Variable_Node_Id is begin pragma Assert (Present (Node) and then (In_Tree.Project_Nodes.Table (Node).Kind = N_Project or else In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration)); return In_Tree.Project_Nodes.Table (Node).Variables; end First_Variable_Of; -------------------------- -- First_With_Clause_Of -- -------------------------- function First_With_Clause_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project); return In_Tree.Project_Nodes.Table (Node).Field1; end First_With_Clause_Of; ------------------------ -- Follows_Empty_Line -- ------------------------ function Follows_Empty_Line (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Boolean is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Comment); return In_Tree.Project_Nodes.Table (Node).Flag1; end Follows_Empty_Line; ---------- -- Hash -- ---------- function Hash (N : Project_Node_Id) return Header_Num is begin return Header_Num (N mod Project_Node_Id (Header_Num'Last)); end Hash; ---------------- -- Initialize -- ---------------- procedure Initialize (Tree : Project_Node_Tree_Ref) is begin Project_Node_Table.Init (Tree.Project_Nodes); Projects_Htable.Reset (Tree.Projects_HT); end Initialize; -------------------- -- Override_Flags -- -------------------- procedure Override_Flags (Self : in out Environment; Flags : Prj.Processing_Flags) is begin Self.Flags := Flags; end Override_Flags; ---------------- -- Initialize -- ---------------- procedure Initialize (Self : out Environment; Flags : Processing_Flags) is begin -- Do not reset the external references, in case we are reloading a -- project, since we want to preserve the current environment. But we -- still need to ensure that the external references are properly -- initialized. -- Prj.Ext.Reset (Tree.External); Prj.Ext.Initialize (Self.External); Self.Flags := Flags; end Initialize; ------------------------- -- Initialize_And_Copy -- ------------------------- procedure Initialize_And_Copy (Self : out Environment; Copy_From : Environment) is begin Self.Flags := Copy_From.Flags; Prj.Ext.Initialize (Self.External, Copy_From => Copy_From.External); Prj.Env.Copy (From => Copy_From.Project_Path, To => Self.Project_Path); end Initialize_And_Copy; ---------- -- Free -- ---------- procedure Free (Self : in out Environment) is begin Prj.Ext.Free (Self.External); Free (Self.Project_Path); end Free; ---------- -- Free -- ---------- procedure Free (Proj : in out Project_Node_Tree_Ref) is procedure Unchecked_Free is new Ada.Unchecked_Deallocation (Project_Node_Tree_Data, Project_Node_Tree_Ref); begin if Proj /= null then Project_Node_Table.Free (Proj.Project_Nodes); Projects_Htable.Reset (Proj.Projects_HT); Unchecked_Free (Proj); end if; end Free; ------------------------------- -- Is_Followed_By_Empty_Line -- ------------------------------- function Is_Followed_By_Empty_Line (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Boolean is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Comment); return In_Tree.Project_Nodes.Table (Node).Flag2; end Is_Followed_By_Empty_Line; ---------------------- -- Is_Extending_All -- ---------------------- function Is_Extending_All (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Boolean is begin pragma Assert (Present (Node) and then (In_Tree.Project_Nodes.Table (Node).Kind = N_Project or else In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause)); return In_Tree.Project_Nodes.Table (Node).Flag2; end Is_Extending_All; ------------------------- -- Is_Not_Last_In_List -- ------------------------- function Is_Not_Last_In_List (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Boolean is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause); return In_Tree.Project_Nodes.Table (Node).Flag1; end Is_Not_Last_In_List; ------------------------------------- -- Imported_Or_Extended_Project_Of -- ------------------------------------- function Imported_Or_Extended_Project_Of (Project : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; With_Name : Name_Id) return Project_Node_Id is With_Clause : Project_Node_Id := First_With_Clause_Of (Project, In_Tree); Result : Project_Node_Id := Empty_Node; begin -- First check all the imported projects while Present (With_Clause) loop -- Only non limited imported project may be used as prefix -- of variable or attributes. Result := Non_Limited_Project_Node_Of (With_Clause, In_Tree); exit when Present (Result) and then Name_Of (Result, In_Tree) = With_Name; With_Clause := Next_With_Clause_Of (With_Clause, In_Tree); end loop; -- If it is not an imported project, it might be an extended project if No (With_Clause) then Result := Project; loop Result := Extended_Project_Of (Project_Declaration_Of (Result, In_Tree), In_Tree); exit when No (Result) or else Name_Of (Result, In_Tree) = With_Name; end loop; end if; return Result; end Imported_Or_Extended_Project_Of; ------------- -- Kind_Of -- ------------- function Kind_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Project_Node_Kind is begin pragma Assert (Present (Node)); return In_Tree.Project_Nodes.Table (Node).Kind; end Kind_Of; ----------------- -- Location_Of -- ----------------- function Location_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Source_Ptr is begin pragma Assert (Present (Node)); return In_Tree.Project_Nodes.Table (Node).Location; end Location_Of; ------------- -- Name_Of -- ------------- function Name_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Name_Id is begin pragma Assert (Present (Node)); return In_Tree.Project_Nodes.Table (Node).Name; end Name_Of; -------------------- -- Next_Case_Item -- -------------------- function Next_Case_Item (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item); return In_Tree.Project_Nodes.Table (Node).Field3; end Next_Case_Item; ------------------ -- Next_Comment -- ------------------ function Next_Comment (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Comment); return In_Tree.Project_Nodes.Table (Node).Comments; end Next_Comment; --------------------------- -- Next_Declarative_Item -- --------------------------- function Next_Declarative_Item (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item); return In_Tree.Project_Nodes.Table (Node).Field2; end Next_Declarative_Item; ----------------------------- -- Next_Expression_In_List -- ----------------------------- function Next_Expression_In_List (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Expression); return In_Tree.Project_Nodes.Table (Node).Field2; end Next_Expression_In_List; ------------------------- -- Next_Literal_String -- ------------------------- function Next_Literal_String (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String); return In_Tree.Project_Nodes.Table (Node).Field1; end Next_Literal_String; ----------------------------- -- Next_Package_In_Project -- ----------------------------- function Next_Package_In_Project (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration); return In_Tree.Project_Nodes.Table (Node).Field3; end Next_Package_In_Project; ---------------------- -- Next_String_Type -- ---------------------- function Next_String_Type (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_String_Type_Declaration); return In_Tree.Project_Nodes.Table (Node).Field2; end Next_String_Type; --------------- -- Next_Term -- --------------- function Next_Term (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Term); return In_Tree.Project_Nodes.Table (Node).Field2; end Next_Term; ------------------- -- Next_Variable -- ------------------- function Next_Variable (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Present (Node) and then (In_Tree.Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration or else In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Declaration)); return In_Tree.Project_Nodes.Table (Node).Field3; end Next_Variable; ------------------------- -- Next_With_Clause_Of -- ------------------------- function Next_With_Clause_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause); return In_Tree.Project_Nodes.Table (Node).Field2; end Next_With_Clause_Of; -------- -- No -- -------- function No (Node : Project_Node_Id) return Boolean is begin return Node = Empty_Node; end No; --------------------------------- -- Non_Limited_Project_Node_Of -- --------------------------------- function Non_Limited_Project_Node_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Present (Node) and then (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause)); return In_Tree.Project_Nodes.Table (Node).Field3; end Non_Limited_Project_Node_Of; ------------------- -- Package_Id_Of -- ------------------- function Package_Id_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Package_Node_Id is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration); return In_Tree.Project_Nodes.Table (Node).Pkg_Id; end Package_Id_Of; --------------------- -- Package_Node_Of -- --------------------- function Package_Node_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Present (Node) and then (In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference or else In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference)); return In_Tree.Project_Nodes.Table (Node).Field2; end Package_Node_Of; ------------------ -- Path_Name_Of -- ------------------ function Path_Name_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Path_Name_Type is begin pragma Assert (Present (Node) and then (In_Tree.Project_Nodes.Table (Node).Kind = N_Project or else In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause)); return In_Tree.Project_Nodes.Table (Node).Path_Name; end Path_Name_Of; ------------- -- Present -- ------------- function Present (Node : Project_Node_Id) return Boolean is begin return Node /= Empty_Node; end Present; ---------------------------- -- Project_Declaration_Of -- ---------------------------- function Project_Declaration_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project); return In_Tree.Project_Nodes.Table (Node).Field2; end Project_Declaration_Of; -------------------------- -- Project_Qualifier_Of -- -------------------------- function Project_Qualifier_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Project_Qualifier is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project); return In_Tree.Project_Nodes.Table (Node).Qualifier; end Project_Qualifier_Of; ----------------------- -- Parent_Project_Of -- ----------------------- function Parent_Project_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project); return In_Tree.Project_Nodes.Table (Node).Field4; end Parent_Project_Of; ------------------------------------------- -- Project_File_Includes_Unkept_Comments -- ------------------------------------------- function Project_File_Includes_Unkept_Comments (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Boolean is Declaration : constant Project_Node_Id := Project_Declaration_Of (Node, In_Tree); begin return In_Tree.Project_Nodes.Table (Declaration).Flag1; end Project_File_Includes_Unkept_Comments; --------------------- -- Project_Node_Of -- --------------------- function Project_Node_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Present (Node) and then (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause or else In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference or else In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference)); return In_Tree.Project_Nodes.Table (Node).Field1; end Project_Node_Of; ----------------------------------- -- Project_Of_Renamed_Package_Of -- ----------------------------------- function Project_Of_Renamed_Package_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration); return In_Tree.Project_Nodes.Table (Node).Field1; end Project_Of_Renamed_Package_Of; -------------------------- -- Remove_Next_End_Node -- -------------------------- procedure Remove_Next_End_Node is begin Next_End_Nodes.Decrement_Last; end Remove_Next_End_Node; ----------------- -- Reset_State -- ----------------- procedure Reset_State is begin End_Of_Line_Node := Empty_Node; Previous_Line_Node := Empty_Node; Previous_End_Node := Empty_Node; Unkept_Comments := False; Comments.Set_Last (0); end Reset_State; ---------------------- -- Restore_And_Free -- ---------------------- procedure Restore_And_Free (S : in out Comment_State) is procedure Unchecked_Free is new Ada.Unchecked_Deallocation (Comment_Array, Comments_Ptr); begin End_Of_Line_Node := S.End_Of_Line_Node; Previous_Line_Node := S.Previous_Line_Node; Previous_End_Node := S.Previous_End_Node; Next_End_Nodes.Set_Last (0); Unkept_Comments := S.Unkept_Comments; Comments.Set_Last (0); for J in S.Comments'Range loop Comments.Increment_Last; Comments.Table (Comments.Last) := S.Comments (J); end loop; Unchecked_Free (S.Comments); end Restore_And_Free; ---------- -- Save -- ---------- procedure Save (S : out Comment_State) is Cmts : constant Comments_Ptr := new Comment_Array (1 .. Comments.Last); begin for J in 1 .. Comments.Last loop Cmts (J) := Comments.Table (J); end loop; S := (End_Of_Line_Node => End_Of_Line_Node, Previous_Line_Node => Previous_Line_Node, Previous_End_Node => Previous_End_Node, Unkept_Comments => Unkept_Comments, Comments => Cmts); end Save; ---------- -- Scan -- ---------- procedure Scan (In_Tree : Project_Node_Tree_Ref) is Empty_Line : Boolean := False; begin -- If there are comments, then they will not be kept. Set the flag and -- clear the comments. if Comments.Last > 0 then Unkept_Comments := True; Comments.Set_Last (0); end if; -- Loop until a token other that End_Of_Line or Comment is found loop Prj.Err.Scanner.Scan; case Token is when Tok_End_Of_Line => if Prev_Token = Tok_End_Of_Line then Empty_Line := True; if Comments.Last > 0 then Comments.Table (Comments.Last).Is_Followed_By_Empty_Line := True; end if; end if; when Tok_Comment => -- If this is a line comment, add it to the comment table if Prev_Token = Tok_End_Of_Line or else Prev_Token = No_Token then Comments.Increment_Last; Comments.Table (Comments.Last) := (Value => Comment_Id, Follows_Empty_Line => Empty_Line, Is_Followed_By_Empty_Line => False); -- Otherwise, it is an end of line comment. If there is -- an end of line node specified, associate the comment with -- this node. elsif Present (End_Of_Line_Node) then declare Zones : constant Project_Node_Id := Comment_Zones_Of (End_Of_Line_Node, In_Tree); begin In_Tree.Project_Nodes.Table (Zones).Value := Comment_Id; end; -- Otherwise, this end of line node cannot be kept else Unkept_Comments := True; Comments.Set_Last (0); end if; Empty_Line := False; when others => -- If there are comments, where the first comment is not -- following an empty line, put the initial uninterrupted -- comment zone with the node of the preceding line (either -- a Previous_Line or a Previous_End node), if any. if Comments.Last > 0 and then not Comments.Table (1).Follows_Empty_Line then if Present (Previous_Line_Node) then Add_Comments (To => Previous_Line_Node, Where => After, In_Tree => In_Tree); elsif Present (Previous_End_Node) then Add_Comments (To => Previous_End_Node, Where => After_End, In_Tree => In_Tree); end if; end if; -- If there are still comments and the token is "end", then -- put these comments with the Next_End node, if any; -- otherwise, these comments cannot be kept. Always clear -- the comments. if Comments.Last > 0 and then Token = Tok_End then if Next_End_Nodes.Last > 0 then Add_Comments (To => Next_End_Nodes.Table (Next_End_Nodes.Last), Where => Before_End, In_Tree => In_Tree); else Unkept_Comments := True; end if; Comments.Set_Last (0); end if; -- Reset the End_Of_Line, Previous_Line and Previous_End nodes -- so that they are not used again. End_Of_Line_Node := Empty_Node; Previous_Line_Node := Empty_Node; Previous_End_Node := Empty_Node; -- And return exit; end case; end loop; end Scan; ------------------------------------ -- Set_Associative_Array_Index_Of -- ------------------------------------ procedure Set_Associative_Array_Index_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Name_Id) is begin pragma Assert (Present (Node) and then (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration or else In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference)); In_Tree.Project_Nodes.Table (Node).Value := To; end Set_Associative_Array_Index_Of; -------------------------------- -- Set_Associative_Package_Of -- -------------------------------- procedure Set_Associative_Package_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Project_Node_Id) is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration); In_Tree.Project_Nodes.Table (Node).Field3 := To; end Set_Associative_Package_Of; -------------------------------- -- Set_Associative_Project_Of -- -------------------------------- procedure Set_Associative_Project_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Project_Node_Id) is begin pragma Assert (Present (Node) and then (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration)); In_Tree.Project_Nodes.Table (Node).Field2 := To; end Set_Associative_Project_Of; -------------------------- -- Set_Case_Insensitive -- -------------------------- procedure Set_Case_Insensitive (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Boolean) is begin pragma Assert (Present (Node) and then (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration or else In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference)); In_Tree.Project_Nodes.Table (Node).Flag1 := To; end Set_Case_Insensitive; ------------------------------------ -- Set_Case_Variable_Reference_Of -- ------------------------------------ procedure Set_Case_Variable_Reference_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Project_Node_Id) is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction); In_Tree.Project_Nodes.Table (Node).Field1 := To; end Set_Case_Variable_Reference_Of; --------------------------- -- Set_Current_Item_Node -- --------------------------- procedure Set_Current_Item_Node (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Project_Node_Id) is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item); In_Tree.Project_Nodes.Table (Node).Field1 := To; end Set_Current_Item_Node; ---------------------- -- Set_Current_Term -- ---------------------- procedure Set_Current_Term (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Project_Node_Id) is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Term); In_Tree.Project_Nodes.Table (Node).Field1 := To; end Set_Current_Term; ---------------------- -- Set_Directory_Of -- ---------------------- procedure Set_Directory_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Path_Name_Type) is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project); In_Tree.Project_Nodes.Table (Node).Directory := To; end Set_Directory_Of; --------------------- -- Set_End_Of_Line -- --------------------- procedure Set_End_Of_Line (To : Project_Node_Id) is begin End_Of_Line_Node := To; end Set_End_Of_Line; ---------------------------- -- Set_Expression_Kind_Of -- ---------------------------- procedure Set_Expression_Kind_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Variable_Kind) is begin pragma Assert (Present (Node) and then -- should use Nkind_In here ??? why not??? (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String or else In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration or else In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Declaration or else In_Tree.Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration or else In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration or else In_Tree.Project_Nodes.Table (Node).Kind = N_Expression or else In_Tree.Project_Nodes.Table (Node).Kind = N_Term or else In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference or else In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference or else In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value)); In_Tree.Project_Nodes.Table (Node).Expr_Kind := To; end Set_Expression_Kind_Of; ----------------------- -- Set_Expression_Of -- ----------------------- procedure Set_Expression_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Project_Node_Id) is begin pragma Assert (Present (Node) and then (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration or else In_Tree.Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration or else In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Declaration)); In_Tree.Project_Nodes.Table (Node).Field1 := To; end Set_Expression_Of; ------------------------------- -- Set_External_Reference_Of -- ------------------------------- procedure Set_External_Reference_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Project_Node_Id) is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value); In_Tree.Project_Nodes.Table (Node).Field1 := To; end Set_External_Reference_Of; ----------------------------- -- Set_External_Default_Of -- ----------------------------- procedure Set_External_Default_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Project_Node_Id) is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value); In_Tree.Project_Nodes.Table (Node).Field2 := To; end Set_External_Default_Of; ---------------------------- -- Set_First_Case_Item_Of -- ---------------------------- procedure Set_First_Case_Item_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Project_Node_Id) is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction); In_Tree.Project_Nodes.Table (Node).Field2 := To; end Set_First_Case_Item_Of; ------------------------- -- Set_First_Choice_Of -- ------------------------- procedure Set_First_Choice_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Project_Node_Id) is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item); In_Tree.Project_Nodes.Table (Node).Field1 := To; end Set_First_Choice_Of; ----------------------------- -- Set_First_Comment_After -- ----------------------------- procedure Set_First_Comment_After (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Project_Node_Id) is Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree); begin In_Tree.Project_Nodes.Table (Zone).Field2 := To; end Set_First_Comment_After; --------------------------------- -- Set_First_Comment_After_End -- --------------------------------- procedure Set_First_Comment_After_End (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Project_Node_Id) is Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree); begin In_Tree.Project_Nodes.Table (Zone).Comments := To; end Set_First_Comment_After_End; ------------------------------ -- Set_First_Comment_Before -- ------------------------------ procedure Set_First_Comment_Before (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Project_Node_Id) is Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree); begin In_Tree.Project_Nodes.Table (Zone).Field1 := To; end Set_First_Comment_Before; ---------------------------------- -- Set_First_Comment_Before_End -- ---------------------------------- procedure Set_First_Comment_Before_End (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Project_Node_Id) is Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree); begin In_Tree.Project_Nodes.Table (Zone).Field2 := To; end Set_First_Comment_Before_End; ------------------------ -- Set_Next_Case_Item -- ------------------------ procedure Set_Next_Case_Item (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Project_Node_Id) is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item); In_Tree.Project_Nodes.Table (Node).Field3 := To; end Set_Next_Case_Item; ---------------------- -- Set_Next_Comment -- ---------------------- procedure Set_Next_Comment (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Project_Node_Id) is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Comment); In_Tree.Project_Nodes.Table (Node).Comments := To; end Set_Next_Comment; ----------------------------------- -- Set_First_Declarative_Item_Of -- ----------------------------------- procedure Set_First_Declarative_Item_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Project_Node_Id) is begin pragma Assert (Present (Node) and then (In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration or else In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item or else In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration)); if In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration then In_Tree.Project_Nodes.Table (Node).Field1 := To; else In_Tree.Project_Nodes.Table (Node).Field2 := To; end if; end Set_First_Declarative_Item_Of; ---------------------------------- -- Set_First_Expression_In_List -- ---------------------------------- procedure Set_First_Expression_In_List (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Project_Node_Id) is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String_List); In_Tree.Project_Nodes.Table (Node).Field1 := To; end Set_First_Expression_In_List; ------------------------------ -- Set_First_Literal_String -- ------------------------------ procedure Set_First_Literal_String (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Project_Node_Id) is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_String_Type_Declaration); In_Tree.Project_Nodes.Table (Node).Field1 := To; end Set_First_Literal_String; -------------------------- -- Set_First_Package_Of -- -------------------------- procedure Set_First_Package_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Package_Declaration_Id) is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project); In_Tree.Project_Nodes.Table (Node).Packages := To; end Set_First_Package_Of; ------------------------------ -- Set_First_String_Type_Of -- ------------------------------ procedure Set_First_String_Type_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Project_Node_Id) is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project); In_Tree.Project_Nodes.Table (Node).Field3 := To; end Set_First_String_Type_Of; -------------------- -- Set_First_Term -- -------------------- procedure Set_First_Term (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Project_Node_Id) is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Expression); In_Tree.Project_Nodes.Table (Node).Field1 := To; end Set_First_Term; --------------------------- -- Set_First_Variable_Of -- --------------------------- procedure Set_First_Variable_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Variable_Node_Id) is begin pragma Assert (Present (Node) and then (In_Tree.Project_Nodes.Table (Node).Kind = N_Project or else In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration)); In_Tree.Project_Nodes.Table (Node).Variables := To; end Set_First_Variable_Of; ------------------------------ -- Set_First_With_Clause_Of -- ------------------------------ procedure Set_First_With_Clause_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Project_Node_Id) is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project); In_Tree.Project_Nodes.Table (Node).Field1 := To; end Set_First_With_Clause_Of; -------------------------- -- Set_Is_Extending_All -- -------------------------- procedure Set_Is_Extending_All (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) is begin pragma Assert (Present (Node) and then (In_Tree.Project_Nodes.Table (Node).Kind = N_Project or else In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause)); In_Tree.Project_Nodes.Table (Node).Flag2 := True; end Set_Is_Extending_All; ----------------------------- -- Set_Is_Not_Last_In_List -- ----------------------------- procedure Set_Is_Not_Last_In_List (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause); In_Tree.Project_Nodes.Table (Node).Flag1 := True; end Set_Is_Not_Last_In_List; ----------------- -- Set_Kind_Of -- ----------------- procedure Set_Kind_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Project_Node_Kind) is begin pragma Assert (Present (Node)); In_Tree.Project_Nodes.Table (Node).Kind := To; end Set_Kind_Of; --------------------- -- Set_Location_Of -- --------------------- procedure Set_Location_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Source_Ptr) is begin pragma Assert (Present (Node)); In_Tree.Project_Nodes.Table (Node).Location := To; end Set_Location_Of; ----------------------------- -- Set_Extended_Project_Of -- ----------------------------- procedure Set_Extended_Project_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Project_Node_Id) is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration); In_Tree.Project_Nodes.Table (Node).Field2 := To; end Set_Extended_Project_Of; ---------------------------------- -- Set_Extended_Project_Path_Of -- ---------------------------------- procedure Set_Extended_Project_Path_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Path_Name_Type) is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project); In_Tree.Project_Nodes.Table (Node).Value := Name_Id (To); end Set_Extended_Project_Path_Of; ------------------------------ -- Set_Extending_Project_Of -- ------------------------------ procedure Set_Extending_Project_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Project_Node_Id) is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration); In_Tree.Project_Nodes.Table (Node).Field3 := To; end Set_Extending_Project_Of; ----------------- -- Set_Name_Of -- ----------------- procedure Set_Name_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Name_Id) is begin pragma Assert (Present (Node)); In_Tree.Project_Nodes.Table (Node).Name := To; end Set_Name_Of; ------------------------------- -- Set_Next_Declarative_Item -- ------------------------------- procedure Set_Next_Declarative_Item (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Project_Node_Id) is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item); In_Tree.Project_Nodes.Table (Node).Field2 := To; end Set_Next_Declarative_Item; ----------------------- -- Set_Next_End_Node -- ----------------------- procedure Set_Next_End_Node (To : Project_Node_Id) is begin Next_End_Nodes.Increment_Last; Next_End_Nodes.Table (Next_End_Nodes.Last) := To; end Set_Next_End_Node; --------------------------------- -- Set_Next_Expression_In_List -- --------------------------------- procedure Set_Next_Expression_In_List (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Project_Node_Id) is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Expression); In_Tree.Project_Nodes.Table (Node).Field2 := To; end Set_Next_Expression_In_List; ----------------------------- -- Set_Next_Literal_String -- ----------------------------- procedure Set_Next_Literal_String (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Project_Node_Id) is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String); In_Tree.Project_Nodes.Table (Node).Field1 := To; end Set_Next_Literal_String; --------------------------------- -- Set_Next_Package_In_Project -- --------------------------------- procedure Set_Next_Package_In_Project (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Project_Node_Id) is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration); In_Tree.Project_Nodes.Table (Node).Field3 := To; end Set_Next_Package_In_Project; -------------------------- -- Set_Next_String_Type -- -------------------------- procedure Set_Next_String_Type (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Project_Node_Id) is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_String_Type_Declaration); In_Tree.Project_Nodes.Table (Node).Field2 := To; end Set_Next_String_Type; ------------------- -- Set_Next_Term -- ------------------- procedure Set_Next_Term (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Project_Node_Id) is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Term); In_Tree.Project_Nodes.Table (Node).Field2 := To; end Set_Next_Term; ----------------------- -- Set_Next_Variable -- ----------------------- procedure Set_Next_Variable (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Project_Node_Id) is begin pragma Assert (Present (Node) and then (In_Tree.Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration or else In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Declaration)); In_Tree.Project_Nodes.Table (Node).Field3 := To; end Set_Next_Variable; ----------------------------- -- Set_Next_With_Clause_Of -- ----------------------------- procedure Set_Next_With_Clause_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Project_Node_Id) is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause); In_Tree.Project_Nodes.Table (Node).Field2 := To; end Set_Next_With_Clause_Of; ----------------------- -- Set_Package_Id_Of -- ----------------------- procedure Set_Package_Id_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Package_Node_Id) is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration); In_Tree.Project_Nodes.Table (Node).Pkg_Id := To; end Set_Package_Id_Of; ------------------------- -- Set_Package_Node_Of -- ------------------------- procedure Set_Package_Node_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Project_Node_Id) is begin pragma Assert (Present (Node) and then (In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference or else In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference)); In_Tree.Project_Nodes.Table (Node).Field2 := To; end Set_Package_Node_Of; ---------------------- -- Set_Path_Name_Of -- ---------------------- procedure Set_Path_Name_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Path_Name_Type) is begin pragma Assert (Present (Node) and then (In_Tree.Project_Nodes.Table (Node).Kind = N_Project or else In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause)); In_Tree.Project_Nodes.Table (Node).Path_Name := To; end Set_Path_Name_Of; --------------------------- -- Set_Previous_End_Node -- --------------------------- procedure Set_Previous_End_Node (To : Project_Node_Id) is begin Previous_End_Node := To; end Set_Previous_End_Node; ---------------------------- -- Set_Previous_Line_Node -- ---------------------------- procedure Set_Previous_Line_Node (To : Project_Node_Id) is begin Previous_Line_Node := To; end Set_Previous_Line_Node; -------------------------------- -- Set_Project_Declaration_Of -- -------------------------------- procedure Set_Project_Declaration_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Project_Node_Id) is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project); In_Tree.Project_Nodes.Table (Node).Field2 := To; end Set_Project_Declaration_Of; ------------------------------ -- Set_Project_Qualifier_Of -- ------------------------------ procedure Set_Project_Qualifier_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Project_Qualifier) is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project); In_Tree.Project_Nodes.Table (Node).Qualifier := To; end Set_Project_Qualifier_Of; --------------------------- -- Set_Parent_Project_Of -- --------------------------- procedure Set_Parent_Project_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Project_Node_Id) is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project); In_Tree.Project_Nodes.Table (Node).Field4 := To; end Set_Parent_Project_Of; ----------------------------------------------- -- Set_Project_File_Includes_Unkept_Comments -- ----------------------------------------------- procedure Set_Project_File_Includes_Unkept_Comments (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Boolean) is Declaration : constant Project_Node_Id := Project_Declaration_Of (Node, In_Tree); begin In_Tree.Project_Nodes.Table (Declaration).Flag1 := To; end Set_Project_File_Includes_Unkept_Comments; ------------------------- -- Set_Project_Node_Of -- ------------------------- procedure Set_Project_Node_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Project_Node_Id; Limited_With : Boolean := False) is begin pragma Assert (Present (Node) and then (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause or else In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference or else In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference)); In_Tree.Project_Nodes.Table (Node).Field1 := To; if In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause and then not Limited_With then In_Tree.Project_Nodes.Table (Node).Field3 := To; end if; end Set_Project_Node_Of; --------------------------------------- -- Set_Project_Of_Renamed_Package_Of -- --------------------------------------- procedure Set_Project_Of_Renamed_Package_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Project_Node_Id) is begin pragma Assert (Present (Node) and then In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration); In_Tree.Project_Nodes.Table (Node).Field1 := To; end Set_Project_Of_Renamed_Package_Of; ------------------------- -- Set_Source_Index_Of -- ------------------------- procedure Set_Source_Index_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Int) is begin pragma Assert (Present (Node) and then (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String or else In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration)); In_Tree.Project_Nodes.Table (Node).Src_Index := To; end Set_Source_Index_Of; ------------------------ -- Set_String_Type_Of -- ------------------------ procedure Set_String_Type_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Project_Node_Id) is begin pragma Assert (Present (Node) and then (In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference or else In_Tree.Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration) and then In_Tree.Project_Nodes.Table (To).Kind = N_String_Type_Declaration); if In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference then In_Tree.Project_Nodes.Table (Node).Field3 := To; else In_Tree.Project_Nodes.Table (Node).Field2 := To; end if; end Set_String_Type_Of; ------------------------- -- Set_String_Value_Of -- ------------------------- procedure Set_String_Value_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; To : Name_Id) is begin pragma Assert (Present (Node) and then (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause or else In_Tree.Project_Nodes.Table (Node).Kind = N_Comment or else In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String)); In_Tree.Project_Nodes.Table (Node).Value := To; end Set_String_Value_Of; --------------------- -- Source_Index_Of -- --------------------- function Source_Index_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Int is begin pragma Assert (Present (Node) and then (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String or else In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration)); return In_Tree.Project_Nodes.Table (Node).Src_Index; end Source_Index_Of; -------------------- -- String_Type_Of -- -------------------- function String_Type_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is begin pragma Assert (Present (Node) and then (In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference or else In_Tree.Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration)); if In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference then return In_Tree.Project_Nodes.Table (Node).Field3; else return In_Tree.Project_Nodes.Table (Node).Field2; end if; end String_Type_Of; --------------------- -- String_Value_Of -- --------------------- function String_Value_Of (Node : Project_Node_Id; In_Tree : Project_Node_Tree_Ref) return Name_Id is begin pragma Assert (Present (Node) and then (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause or else In_Tree.Project_Nodes.Table (Node).Kind = N_Comment or else In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String)); return In_Tree.Project_Nodes.Table (Node).Value; end String_Value_Of; -------------------- -- Value_Is_Valid -- -------------------- function Value_Is_Valid (For_Typed_Variable : Project_Node_Id; In_Tree : Project_Node_Tree_Ref; Value : Name_Id) return Boolean is begin pragma Assert (Present (For_Typed_Variable) and then (In_Tree.Project_Nodes.Table (For_Typed_Variable).Kind = N_Typed_Variable_Declaration)); declare Current_String : Project_Node_Id := First_Literal_String (String_Type_Of (For_Typed_Variable, In_Tree), In_Tree); begin while Present (Current_String) and then String_Value_Of (Current_String, In_Tree) /= Value loop Current_String := Next_Literal_String (Current_String, In_Tree); end loop; return Present (Current_String); end; end Value_Is_Valid; ------------------------------- -- There_Are_Unkept_Comments -- ------------------------------- function There_Are_Unkept_Comments return Boolean is begin return Unkept_Comments; end There_Are_Unkept_Comments; -------------------- -- Create_Project -- -------------------- function Create_Project (In_Tree : Project_Node_Tree_Ref; Name : Name_Id; Full_Path : Path_Name_Type; Is_Config_File : Boolean := False) return Project_Node_Id is Project : Project_Node_Id; Qualifier : Project_Qualifier := Unspecified; begin Project := Default_Project_Node (In_Tree, N_Project); Set_Name_Of (Project, In_Tree, Name); Set_Directory_Of (Project, In_Tree, Path_Name_Type (Get_Directory (File_Name_Type (Full_Path)))); Set_Path_Name_Of (Project, In_Tree, Full_Path); Set_Project_Declaration_Of (Project, In_Tree, Default_Project_Node (In_Tree, N_Project_Declaration)); if Is_Config_File then Qualifier := Configuration; end if; if not Is_Config_File then Prj.Tree.Tree_Private_Part.Projects_Htable.Set (In_Tree.Projects_HT, Name, Prj.Tree.Tree_Private_Part.Project_Name_And_Node' (Name => Name, Display_Name => Name, Canonical_Path => No_Path, Node => Project, Extended => False, Proj_Qualifier => Qualifier)); end if; return Project; end Create_Project; ---------------- -- Add_At_End -- ---------------- procedure Add_At_End (Tree : Project_Node_Tree_Ref; Parent : Project_Node_Id; Expr : Project_Node_Id; Add_Before_First_Pkg : Boolean := False; Add_Before_First_Case : Boolean := False) is Real_Parent : Project_Node_Id; New_Decl, Decl, Next : Project_Node_Id; Last, L : Project_Node_Id; begin if Kind_Of (Expr, Tree) /= N_Declarative_Item then New_Decl := Default_Project_Node (Tree, N_Declarative_Item); Set_Current_Item_Node (New_Decl, Tree, Expr); else New_Decl := Expr; end if; if Kind_Of (Parent, Tree) = N_Project then Real_Parent := Project_Declaration_Of (Parent, Tree); else Real_Parent := Parent; end if; Decl := First_Declarative_Item_Of (Real_Parent, Tree); if Decl = Empty_Node then Set_First_Declarative_Item_Of (Real_Parent, Tree, New_Decl); else loop Next := Next_Declarative_Item (Decl, Tree); exit when Next = Empty_Node or else (Add_Before_First_Pkg and then Kind_Of (Current_Item_Node (Next, Tree), Tree) = N_Package_Declaration) or else (Add_Before_First_Case and then Kind_Of (Current_Item_Node (Next, Tree), Tree) = N_Case_Construction); Decl := Next; end loop; -- In case Expr is in fact a range of declarative items Last := New_Decl; loop L := Next_Declarative_Item (Last, Tree); exit when L = Empty_Node; Last := L; end loop; -- In case Expr is in fact a range of declarative items Last := New_Decl; loop L := Next_Declarative_Item (Last, Tree); exit when L = Empty_Node; Last := L; end loop; Set_Next_Declarative_Item (Last, Tree, Next); Set_Next_Declarative_Item (Decl, Tree, New_Decl); end if; end Add_At_End; --------------------------- -- Create_Literal_String -- --------------------------- function Create_Literal_String (Str : Namet.Name_Id; Tree : Project_Node_Tree_Ref) return Project_Node_Id is Node : Project_Node_Id; begin Node := Default_Project_Node (Tree, N_Literal_String, Prj.Single); Set_Next_Literal_String (Node, Tree, Empty_Node); Set_String_Value_Of (Node, Tree, Str); return Node; end Create_Literal_String; --------------------------- -- Enclose_In_Expression -- --------------------------- function Enclose_In_Expression (Node : Project_Node_Id; Tree : Project_Node_Tree_Ref) return Project_Node_Id is Expr : Project_Node_Id; begin if Kind_Of (Node, Tree) /= N_Expression then Expr := Default_Project_Node (Tree, N_Expression, Single); Set_First_Term (Expr, Tree, Default_Project_Node (Tree, N_Term, Single)); Set_Current_Term (First_Term (Expr, Tree), Tree, Node); return Expr; else return Node; end if; end Enclose_In_Expression; -------------------- -- Create_Package -- -------------------- function Create_Package (Tree : Project_Node_Tree_Ref; Project : Project_Node_Id; Pkg : String) return Project_Node_Id is Pack : Project_Node_Id; N : Name_Id; begin Name_Len := Pkg'Length; Name_Buffer (1 .. Name_Len) := Pkg; N := Name_Find; -- Check if the package already exists Pack := First_Package_Of (Project, Tree); while Pack /= Empty_Node loop if Prj.Tree.Name_Of (Pack, Tree) = N then return Pack; end if; Pack := Next_Package_In_Project (Pack, Tree); end loop; -- Create the package and add it to the declarative item Pack := Default_Project_Node (Tree, N_Package_Declaration); Set_Name_Of (Pack, Tree, N); -- Find the correct package id to use Set_Package_Id_Of (Pack, Tree, Package_Node_Id_Of (N)); -- Add it to the list of packages Set_Next_Package_In_Project (Pack, Tree, First_Package_Of (Project, Tree)); Set_First_Package_Of (Project, Tree, Pack); Add_At_End (Tree, Project_Declaration_Of (Project, Tree), Pack); return Pack; end Create_Package; ---------------------- -- Create_Attribute -- ---------------------- function Create_Attribute (Tree : Project_Node_Tree_Ref; Prj_Or_Pkg : Project_Node_Id; Name : Name_Id; Index_Name : Name_Id := No_Name; Kind : Variable_Kind := List; At_Index : Integer := 0; Value : Project_Node_Id := Empty_Node) return Project_Node_Id is Node : constant Project_Node_Id := Default_Project_Node (Tree, N_Attribute_Declaration, Kind); Case_Insensitive : Boolean; Pkg : Package_Node_Id; Start_At : Attribute_Node_Id; Expr : Project_Node_Id; begin Set_Name_Of (Node, Tree, Name); if Index_Name /= No_Name then Set_Associative_Array_Index_Of (Node, Tree, Index_Name); end if; if Prj_Or_Pkg /= Empty_Node then Add_At_End (Tree, Prj_Or_Pkg, Node); end if; -- Find out the case sensitivity of the attribute if Prj_Or_Pkg /= Empty_Node and then Kind_Of (Prj_Or_Pkg, Tree) = N_Package_Declaration then Pkg := Prj.Attr.Package_Node_Id_Of (Name_Of (Prj_Or_Pkg, Tree)); Start_At := First_Attribute_Of (Pkg); else Start_At := Attribute_First; end if; Start_At := Attribute_Node_Id_Of (Name, Start_At); Case_Insensitive := Attribute_Kind_Of (Start_At) = Case_Insensitive_Associative_Array; Tree.Project_Nodes.Table (Node).Flag1 := Case_Insensitive; if At_Index /= 0 then if Attribute_Kind_Of (Start_At) = Optional_Index_Associative_Array or else Attribute_Kind_Of (Start_At) = Optional_Index_Case_Insensitive_Associative_Array then -- Results in: for Name ("index" at index) use "value"; -- This is currently only used for executables. Set_Source_Index_Of (Node, Tree, To => Int (At_Index)); else -- Results in: for Name ("index") use "value" at index; -- ??? This limitation makes no sense, we should be able to -- set the source index on an expression. pragma Assert (Kind_Of (Value, Tree) = N_Literal_String); Set_Source_Index_Of (Value, Tree, To => Int (At_Index)); end if; end if; if Value /= Empty_Node then Expr := Enclose_In_Expression (Value, Tree); Set_Expression_Of (Node, Tree, Expr); end if; return Node; end Create_Attribute; end Prj.Tree;
Go to most recent revision | Compare with Previous | Blame | View Log