gcc/ada/prj-tree.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             P R J . T R E E                              --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2001-2013, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 with Osint;   use Osint;
  27 with Prj.Env; use Prj.Env;
  28 with Prj.Err;
  29
  30 with Ada.Unchecked_Deallocation;
  31
  32 package body Prj.Tree is
  33
  34    Node_With_Comments : constant array (Project_Node_Kind) of Boolean :=
  35      (N_Project                    => True,
  36       N_With_Clause                => True,
  37       N_Project_Declaration        => False,
  38       N_Declarative_Item           => False,
  39       N_Package_Declaration        => True,
  40       N_String_Type_Declaration    => True,
  41       N_Literal_String             => False,
  42       N_Attribute_Declaration      => True,
  43       N_Typed_Variable_Declaration => True,
  44       N_Variable_Declaration       => True,
  45       N_Expression                 => False,
  46       N_Term                       => False,
  47       N_Literal_String_List        => False,
  48       N_Variable_Reference         => False,
  49       N_External_Value             => False,
  50       N_Attribute_Reference        => False,
  51       N_Case_Construction          => True,
  52       N_Case_Item                  => True,
  53       N_Comment_Zones              => True,
  54       N_Comment                    => True);
  55    --  Indicates the kinds of node that may have associated comments
  56
  57    package Next_End_Nodes is new Table.Table
  58      (Table_Component_Type => Project_Node_Id,
  59       Table_Index_Type     => Natural,
  60       Table_Low_Bound      => 1,
  61       Table_Initial        => 10,
  62       Table_Increment      => 100,
  63       Table_Name           => "Next_End_Nodes");
  64    --  A stack of nodes to indicates to what node the next "end" is associated
  65
  66    use Tree_Private_Part;
  67
  68    End_Of_Line_Node   : Project_Node_Id := Empty_Node;
  69    --  The node an end of line comment may be associated with
  70
  71    Previous_Line_Node : Project_Node_Id := Empty_Node;
  72    --  The node an immediately following comment may be associated with
  73
  74    Previous_End_Node  : Project_Node_Id := Empty_Node;
  75    --  The node comments immediately following an "end" line may be
  76    --  associated with.
  77
  78    Unkept_Comments    : Boolean := False;
  79    --  Set to True when some comments may not be associated with any node
  80
  81    function Comment_Zones_Of
  82      (Node    : Project_Node_Id;
  83       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
  84    --  Returns the ID of the N_Comment_Zones node associated with node Node.
  85    --  If there is not already an N_Comment_Zones node, create one and
  86    --  associate it with node Node.
  87
  88    ------------------
  89    -- Add_Comments --
  90    ------------------
  91
  92    procedure Add_Comments
  93      (To       : Project_Node_Id;
  94       In_Tree  : Project_Node_Tree_Ref;
  95       Where    : Comment_Location) is
  96       Zone     : Project_Node_Id := Empty_Node;
  97       Previous : Project_Node_Id := Empty_Node;
  98
  99    begin
 100       pragma Assert
 101         (Present (To)
 102           and then In_Tree.Project_Nodes.Table (To).Kind /= N_Comment);
 103
 104       Zone := In_Tree.Project_Nodes.Table (To).Comments;
 105
 106       if No (Zone) then
 107
 108          --  Create new N_Comment_Zones node
 109
 110          Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
 111          In_Tree.Project_Nodes.Table
 112            (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
 113            (Kind      => N_Comment_Zones,
 114             Qualifier => Unspecified,
 115             Expr_Kind => Undefined,
 116             Location  => No_Location,
 117             Directory => No_Path,
 118             Variables => Empty_Node,
 119             Packages  => Empty_Node,
 120             Pkg_Id    => Empty_Package,
 121             Name      => No_Name,
 122             Src_Index => 0,
 123             Path_Name => No_Path,
 124             Value     => No_Name,
 125             Field1    => Empty_Node,
 126             Field2    => Empty_Node,
 127             Field3    => Empty_Node,
 128             Field4    => Empty_Node,
 129             Flag1     => False,
 130             Flag2     => False,
 131             Comments  => Empty_Node);
 132
 133          Zone := Project_Node_Table.Last (In_Tree.Project_Nodes);
 134          In_Tree.Project_Nodes.Table (To).Comments := Zone;
 135       end if;
 136
 137       if Where = End_Of_Line then
 138          In_Tree.Project_Nodes.Table (Zone).Value := Comments.Table (1).Value;
 139
 140       else
 141          --  Get each comments in the Comments table and link them to node To
 142
 143          for J in 1 .. Comments.Last loop
 144
 145             --  Create new N_Comment node
 146
 147             if (Where = After or else Where = After_End)
 148               and then Token /= Tok_EOF
 149               and then Comments.Table (J).Follows_Empty_Line
 150             then
 151                Comments.Table (1 .. Comments.Last - J + 1) :=
 152                  Comments.Table (J .. Comments.Last);
 153                Comments.Set_Last (Comments.Last - J + 1);
 154                return;
 155             end if;
 156
 157             Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
 158             In_Tree.Project_Nodes.Table
 159               (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
 160               (Kind             => N_Comment,
 161                Qualifier        => Unspecified,
 162                Expr_Kind        => Undefined,
 163                Flag1            => Comments.Table (J).Follows_Empty_Line,
 164                Flag2            =>
 165                  Comments.Table (J).Is_Followed_By_Empty_Line,
 166                Location         => No_Location,
 167                Directory        => No_Path,
 168                Variables        => Empty_Node,
 169                Packages         => Empty_Node,
 170                Pkg_Id           => Empty_Package,
 171                Name             => No_Name,
 172                Src_Index        => 0,
 173                Path_Name        => No_Path,
 174                Value            => Comments.Table (J).Value,
 175                Field1           => Empty_Node,
 176                Field2           => Empty_Node,
 177                Field3           => Empty_Node,
 178                Field4           => Empty_Node,
 179                Comments         => Empty_Node);
 180
 181             --  If this is the first comment, put it in the right field of
 182             --  the node Zone.
 183
 184             if No (Previous) then
 185                case Where is
 186                   when Before =>
 187                      In_Tree.Project_Nodes.Table (Zone).Field1 :=
 188                        Project_Node_Table.Last (In_Tree.Project_Nodes);
 189
 190                   when After =>
 191                      In_Tree.Project_Nodes.Table (Zone).Field2 :=
 192                        Project_Node_Table.Last (In_Tree.Project_Nodes);
 193
 194                   when Before_End =>
 195                      In_Tree.Project_Nodes.Table (Zone).Field3 :=
 196                        Project_Node_Table.Last (In_Tree.Project_Nodes);
 197
 198                   when After_End =>
 199                      In_Tree.Project_Nodes.Table (Zone).Comments :=
 200                        Project_Node_Table.Last (In_Tree.Project_Nodes);
 201
 202                   when End_Of_Line =>
 203                      null;
 204                end case;
 205
 206             else
 207                --  When it is not the first, link it to the previous one
 208
 209                In_Tree.Project_Nodes.Table (Previous).Comments :=
 210                  Project_Node_Table.Last (In_Tree.Project_Nodes);
 211             end if;
 212
 213             --  This node becomes the previous one for the next comment, if
 214             --  there is one.
 215
 216             Previous := Project_Node_Table.Last (In_Tree.Project_Nodes);
 217          end loop;
 218       end if;
 219
 220       --  Empty the Comments table, so that there is no risk to link the same
 221       --  comments to another node.
 222
 223       Comments.Set_Last (0);
 224    end Add_Comments;
 225
 226    --------------------------------
 227    -- Associative_Array_Index_Of --
 228    --------------------------------
 229
 230    function Associative_Array_Index_Of
 231      (Node    : Project_Node_Id;
 232       In_Tree : Project_Node_Tree_Ref) return Name_Id
 233    is
 234    begin
 235       pragma Assert
 236         (Present (Node)
 237           and then
 238             (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
 239                or else
 240              In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
 241       return In_Tree.Project_Nodes.Table (Node).Value;
 242    end Associative_Array_Index_Of;
 243
 244    ----------------------------
 245    -- Associative_Package_Of --
 246    ----------------------------
 247
 248    function Associative_Package_Of
 249      (Node    : Project_Node_Id;
 250       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
 251    is
 252    begin
 253       pragma Assert
 254         (Present (Node)
 255           and then
 256           (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration));
 257       return In_Tree.Project_Nodes.Table (Node).Field3;
 258    end Associative_Package_Of;
 259
 260    ----------------------------
 261    -- Associative_Project_Of --
 262    ----------------------------
 263
 264    function Associative_Project_Of
 265      (Node    : Project_Node_Id;
 266       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
 267    is
 268    begin
 269       pragma Assert
 270         (Present (Node)
 271           and then
 272           (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration));
 273       return In_Tree.Project_Nodes.Table (Node).Field2;
 274    end Associative_Project_Of;
 275
 276    ----------------------
 277    -- Case_Insensitive --
 278    ----------------------
 279
 280    function Case_Insensitive
 281      (Node    : Project_Node_Id;
 282       In_Tree : Project_Node_Tree_Ref) return Boolean
 283    is
 284    begin
 285       pragma Assert
 286         (Present (Node)
 287           and then
 288             (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
 289                or else
 290              In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
 291       return In_Tree.Project_Nodes.Table (Node).Flag1;
 292    end Case_Insensitive;
 293
 294    --------------------------------
 295    -- Case_Variable_Reference_Of --
 296    --------------------------------
 297
 298    function Case_Variable_Reference_Of
 299      (Node    : Project_Node_Id;
 300       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
 301    is
 302    begin
 303       pragma Assert
 304         (Present (Node)
 305           and then
 306             In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
 307       return In_Tree.Project_Nodes.Table (Node).Field1;
 308    end Case_Variable_Reference_Of;
 309
 310    ----------------------
 311    -- Comment_Zones_Of --
 312    ----------------------
 313
 314    function Comment_Zones_Of
 315      (Node    : Project_Node_Id;
 316       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
 317    is
 318       Zone : Project_Node_Id;
 319
 320    begin
 321       pragma Assert (Present (Node));
 322       Zone := In_Tree.Project_Nodes.Table (Node).Comments;
 323
 324       --  If there is not already an N_Comment_Zones associated, create a new
 325       --  one and associate it with node Node.
 326
 327       if No (Zone) then
 328          Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
 329          Zone := Project_Node_Table.Last (In_Tree.Project_Nodes);
 330          In_Tree.Project_Nodes.Table (Zone) :=
 331         (Kind             => N_Comment_Zones,
 332          Qualifier        => Unspecified,
 333          Location         => No_Location,
 334          Directory        => No_Path,
 335          Expr_Kind        => Undefined,
 336          Variables        => Empty_Node,
 337          Packages         => Empty_Node,
 338          Pkg_Id           => Empty_Package,
 339          Name             => No_Name,
 340          Src_Index        => 0,
 341          Path_Name        => No_Path,
 342          Value            => No_Name,
 343          Field1           => Empty_Node,
 344          Field2           => Empty_Node,
 345          Field3           => Empty_Node,
 346          Field4           => Empty_Node,
 347          Flag1            => False,
 348          Flag2            => False,
 349          Comments         => Empty_Node);
 350          In_Tree.Project_Nodes.Table (Node).Comments := Zone;
 351       end if;
 352
 353       return Zone;
 354    end Comment_Zones_Of;
 355
 356    -----------------------
 357    -- Current_Item_Node --
 358    -----------------------
 359
 360    function Current_Item_Node
 361      (Node    : Project_Node_Id;
 362       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
 363    is
 364    begin
 365       pragma Assert
 366         (Present (Node)
 367           and then
 368             In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
 369       return In_Tree.Project_Nodes.Table (Node).Field1;
 370    end Current_Item_Node;
 371
 372    ------------------
 373    -- Current_Term --
 374    ------------------
 375
 376    function Current_Term
 377      (Node    : Project_Node_Id;
 378       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
 379    is
 380    begin
 381       pragma Assert
 382         (Present (Node)
 383           and then
 384             In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
 385       return In_Tree.Project_Nodes.Table (Node).Field1;
 386    end Current_Term;
 387
 388    --------------------------
 389    -- Default_Project_Node --
 390    --------------------------
 391
 392    function Default_Project_Node
 393      (In_Tree       : Project_Node_Tree_Ref;
 394       Of_Kind       : Project_Node_Kind;
 395       And_Expr_Kind : Variable_Kind := Undefined) return Project_Node_Id
 396    is
 397       Result   : Project_Node_Id;
 398       Zone     : Project_Node_Id;
 399       Previous : Project_Node_Id;
 400
 401    begin
 402       --  Create new node with specified kind and expression kind
 403
 404       Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
 405       In_Tree.Project_Nodes.Table
 406         (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
 407         (Kind             => Of_Kind,
 408          Qualifier        => Unspecified,
 409          Location         => No_Location,
 410          Directory        => No_Path,
 411          Expr_Kind        => And_Expr_Kind,
 412          Variables        => Empty_Node,
 413          Packages         => Empty_Node,
 414          Pkg_Id           => Empty_Package,
 415          Name             => No_Name,
 416          Src_Index        => 0,
 417          Path_Name        => No_Path,
 418          Value            => No_Name,
 419          Field1           => Empty_Node,
 420          Field2           => Empty_Node,
 421          Field3           => Empty_Node,
 422          Field4           => Empty_Node,
 423          Flag1            => False,
 424          Flag2            => False,
 425          Comments         => Empty_Node);
 426
 427       --  Save the new node for the returned value
 428
 429       Result := Project_Node_Table.Last (In_Tree.Project_Nodes);
 430
 431       if Comments.Last > 0 then
 432
 433          --  If this is not a node with comments, then set the flag
 434
 435          if not Node_With_Comments (Of_Kind) then
 436             Unkept_Comments := True;
 437
 438          elsif Of_Kind /= N_Comment and then Of_Kind /= N_Comment_Zones then
 439
 440             Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
 441             In_Tree.Project_Nodes.Table
 442               (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
 443               (Kind             => N_Comment_Zones,
 444                Qualifier        => Unspecified,
 445                Expr_Kind        => Undefined,
 446                Location         => No_Location,
 447                Directory        => No_Path,
 448                Variables        => Empty_Node,
 449                Packages         => Empty_Node,
 450                Pkg_Id           => Empty_Package,
 451                Name             => No_Name,
 452                Src_Index        => 0,
 453                Path_Name        => No_Path,
 454                Value            => No_Name,
 455                Field1           => Empty_Node,
 456                Field2           => Empty_Node,
 457                Field3           => Empty_Node,
 458                Field4           => Empty_Node,
 459                Flag1            => False,
 460                Flag2            => False,
 461                Comments         => Empty_Node);
 462
 463             Zone := Project_Node_Table.Last (In_Tree.Project_Nodes);
 464             In_Tree.Project_Nodes.Table (Result).Comments := Zone;
 465             Previous := Empty_Node;
 466
 467             for J in 1 .. Comments.Last loop
 468
 469                --  Create a new N_Comment node
 470
 471                Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
 472                In_Tree.Project_Nodes.Table
 473                  (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
 474                  (Kind             => N_Comment,
 475                   Qualifier        => Unspecified,
 476                   Expr_Kind        => Undefined,
 477                   Flag1            => Comments.Table (J).Follows_Empty_Line,
 478                   Flag2            =>
 479                     Comments.Table (J).Is_Followed_By_Empty_Line,
 480                   Location         => No_Location,
 481                   Directory        => No_Path,
 482                   Variables        => Empty_Node,
 483                   Packages         => Empty_Node,
 484                   Pkg_Id           => Empty_Package,
 485                   Name             => No_Name,
 486                   Src_Index        => 0,
 487                   Path_Name        => No_Path,
 488                   Value            => Comments.Table (J).Value,
 489                   Field1           => Empty_Node,
 490                   Field2           => Empty_Node,
 491                   Field3           => Empty_Node,
 492                   Field4           => Empty_Node,
 493                   Comments         => Empty_Node);
 494
 495                --  Link it to the N_Comment_Zones node, if it is the first,
 496                --  otherwise to the previous one.
 497
 498                if No (Previous) then
 499                   In_Tree.Project_Nodes.Table (Zone).Field1 :=
 500                     Project_Node_Table.Last (In_Tree.Project_Nodes);
 501
 502                else
 503                   In_Tree.Project_Nodes.Table (Previous).Comments :=
 504                     Project_Node_Table.Last (In_Tree.Project_Nodes);
 505                end if;
 506
 507                --  This new node will be the previous one for the next
 508                --  N_Comment node, if there is one.
 509
 510                Previous := Project_Node_Table.Last (In_Tree.Project_Nodes);
 511             end loop;
 512
 513             --  Empty the Comments table after all comments have been processed
 514
 515             Comments.Set_Last (0);
 516          end if;
 517       end if;
 518
 519       return Result;
 520    end Default_Project_Node;
 521
 522    ------------------
 523    -- Directory_Of --
 524    ------------------
 525
 526    function Directory_Of
 527      (Node    : Project_Node_Id;
 528       In_Tree : Project_Node_Tree_Ref) return Path_Name_Type
 529    is
 530    begin
 531       pragma Assert
 532         (Present (Node)
 533           and then
 534             In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
 535       return In_Tree.Project_Nodes.Table (Node).Directory;
 536    end Directory_Of;
 537
 538    -------------------------
 539    -- End_Of_Line_Comment --
 540    -------------------------
 541
 542    function End_Of_Line_Comment
 543      (Node    : Project_Node_Id;
 544       In_Tree : Project_Node_Tree_Ref) return Name_Id
 545    is
 546       Zone : Project_Node_Id := Empty_Node;
 547
 548    begin
 549       pragma Assert (Present (Node));
 550       Zone := In_Tree.Project_Nodes.Table (Node).Comments;
 551
 552       if No (Zone) then
 553          return No_Name;
 554       else
 555          return In_Tree.Project_Nodes.Table (Zone).Value;
 556       end if;
 557    end End_Of_Line_Comment;
 558
 559    ------------------------
 560    -- Expression_Kind_Of --
 561    ------------------------
 562
 563    function Expression_Kind_Of
 564      (Node    : Project_Node_Id;
 565       In_Tree : Project_Node_Tree_Ref) return Variable_Kind
 566    is
 567    begin
 568       pragma Assert
 569         (Present (Node)
 570            and then -- should use Nkind_In here ??? why not???
 571              (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
 572                 or else
 573               In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
 574                 or else
 575               In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Declaration
 576                 or else
 577               In_Tree.Project_Nodes.Table (Node).Kind =
 578                                                   N_Typed_Variable_Declaration
 579                 or else
 580               In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration
 581                 or else
 582               In_Tree.Project_Nodes.Table (Node).Kind = N_Expression
 583                 or else
 584               In_Tree.Project_Nodes.Table (Node).Kind = N_Term
 585                 or else
 586               In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
 587                 or else
 588               In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference
 589                 or else
 590               In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value));
 591       return In_Tree.Project_Nodes.Table (Node).Expr_Kind;
 592    end Expression_Kind_Of;
 593
 594    -------------------
 595    -- Expression_Of --
 596    -------------------
 597
 598    function Expression_Of
 599      (Node    : Project_Node_Id;
 600       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
 601    is
 602    begin
 603       pragma Assert
 604         (Present (Node)
 605           and then
 606            (In_Tree.Project_Nodes.Table (Node).Kind =
 607               N_Attribute_Declaration
 608                or else
 609             In_Tree.Project_Nodes.Table (Node).Kind =
 610               N_Typed_Variable_Declaration
 611                or else
 612             In_Tree.Project_Nodes.Table (Node).Kind =
 613               N_Variable_Declaration));
 614
 615       return In_Tree.Project_Nodes.Table (Node).Field1;
 616    end Expression_Of;
 617
 618    -------------------------
 619    -- Extended_Project_Of --
 620    -------------------------
 621
 622    function Extended_Project_Of
 623      (Node    : Project_Node_Id;
 624       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
 625    is
 626    begin
 627       pragma Assert
 628         (Present (Node)
 629           and then
 630             In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
 631       return In_Tree.Project_Nodes.Table (Node).Field2;
 632    end Extended_Project_Of;
 633
 634    ------------------------------
 635    -- Extended_Project_Path_Of --
 636    ------------------------------
 637
 638    function Extended_Project_Path_Of
 639      (Node    : Project_Node_Id;
 640       In_Tree : Project_Node_Tree_Ref) return Path_Name_Type
 641    is
 642    begin
 643       pragma Assert
 644         (Present (Node)
 645           and then
 646             In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
 647       return Path_Name_Type (In_Tree.Project_Nodes.Table (Node).Value);
 648    end Extended_Project_Path_Of;
 649
 650    --------------------------
 651    -- Extending_Project_Of --
 652    --------------------------
 653    function Extending_Project_Of
 654      (Node    : Project_Node_Id;
 655       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
 656    is
 657    begin
 658       pragma Assert
 659         (Present (Node)
 660           and then
 661             In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
 662       return In_Tree.Project_Nodes.Table (Node).Field3;
 663    end Extending_Project_Of;
 664
 665    ---------------------------
 666    -- External_Reference_Of --
 667    ---------------------------
 668
 669    function External_Reference_Of
 670      (Node    : Project_Node_Id;
 671       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
 672    is
 673    begin
 674       pragma Assert
 675         (Present (Node)
 676           and then
 677             In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
 678       return In_Tree.Project_Nodes.Table (Node).Field1;
 679    end External_Reference_Of;
 680
 681    -------------------------
 682    -- External_Default_Of --
 683    -------------------------
 684
 685    function External_Default_Of
 686      (Node    : Project_Node_Id;
 687       In_Tree : Project_Node_Tree_Ref)
 688       return Project_Node_Id
 689    is
 690    begin
 691       pragma Assert
 692         (Present (Node)
 693           and then
 694             In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
 695       return In_Tree.Project_Nodes.Table (Node).Field2;
 696    end External_Default_Of;
 697
 698    ------------------------
 699    -- First_Case_Item_Of --
 700    ------------------------
 701
 702    function First_Case_Item_Of
 703      (Node    : Project_Node_Id;
 704       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
 705    is
 706    begin
 707       pragma Assert
 708         (Present (Node)
 709           and then
 710             In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
 711       return In_Tree.Project_Nodes.Table (Node).Field2;
 712    end First_Case_Item_Of;
 713
 714    ---------------------
 715    -- First_Choice_Of --
 716    ---------------------
 717
 718    function First_Choice_Of
 719      (Node    : Project_Node_Id;
 720       In_Tree : Project_Node_Tree_Ref)
 721       return Project_Node_Id
 722    is
 723    begin
 724       pragma Assert
 725         (Present (Node)
 726           and then
 727             In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
 728       return In_Tree.Project_Nodes.Table (Node).Field1;
 729    end First_Choice_Of;
 730
 731    -------------------------
 732    -- First_Comment_After --
 733    -------------------------
 734
 735    function First_Comment_After
 736      (Node    : Project_Node_Id;
 737       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
 738    is
 739       Zone : Project_Node_Id := Empty_Node;
 740    begin
 741       pragma Assert (Present (Node));
 742       Zone := In_Tree.Project_Nodes.Table (Node).Comments;
 743
 744       if No (Zone) then
 745          return Empty_Node;
 746
 747       else
 748          return In_Tree.Project_Nodes.Table (Zone).Field2;
 749       end if;
 750    end First_Comment_After;
 751
 752    -----------------------------
 753    -- First_Comment_After_End --
 754    -----------------------------
 755
 756    function First_Comment_After_End
 757      (Node    : Project_Node_Id;
 758       In_Tree : Project_Node_Tree_Ref)
 759       return Project_Node_Id
 760    is
 761       Zone : Project_Node_Id := Empty_Node;
 762
 763    begin
 764       pragma Assert (Present (Node));
 765       Zone := In_Tree.Project_Nodes.Table (Node).Comments;
 766
 767       if No (Zone) then
 768          return Empty_Node;
 769
 770       else
 771          return In_Tree.Project_Nodes.Table (Zone).Comments;
 772       end if;
 773    end First_Comment_After_End;
 774
 775    --------------------------
 776    -- First_Comment_Before --
 777    --------------------------
 778
 779    function First_Comment_Before
 780      (Node    : Project_Node_Id;
 781       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
 782    is
 783       Zone : Project_Node_Id := Empty_Node;
 784
 785    begin
 786       pragma Assert (Present (Node));
 787       Zone := In_Tree.Project_Nodes.Table (Node).Comments;
 788
 789       if No (Zone) then
 790          return Empty_Node;
 791
 792       else
 793          return In_Tree.Project_Nodes.Table (Zone).Field1;
 794       end if;
 795    end First_Comment_Before;
 796
 797    ------------------------------
 798    -- First_Comment_Before_End --
 799    ------------------------------
 800
 801    function First_Comment_Before_End
 802      (Node    : Project_Node_Id;
 803       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
 804    is
 805       Zone : Project_Node_Id := Empty_Node;
 806
 807    begin
 808       pragma Assert (Present (Node));
 809       Zone := In_Tree.Project_Nodes.Table (Node).Comments;
 810
 811       if No (Zone) then
 812          return Empty_Node;
 813
 814       else
 815          return In_Tree.Project_Nodes.Table (Zone).Field3;
 816       end if;
 817    end First_Comment_Before_End;
 818
 819    -------------------------------
 820    -- First_Declarative_Item_Of --
 821    -------------------------------
 822
 823    function First_Declarative_Item_Of
 824      (Node    : Project_Node_Id;
 825       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
 826    is
 827    begin
 828       pragma Assert
 829         (Present (Node)
 830           and then
 831             (In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration
 832                or else
 833              In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item
 834                or else
 835              In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration));
 836
 837       if In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration then
 838          return In_Tree.Project_Nodes.Table (Node).Field1;
 839       else
 840          return In_Tree.Project_Nodes.Table (Node).Field2;
 841       end if;
 842    end First_Declarative_Item_Of;
 843
 844    ------------------------------
 845    -- First_Expression_In_List --
 846    ------------------------------
 847
 848    function First_Expression_In_List
 849      (Node    : Project_Node_Id;
 850       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
 851    is
 852    begin
 853       pragma Assert
 854         (Present (Node)
 855           and then
 856             In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String_List);
 857       return In_Tree.Project_Nodes.Table (Node).Field1;
 858    end First_Expression_In_List;
 859
 860    --------------------------
 861    -- First_Literal_String --
 862    --------------------------
 863
 864    function First_Literal_String
 865      (Node    : Project_Node_Id;
 866       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
 867    is
 868    begin
 869       pragma Assert
 870         (Present (Node)
 871           and then
 872          In_Tree.Project_Nodes.Table (Node).Kind =
 873            N_String_Type_Declaration);
 874       return In_Tree.Project_Nodes.Table (Node).Field1;
 875    end First_Literal_String;
 876
 877    ----------------------
 878    -- First_Package_Of --
 879    ----------------------
 880
 881    function First_Package_Of
 882      (Node    : Project_Node_Id;
 883       In_Tree : Project_Node_Tree_Ref) return Package_Declaration_Id
 884    is
 885    begin
 886       pragma Assert
 887         (Present (Node)
 888           and then
 889             In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
 890       return In_Tree.Project_Nodes.Table (Node).Packages;
 891    end First_Package_Of;
 892
 893    --------------------------
 894    -- First_String_Type_Of --
 895    --------------------------
 896
 897    function First_String_Type_Of
 898      (Node    : Project_Node_Id;
 899       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
 900    is
 901    begin
 902       pragma Assert
 903         (Present (Node)
 904           and then
 905             In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
 906       return In_Tree.Project_Nodes.Table (Node).Field3;
 907    end First_String_Type_Of;
 908
 909    ----------------
 910    -- First_Term --
 911    ----------------
 912
 913    function First_Term
 914      (Node    : Project_Node_Id;
 915       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
 916    is
 917    begin
 918       pragma Assert
 919         (Present (Node)
 920           and then
 921             In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
 922       return In_Tree.Project_Nodes.Table (Node).Field1;
 923    end First_Term;
 924
 925    -----------------------
 926    -- First_Variable_Of --
 927    -----------------------
 928
 929    function First_Variable_Of
 930      (Node    : Project_Node_Id;
 931       In_Tree : Project_Node_Tree_Ref) return Variable_Node_Id
 932    is
 933    begin
 934       pragma Assert
 935         (Present (Node)
 936           and then
 937             (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
 938                or else
 939              In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration));
 940
 941       return In_Tree.Project_Nodes.Table (Node).Variables;
 942    end First_Variable_Of;
 943
 944    --------------------------
 945    -- First_With_Clause_Of --
 946    --------------------------
 947
 948    function First_With_Clause_Of
 949      (Node    : Project_Node_Id;
 950       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
 951    is
 952    begin
 953       pragma Assert
 954         (Present (Node)
 955           and then
 956             In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
 957       return In_Tree.Project_Nodes.Table (Node).Field1;
 958    end First_With_Clause_Of;
 959
 960    ------------------------
 961    -- Follows_Empty_Line --
 962    ------------------------
 963
 964    function Follows_Empty_Line
 965      (Node    : Project_Node_Id;
 966       In_Tree : Project_Node_Tree_Ref) return Boolean
 967    is
 968    begin
 969       pragma Assert
 970         (Present (Node)
 971          and then
 972          In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
 973       return In_Tree.Project_Nodes.Table (Node).Flag1;
 974    end Follows_Empty_Line;
 975
 976    ----------
 977    -- Hash --
 978    ----------
 979
 980    function Hash (N : Project_Node_Id) return Header_Num is
 981    begin
 982       return Header_Num (N mod Project_Node_Id (Header_Num'Last));
 983    end Hash;
 984
 985    ----------------
 986    -- Initialize --
 987    ----------------
 988
 989    procedure Initialize (Tree : Project_Node_Tree_Ref) is
 990    begin
 991       Project_Node_Table.Init (Tree.Project_Nodes);
 992       Projects_Htable.Reset (Tree.Projects_HT);
 993    end Initialize;
 994
 995    --------------------
 996    -- Override_Flags --
 997    --------------------
 998
 999    procedure Override_Flags
1000      (Self  : in out Environment;
1001       Flags : Prj.Processing_Flags)
1002    is
1003    begin
1004       Self.Flags := Flags;
1005    end Override_Flags;
1006
1007    ----------------
1008    -- Initialize --
1009    ----------------
1010
1011    procedure Initialize
1012      (Self  : out Environment;
1013       Flags : Processing_Flags)
1014    is
1015    begin
1016       --  Do not reset the external references, in case we are reloading a
1017       --  project, since we want to preserve the current environment. But we
1018       --  still need to ensure that the external references are properly
1019       --  initialized.
1020
1021       Prj.Ext.Initialize (Self.External);
1022
1023       Self.Flags := Flags;
1024    end Initialize;
1025
1026    -------------------------
1027    -- Initialize_And_Copy --
1028    -------------------------
1029
1030    procedure Initialize_And_Copy
1031      (Self      : out Environment;
1032       Copy_From : Environment)
1033    is
1034    begin
1035       Self.Flags := Copy_From.Flags;
1036       Prj.Ext.Initialize (Self.External, Copy_From => Copy_From.External);
1037       Prj.Env.Copy (From => Copy_From.Project_Path, To => Self.Project_Path);
1038    end Initialize_And_Copy;
1039
1040    ----------
1041    -- Free --
1042    ----------
1043
1044    procedure Free (Self : in out Environment) is
1045    begin
1046       Prj.Ext.Free (Self.External);
1047       Free (Self.Project_Path);
1048    end Free;
1049
1050    ----------
1051    -- Free --
1052    ----------
1053
1054    procedure Free (Proj : in out Project_Node_Tree_Ref) is
1055       procedure Unchecked_Free is new Ada.Unchecked_Deallocation
1056         (Project_Node_Tree_Data, Project_Node_Tree_Ref);
1057    begin
1058       if Proj /= null then
1059          Project_Node_Table.Free (Proj.Project_Nodes);
1060          Projects_Htable.Reset (Proj.Projects_HT);
1061          Unchecked_Free (Proj);
1062       end if;
1063    end Free;
1064
1065    -------------------------------
1066    -- Is_Followed_By_Empty_Line --
1067    -------------------------------
1068
1069    function Is_Followed_By_Empty_Line
1070      (Node    : Project_Node_Id;
1071       In_Tree : Project_Node_Tree_Ref) return Boolean
1072    is
1073    begin
1074       pragma Assert
1075         (Present (Node)
1076           and then
1077             In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
1078       return In_Tree.Project_Nodes.Table (Node).Flag2;
1079    end Is_Followed_By_Empty_Line;
1080
1081    ----------------------
1082    -- Is_Extending_All --
1083    ----------------------
1084
1085    function Is_Extending_All
1086      (Node    : Project_Node_Id;
1087       In_Tree : Project_Node_Tree_Ref) return Boolean
1088    is
1089    begin
1090       pragma Assert
1091         (Present (Node)
1092           and then
1093            (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
1094               or else
1095             In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
1096       return In_Tree.Project_Nodes.Table (Node).Flag2;
1097    end Is_Extending_All;
1098
1099    -------------------------
1100    -- Is_Not_Last_In_List --
1101    -------------------------
1102
1103    function Is_Not_Last_In_List
1104      (Node    : Project_Node_Id;
1105       In_Tree : Project_Node_Tree_Ref) return Boolean
1106    is
1107    begin
1108       pragma Assert
1109         (Present (Node)
1110           and then
1111             In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
1112       return In_Tree.Project_Nodes.Table (Node).Flag1;
1113    end Is_Not_Last_In_List;
1114
1115    -------------------------------------
1116    -- Imported_Or_Extended_Project_Of --
1117    -------------------------------------
1118
1119    function Imported_Or_Extended_Project_Of
1120      (Project   : Project_Node_Id;
1121       In_Tree   : Project_Node_Tree_Ref;
1122       With_Name : Name_Id) return Project_Node_Id
1123    is
1124       With_Clause : Project_Node_Id :=
1125         First_With_Clause_Of (Project, In_Tree);
1126       Result      : Project_Node_Id := Empty_Node;
1127
1128    begin
1129       --  First check all the imported projects
1130
1131       while Present (With_Clause) loop
1132
1133          --  Only non limited imported project may be used as prefix
1134          --  of variable or attributes.
1135
1136          Result := Non_Limited_Project_Node_Of (With_Clause, In_Tree);
1137          exit when Present (Result)
1138            and then Name_Of (Result, In_Tree) = With_Name;
1139          With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
1140       end loop;
1141
1142       --  If it is not an imported project, it might be an extended project
1143
1144       if No (With_Clause) then
1145          Result := Project;
1146          loop
1147             Result :=
1148               Extended_Project_Of
1149                 (Project_Declaration_Of (Result, In_Tree), In_Tree);
1150
1151             exit when No (Result)
1152               or else Name_Of (Result, In_Tree) = With_Name;
1153          end loop;
1154       end if;
1155
1156       return Result;
1157    end Imported_Or_Extended_Project_Of;
1158
1159    -------------
1160    -- Kind_Of --
1161    -------------
1162
1163    function Kind_Of
1164      (Node    : Project_Node_Id;
1165       In_Tree : Project_Node_Tree_Ref) return Project_Node_Kind
1166    is
1167    begin
1168       pragma Assert (Present (Node));
1169       return In_Tree.Project_Nodes.Table (Node).Kind;
1170    end Kind_Of;
1171
1172    -----------------
1173    -- Location_Of --
1174    -----------------
1175
1176    function Location_Of
1177      (Node    : Project_Node_Id;
1178       In_Tree : Project_Node_Tree_Ref) return Source_Ptr
1179    is
1180    begin
1181       pragma Assert (Present (Node));
1182       return In_Tree.Project_Nodes.Table (Node).Location;
1183    end Location_Of;
1184
1185    -------------
1186    -- Name_Of --
1187    -------------
1188
1189    function Name_Of
1190      (Node    : Project_Node_Id;
1191       In_Tree : Project_Node_Tree_Ref) return Name_Id
1192    is
1193    begin
1194       pragma Assert (Present (Node));
1195       return In_Tree.Project_Nodes.Table (Node).Name;
1196    end Name_Of;
1197
1198    --------------------
1199    -- Next_Case_Item --
1200    --------------------
1201
1202    function Next_Case_Item
1203      (Node    : Project_Node_Id;
1204       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1205    is
1206    begin
1207       pragma Assert
1208         (Present (Node)
1209           and then
1210             In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
1211       return In_Tree.Project_Nodes.Table (Node).Field3;
1212    end Next_Case_Item;
1213
1214    ------------------
1215    -- Next_Comment --
1216    ------------------
1217
1218    function Next_Comment
1219      (Node    : Project_Node_Id;
1220       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1221    is
1222    begin
1223       pragma Assert
1224         (Present (Node)
1225           and then
1226             In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
1227       return In_Tree.Project_Nodes.Table (Node).Comments;
1228    end Next_Comment;
1229
1230    ---------------------------
1231    -- Next_Declarative_Item --
1232    ---------------------------
1233
1234    function Next_Declarative_Item
1235      (Node    : Project_Node_Id;
1236       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1237    is
1238    begin
1239       pragma Assert
1240         (Present (Node)
1241           and then
1242             In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
1243       return In_Tree.Project_Nodes.Table (Node).Field2;
1244    end Next_Declarative_Item;
1245
1246    -----------------------------
1247    -- Next_Expression_In_List --
1248    -----------------------------
1249
1250    function Next_Expression_In_List
1251      (Node    : Project_Node_Id;
1252       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1253    is
1254    begin
1255       pragma Assert
1256         (Present (Node)
1257           and then
1258             In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
1259       return In_Tree.Project_Nodes.Table (Node).Field2;
1260    end Next_Expression_In_List;
1261
1262    -------------------------
1263    -- Next_Literal_String --
1264    -------------------------
1265
1266    function Next_Literal_String
1267      (Node    : Project_Node_Id;
1268       In_Tree : Project_Node_Tree_Ref)
1269       return Project_Node_Id
1270    is
1271    begin
1272       pragma Assert
1273         (Present (Node)
1274           and then
1275             In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String);
1276       return In_Tree.Project_Nodes.Table (Node).Field1;
1277    end Next_Literal_String;
1278
1279    -----------------------------
1280    -- Next_Package_In_Project --
1281    -----------------------------
1282
1283    function Next_Package_In_Project
1284      (Node    : Project_Node_Id;
1285       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1286    is
1287    begin
1288       pragma Assert
1289         (Present (Node)
1290           and then
1291             In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
1292       return In_Tree.Project_Nodes.Table (Node).Field3;
1293    end Next_Package_In_Project;
1294
1295    ----------------------
1296    -- Next_String_Type --
1297    ----------------------
1298
1299    function Next_String_Type
1300      (Node    : Project_Node_Id;
1301       In_Tree : Project_Node_Tree_Ref)
1302       return Project_Node_Id
1303    is
1304    begin
1305       pragma Assert
1306         (Present (Node)
1307           and then
1308          In_Tree.Project_Nodes.Table (Node).Kind =
1309            N_String_Type_Declaration);
1310       return In_Tree.Project_Nodes.Table (Node).Field2;
1311    end Next_String_Type;
1312
1313    ---------------
1314    -- Next_Term --
1315    ---------------
1316
1317    function Next_Term
1318      (Node    : Project_Node_Id;
1319       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1320    is
1321    begin
1322       pragma Assert
1323         (Present (Node)
1324           and then
1325             In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
1326       return In_Tree.Project_Nodes.Table (Node).Field2;
1327    end Next_Term;
1328
1329    -------------------
1330    -- Next_Variable --
1331    -------------------
1332
1333    function Next_Variable
1334      (Node    : Project_Node_Id;
1335       In_Tree : Project_Node_Tree_Ref)
1336       return Project_Node_Id
1337    is
1338    begin
1339       pragma Assert
1340         (Present (Node)
1341           and then
1342            (In_Tree.Project_Nodes.Table (Node).Kind =
1343               N_Typed_Variable_Declaration
1344                or else
1345             In_Tree.Project_Nodes.Table (Node).Kind =
1346               N_Variable_Declaration));
1347
1348       return In_Tree.Project_Nodes.Table (Node).Field3;
1349    end Next_Variable;
1350
1351    -------------------------
1352    -- Next_With_Clause_Of --
1353    -------------------------
1354
1355    function Next_With_Clause_Of
1356      (Node    : Project_Node_Id;
1357       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1358    is
1359    begin
1360       pragma Assert
1361         (Present (Node)
1362           and then
1363             In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
1364       return In_Tree.Project_Nodes.Table (Node).Field2;
1365    end Next_With_Clause_Of;
1366
1367    --------
1368    -- No --
1369    --------
1370
1371    function No (Node : Project_Node_Id) return Boolean is
1372    begin
1373       return Node = Empty_Node;
1374    end No;
1375
1376    ---------------------------------
1377    -- Non_Limited_Project_Node_Of --
1378    ---------------------------------
1379
1380    function Non_Limited_Project_Node_Of
1381      (Node    : Project_Node_Id;
1382       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1383    is
1384    begin
1385       pragma Assert
1386         (Present (Node)
1387           and then
1388            (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
1389       return In_Tree.Project_Nodes.Table (Node).Field3;
1390    end Non_Limited_Project_Node_Of;
1391
1392    -------------------
1393    -- Package_Id_Of --
1394    -------------------
1395
1396    function Package_Id_Of
1397      (Node    : Project_Node_Id;
1398       In_Tree : Project_Node_Tree_Ref) return Package_Node_Id
1399    is
1400    begin
1401       pragma Assert
1402         (Present (Node)
1403           and then
1404             In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
1405       return In_Tree.Project_Nodes.Table (Node).Pkg_Id;
1406    end Package_Id_Of;
1407
1408    ---------------------
1409    -- Package_Node_Of --
1410    ---------------------
1411
1412    function Package_Node_Of
1413      (Node    : Project_Node_Id;
1414       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1415    is
1416    begin
1417       pragma Assert
1418         (Present (Node)
1419           and then
1420             (In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
1421                or else
1422              In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
1423       return In_Tree.Project_Nodes.Table (Node).Field2;
1424    end Package_Node_Of;
1425
1426    ------------------
1427    -- Path_Name_Of --
1428    ------------------
1429
1430    function Path_Name_Of
1431      (Node    : Project_Node_Id;
1432       In_Tree : Project_Node_Tree_Ref) return Path_Name_Type
1433    is
1434    begin
1435       pragma Assert
1436         (Present (Node)
1437           and then
1438             (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
1439                or else
1440              In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
1441       return In_Tree.Project_Nodes.Table (Node).Path_Name;
1442    end Path_Name_Of;
1443
1444    -------------
1445    -- Present --
1446    -------------
1447
1448    function Present (Node : Project_Node_Id) return Boolean is
1449    begin
1450       return Node /= Empty_Node;
1451    end Present;
1452
1453    ----------------------------
1454    -- Project_Declaration_Of --
1455    ----------------------------
1456
1457    function Project_Declaration_Of
1458      (Node    : Project_Node_Id;
1459       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1460    is
1461    begin
1462       pragma Assert
1463         (Present (Node)
1464           and then
1465             In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
1466       return In_Tree.Project_Nodes.Table (Node).Field2;
1467    end Project_Declaration_Of;
1468
1469    --------------------------
1470    -- Project_Qualifier_Of --
1471    --------------------------
1472
1473    function Project_Qualifier_Of
1474      (Node    : Project_Node_Id;
1475       In_Tree : Project_Node_Tree_Ref) return Project_Qualifier
1476    is
1477    begin
1478       pragma Assert
1479         (Present (Node)
1480           and then
1481             In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
1482       return In_Tree.Project_Nodes.Table (Node).Qualifier;
1483    end Project_Qualifier_Of;
1484
1485    -----------------------
1486    -- Parent_Project_Of --
1487    -----------------------
1488
1489    function Parent_Project_Of
1490      (Node    : Project_Node_Id;
1491       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1492    is
1493    begin
1494       pragma Assert
1495         (Present (Node)
1496           and then
1497             In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
1498       return In_Tree.Project_Nodes.Table (Node).Field4;
1499    end Parent_Project_Of;
1500
1501    -------------------------------------------
1502    -- Project_File_Includes_Unkept_Comments --
1503    -------------------------------------------
1504
1505    function Project_File_Includes_Unkept_Comments
1506      (Node    : Project_Node_Id;
1507       In_Tree : Project_Node_Tree_Ref) return Boolean
1508    is
1509       Declaration : constant Project_Node_Id :=
1510                       Project_Declaration_Of (Node, In_Tree);
1511    begin
1512       return In_Tree.Project_Nodes.Table (Declaration).Flag1;
1513    end Project_File_Includes_Unkept_Comments;
1514
1515    ---------------------
1516    -- Project_Node_Of --
1517    ---------------------
1518
1519    function Project_Node_Of
1520      (Node    : Project_Node_Id;
1521       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1522    is
1523    begin
1524       pragma Assert
1525         (Present (Node)
1526           and then
1527            (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
1528               or else
1529             In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
1530               or else
1531             In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
1532       return In_Tree.Project_Nodes.Table (Node).Field1;
1533    end Project_Node_Of;
1534
1535    -----------------------------------
1536    -- Project_Of_Renamed_Package_Of --
1537    -----------------------------------
1538
1539    function Project_Of_Renamed_Package_Of
1540      (Node    : Project_Node_Id;
1541       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1542    is
1543    begin
1544       pragma Assert
1545         (Present (Node)
1546           and then
1547             In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
1548       return In_Tree.Project_Nodes.Table (Node).Field1;
1549    end Project_Of_Renamed_Package_Of;
1550
1551    --------------------------
1552    -- Remove_Next_End_Node --
1553    --------------------------
1554
1555    procedure Remove_Next_End_Node is
1556    begin
1557       Next_End_Nodes.Decrement_Last;
1558    end Remove_Next_End_Node;
1559
1560    -----------------
1561    -- Reset_State --
1562    -----------------
1563
1564    procedure Reset_State is
1565    begin
1566       End_Of_Line_Node   := Empty_Node;
1567       Previous_Line_Node := Empty_Node;
1568       Previous_End_Node  := Empty_Node;
1569       Unkept_Comments    := False;
1570       Comments.Set_Last (0);
1571    end Reset_State;
1572
1573    ----------------------
1574    -- Restore_And_Free --
1575    ----------------------
1576
1577    procedure Restore_And_Free (S : in out Comment_State) is
1578       procedure Unchecked_Free is new
1579         Ada.Unchecked_Deallocation (Comment_Array, Comments_Ptr);
1580
1581    begin
1582       End_Of_Line_Node   := S.End_Of_Line_Node;
1583       Previous_Line_Node := S.Previous_Line_Node;
1584       Previous_End_Node  := S.Previous_End_Node;
1585       Next_End_Nodes.Set_Last (0);
1586       Unkept_Comments    := S.Unkept_Comments;
1587
1588       Comments.Set_Last (0);
1589
1590       for J in S.Comments'Range loop
1591          Comments.Increment_Last;
1592          Comments.Table (Comments.Last) := S.Comments (J);
1593       end loop;
1594
1595       Unchecked_Free (S.Comments);
1596    end Restore_And_Free;
1597
1598    ----------
1599    -- Save --
1600    ----------
1601
1602    procedure Save (S : out Comment_State) is
1603       Cmts : constant Comments_Ptr := new Comment_Array (1 .. Comments.Last);
1604
1605    begin
1606       for J in 1 .. Comments.Last loop
1607          Cmts (J) := Comments.Table (J);
1608       end loop;
1609
1610       S :=
1611         (End_Of_Line_Node   => End_Of_Line_Node,
1612          Previous_Line_Node => Previous_Line_Node,
1613          Previous_End_Node  => Previous_End_Node,
1614          Unkept_Comments    => Unkept_Comments,
1615          Comments           => Cmts);
1616    end Save;
1617
1618    ----------
1619    -- Scan --
1620    ----------
1621
1622    procedure Scan (In_Tree : Project_Node_Tree_Ref) is
1623       Empty_Line : Boolean := False;
1624
1625    begin
1626       --  If there are comments, then they will not be kept. Set the flag and
1627       --  clear the comments.
1628
1629       if Comments.Last > 0 then
1630          Unkept_Comments := True;
1631          Comments.Set_Last (0);
1632       end if;
1633
1634       --  Loop until a token other that End_Of_Line or Comment is found
1635
1636       loop
1637          Prj.Err.Scanner.Scan;
1638
1639          case Token is
1640             when Tok_End_Of_Line =>
1641                if Prev_Token = Tok_End_Of_Line then
1642                   Empty_Line := True;
1643
1644                   if Comments.Last > 0 then
1645                      Comments.Table (Comments.Last).Is_Followed_By_Empty_Line
1646                      := True;
1647                   end if;
1648                end if;
1649
1650             when Tok_Comment =>
1651                --  If this is a line comment, add it to the comment table
1652
1653                if Prev_Token = Tok_End_Of_Line
1654                  or else Prev_Token = No_Token
1655                then
1656                   Comments.Increment_Last;
1657                   Comments.Table (Comments.Last) :=
1658                     (Value                     => Comment_Id,
1659                      Follows_Empty_Line        => Empty_Line,
1660                      Is_Followed_By_Empty_Line => False);
1661
1662                --  Otherwise, it is an end of line comment. If there is an
1663                --  end of line node specified, associate the comment with
1664                --  this node.
1665
1666                elsif Present (End_Of_Line_Node) then
1667                   declare
1668                      Zones : constant Project_Node_Id :=
1669                                Comment_Zones_Of (End_Of_Line_Node, In_Tree);
1670                   begin
1671                      In_Tree.Project_Nodes.Table (Zones).Value := Comment_Id;
1672                   end;
1673
1674                --  Otherwise, this end of line node cannot be kept
1675
1676                else
1677                   Unkept_Comments := True;
1678                   Comments.Set_Last (0);
1679                end if;
1680
1681                Empty_Line := False;
1682
1683             when others =>
1684                --  If there are comments, where the first comment is not
1685                --  following an empty line, put the initial uninterrupted
1686                --  comment zone with the node of the preceding line (either
1687                --  a Previous_Line or a Previous_End node), if any.
1688
1689                if Comments.Last > 0 and then
1690                  not Comments.Table (1).Follows_Empty_Line then
1691                   if Present (Previous_Line_Node) then
1692                      Add_Comments
1693                        (To      => Previous_Line_Node,
1694                         Where   => After,
1695                         In_Tree => In_Tree);
1696
1697                   elsif Present (Previous_End_Node) then
1698                      Add_Comments
1699                        (To      => Previous_End_Node,
1700                         Where   => After_End,
1701                         In_Tree => In_Tree);
1702                   end if;
1703                end if;
1704
1705                --  If there are still comments and the token is "end", then
1706                --  put these comments with the Next_End node, if any;
1707                --  otherwise, these comments cannot be kept. Always clear
1708                --  the comments.
1709
1710                if Comments.Last > 0 and then Token = Tok_End then
1711                   if Next_End_Nodes.Last > 0 then
1712                      Add_Comments
1713                        (To      => Next_End_Nodes.Table (Next_End_Nodes.Last),
1714                         Where   => Before_End,
1715                         In_Tree => In_Tree);
1716
1717                   else
1718                      Unkept_Comments := True;
1719                   end if;
1720
1721                   Comments.Set_Last (0);
1722                end if;
1723
1724                --  Reset the End_Of_Line, Previous_Line and Previous_End nodes
1725                --  so that they are not used again.
1726
1727                End_Of_Line_Node   := Empty_Node;
1728                Previous_Line_Node := Empty_Node;
1729                Previous_End_Node  := Empty_Node;
1730
1731                --  And return
1732
1733                exit;
1734          end case;
1735       end loop;
1736    end Scan;
1737
1738    ------------------------------------
1739    -- Set_Associative_Array_Index_Of --
1740    ------------------------------------
1741
1742    procedure Set_Associative_Array_Index_Of
1743      (Node    : Project_Node_Id;
1744       In_Tree : Project_Node_Tree_Ref;
1745       To      : Name_Id)
1746    is
1747    begin
1748       pragma Assert
1749         (Present (Node)
1750           and then
1751             (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
1752                or else
1753              In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
1754       In_Tree.Project_Nodes.Table (Node).Value := To;
1755    end Set_Associative_Array_Index_Of;
1756
1757    --------------------------------
1758    -- Set_Associative_Package_Of --
1759    --------------------------------
1760
1761    procedure Set_Associative_Package_Of
1762      (Node    : Project_Node_Id;
1763       In_Tree : Project_Node_Tree_Ref;
1764       To      : Project_Node_Id)
1765    is
1766    begin
1767       pragma Assert
1768          (Present (Node)
1769           and then
1770             In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration);
1771       In_Tree.Project_Nodes.Table (Node).Field3 := To;
1772    end Set_Associative_Package_Of;
1773
1774    --------------------------------
1775    -- Set_Associative_Project_Of --
1776    --------------------------------
1777
1778    procedure Set_Associative_Project_Of
1779      (Node    : Project_Node_Id;
1780       In_Tree : Project_Node_Tree_Ref;
1781       To      : Project_Node_Id)
1782    is
1783    begin
1784       pragma Assert
1785         (Present (Node)
1786           and then
1787            (In_Tree.Project_Nodes.Table (Node).Kind =
1788               N_Attribute_Declaration));
1789       In_Tree.Project_Nodes.Table (Node).Field2 := To;
1790    end Set_Associative_Project_Of;
1791
1792    --------------------------
1793    -- Set_Case_Insensitive --
1794    --------------------------
1795
1796    procedure Set_Case_Insensitive
1797      (Node    : Project_Node_Id;
1798       In_Tree : Project_Node_Tree_Ref;
1799       To      : Boolean)
1800    is
1801    begin
1802       pragma Assert
1803         (Present (Node)
1804           and then
1805            (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
1806                or else
1807             In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
1808       In_Tree.Project_Nodes.Table (Node).Flag1 := To;
1809    end Set_Case_Insensitive;
1810
1811    ------------------------------------
1812    -- Set_Case_Variable_Reference_Of --
1813    ------------------------------------
1814
1815    procedure Set_Case_Variable_Reference_Of
1816      (Node    : Project_Node_Id;
1817       In_Tree : Project_Node_Tree_Ref;
1818       To      : Project_Node_Id)
1819    is
1820    begin
1821       pragma Assert
1822         (Present (Node)
1823           and then
1824             In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
1825       In_Tree.Project_Nodes.Table (Node).Field1 := To;
1826    end Set_Case_Variable_Reference_Of;
1827
1828    ---------------------------
1829    -- Set_Current_Item_Node --
1830    ---------------------------
1831
1832    procedure Set_Current_Item_Node
1833      (Node    : Project_Node_Id;
1834       In_Tree : Project_Node_Tree_Ref;
1835       To      : Project_Node_Id)
1836    is
1837    begin
1838       pragma Assert
1839         (Present (Node)
1840           and then
1841             In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
1842       In_Tree.Project_Nodes.Table (Node).Field1 := To;
1843    end Set_Current_Item_Node;
1844
1845    ----------------------
1846    -- Set_Current_Term --
1847    ----------------------
1848
1849    procedure Set_Current_Term
1850      (Node    : Project_Node_Id;
1851       In_Tree : Project_Node_Tree_Ref;
1852       To      : Project_Node_Id)
1853    is
1854    begin
1855       pragma Assert
1856         (Present (Node)
1857           and then
1858             In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
1859       In_Tree.Project_Nodes.Table (Node).Field1 := To;
1860    end Set_Current_Term;
1861
1862    ----------------------
1863    -- Set_Directory_Of --
1864    ----------------------
1865
1866    procedure Set_Directory_Of
1867      (Node    : Project_Node_Id;
1868       In_Tree : Project_Node_Tree_Ref;
1869       To      : Path_Name_Type)
1870    is
1871    begin
1872       pragma Assert
1873         (Present (Node)
1874           and then
1875             In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
1876       In_Tree.Project_Nodes.Table (Node).Directory := To;
1877    end Set_Directory_Of;
1878
1879    ---------------------
1880    -- Set_End_Of_Line --
1881    ---------------------
1882
1883    procedure Set_End_Of_Line (To : Project_Node_Id) is
1884    begin
1885       End_Of_Line_Node := To;
1886    end Set_End_Of_Line;
1887
1888    ----------------------------
1889    -- Set_Expression_Kind_Of --
1890    ----------------------------
1891
1892    procedure Set_Expression_Kind_Of
1893      (Node    : Project_Node_Id;
1894       In_Tree : Project_Node_Tree_Ref;
1895       To      : Variable_Kind)
1896    is
1897    begin
1898       pragma Assert
1899         (Present (Node)
1900            and then -- should use Nkind_In here ??? why not???
1901              (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
1902                 or else
1903               In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
1904                 or else
1905               In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Declaration
1906                 or else
1907               In_Tree.Project_Nodes.Table (Node).Kind =
1908                                                   N_Typed_Variable_Declaration
1909                 or else
1910               In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration
1911                 or else
1912               In_Tree.Project_Nodes.Table (Node).Kind = N_Expression
1913                 or else
1914               In_Tree.Project_Nodes.Table (Node).Kind = N_Term
1915                 or else
1916               In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
1917                 or else
1918               In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference
1919                 or else
1920               In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value));
1921       In_Tree.Project_Nodes.Table (Node).Expr_Kind := To;
1922    end Set_Expression_Kind_Of;
1923
1924    -----------------------
1925    -- Set_Expression_Of --
1926    -----------------------
1927
1928    procedure Set_Expression_Of
1929      (Node    : Project_Node_Id;
1930       In_Tree : Project_Node_Tree_Ref;
1931       To      : Project_Node_Id)
1932    is
1933    begin
1934       pragma Assert
1935         (Present (Node)
1936           and then
1937            (In_Tree.Project_Nodes.Table (Node).Kind =
1938               N_Attribute_Declaration
1939                or else
1940             In_Tree.Project_Nodes.Table (Node).Kind =
1941               N_Typed_Variable_Declaration
1942                or else
1943             In_Tree.Project_Nodes.Table (Node).Kind =
1944               N_Variable_Declaration));
1945       In_Tree.Project_Nodes.Table (Node).Field1 := To;
1946    end Set_Expression_Of;
1947
1948    -------------------------------
1949    -- Set_External_Reference_Of --
1950    -------------------------------
1951
1952    procedure Set_External_Reference_Of
1953      (Node    : Project_Node_Id;
1954       In_Tree : Project_Node_Tree_Ref;
1955       To      : Project_Node_Id)
1956    is
1957    begin
1958       pragma Assert
1959         (Present (Node)
1960           and then
1961             In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
1962       In_Tree.Project_Nodes.Table (Node).Field1 := To;
1963    end Set_External_Reference_Of;
1964
1965    -----------------------------
1966    -- Set_External_Default_Of --
1967    -----------------------------
1968
1969    procedure Set_External_Default_Of
1970      (Node    : Project_Node_Id;
1971       In_Tree : Project_Node_Tree_Ref;
1972       To      : Project_Node_Id)
1973    is
1974    begin
1975       pragma Assert
1976         (Present (Node)
1977           and then
1978             In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
1979       In_Tree.Project_Nodes.Table (Node).Field2 := To;
1980    end Set_External_Default_Of;
1981
1982    ----------------------------
1983    -- Set_First_Case_Item_Of --
1984    ----------------------------
1985
1986    procedure Set_First_Case_Item_Of
1987      (Node    : Project_Node_Id;
1988       In_Tree : Project_Node_Tree_Ref;
1989       To      : Project_Node_Id)
1990    is
1991    begin
1992       pragma Assert
1993         (Present (Node)
1994           and then
1995             In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
1996       In_Tree.Project_Nodes.Table (Node).Field2 := To;
1997    end Set_First_Case_Item_Of;
1998
1999    -------------------------
2000    -- Set_First_Choice_Of --
2001    -------------------------
2002
2003    procedure Set_First_Choice_Of
2004      (Node    : Project_Node_Id;
2005       In_Tree : Project_Node_Tree_Ref;
2006       To      : Project_Node_Id)
2007    is
2008    begin
2009       pragma Assert
2010         (Present (Node)
2011           and then
2012             In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
2013       In_Tree.Project_Nodes.Table (Node).Field1 := To;
2014    end Set_First_Choice_Of;
2015
2016    -----------------------------
2017    -- Set_First_Comment_After --
2018    -----------------------------
2019
2020    procedure Set_First_Comment_After
2021      (Node    : Project_Node_Id;
2022       In_Tree : Project_Node_Tree_Ref;
2023       To      : Project_Node_Id)
2024    is
2025       Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree);
2026    begin
2027       In_Tree.Project_Nodes.Table (Zone).Field2 := To;
2028    end Set_First_Comment_After;
2029
2030    ---------------------------------
2031    -- Set_First_Comment_After_End --
2032    ---------------------------------
2033
2034    procedure Set_First_Comment_After_End
2035      (Node    : Project_Node_Id;
2036       In_Tree : Project_Node_Tree_Ref;
2037       To      : Project_Node_Id)
2038    is
2039       Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree);
2040    begin
2041       In_Tree.Project_Nodes.Table (Zone).Comments := To;
2042    end Set_First_Comment_After_End;
2043
2044    ------------------------------
2045    -- Set_First_Comment_Before --
2046    ------------------------------
2047
2048    procedure Set_First_Comment_Before
2049      (Node    : Project_Node_Id;
2050       In_Tree : Project_Node_Tree_Ref;
2051       To      : Project_Node_Id)
2052    is
2053       Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree);
2054    begin
2055       In_Tree.Project_Nodes.Table (Zone).Field1 := To;
2056    end Set_First_Comment_Before;
2057
2058    ----------------------------------
2059    -- Set_First_Comment_Before_End --
2060    ----------------------------------
2061
2062    procedure Set_First_Comment_Before_End
2063      (Node    : Project_Node_Id;
2064       In_Tree : Project_Node_Tree_Ref;
2065       To      : Project_Node_Id)
2066    is
2067       Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree);
2068    begin
2069       In_Tree.Project_Nodes.Table (Zone).Field2 := To;
2070    end Set_First_Comment_Before_End;
2071
2072    ------------------------
2073    -- Set_Next_Case_Item --
2074    ------------------------
2075
2076    procedure Set_Next_Case_Item
2077      (Node    : Project_Node_Id;
2078       In_Tree : Project_Node_Tree_Ref;
2079       To      : Project_Node_Id)
2080    is
2081    begin
2082       pragma Assert
2083         (Present (Node)
2084           and then
2085             In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
2086       In_Tree.Project_Nodes.Table (Node).Field3 := To;
2087    end Set_Next_Case_Item;
2088
2089    ----------------------
2090    -- Set_Next_Comment --
2091    ----------------------
2092
2093    procedure Set_Next_Comment
2094      (Node    : Project_Node_Id;
2095       In_Tree : Project_Node_Tree_Ref;
2096       To      : Project_Node_Id)
2097    is
2098    begin
2099       pragma Assert
2100         (Present (Node)
2101           and then
2102             In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
2103       In_Tree.Project_Nodes.Table (Node).Comments := To;
2104    end Set_Next_Comment;
2105
2106    -----------------------------------
2107    -- Set_First_Declarative_Item_Of --
2108    -----------------------------------
2109
2110    procedure Set_First_Declarative_Item_Of
2111      (Node    : Project_Node_Id;
2112       In_Tree : Project_Node_Tree_Ref;
2113       To      : Project_Node_Id)
2114    is
2115    begin
2116       pragma Assert
2117         (Present (Node)
2118           and then
2119             (In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration
2120                or else
2121              In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item
2122                or else
2123              In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration));
2124
2125       if In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration then
2126          In_Tree.Project_Nodes.Table (Node).Field1 := To;
2127       else
2128          In_Tree.Project_Nodes.Table (Node).Field2 := To;
2129       end if;
2130    end Set_First_Declarative_Item_Of;
2131
2132    ----------------------------------
2133    -- Set_First_Expression_In_List --
2134    ----------------------------------
2135
2136    procedure Set_First_Expression_In_List
2137      (Node    : Project_Node_Id;
2138       In_Tree : Project_Node_Tree_Ref;
2139       To      : Project_Node_Id)
2140    is
2141    begin
2142       pragma Assert
2143         (Present (Node)
2144           and then
2145             In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String_List);
2146       In_Tree.Project_Nodes.Table (Node).Field1 := To;
2147    end Set_First_Expression_In_List;
2148
2149    ------------------------------
2150    -- Set_First_Literal_String --
2151    ------------------------------
2152
2153    procedure Set_First_Literal_String
2154      (Node    : Project_Node_Id;
2155       In_Tree : Project_Node_Tree_Ref;
2156       To      : Project_Node_Id)
2157    is
2158    begin
2159       pragma Assert
2160         (Present (Node)
2161           and then
2162          In_Tree.Project_Nodes.Table (Node).Kind =
2163            N_String_Type_Declaration);
2164       In_Tree.Project_Nodes.Table (Node).Field1 := To;
2165    end Set_First_Literal_String;
2166
2167    --------------------------
2168    -- Set_First_Package_Of --
2169    --------------------------
2170
2171    procedure Set_First_Package_Of
2172      (Node    : Project_Node_Id;
2173       In_Tree : Project_Node_Tree_Ref;
2174       To      : Package_Declaration_Id)
2175    is
2176    begin
2177       pragma Assert
2178         (Present (Node)
2179           and then
2180             In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2181       In_Tree.Project_Nodes.Table (Node).Packages := To;
2182    end Set_First_Package_Of;
2183
2184    ------------------------------
2185    -- Set_First_String_Type_Of --
2186    ------------------------------
2187
2188    procedure Set_First_String_Type_Of
2189      (Node    : Project_Node_Id;
2190       In_Tree : Project_Node_Tree_Ref;
2191       To      : Project_Node_Id)
2192    is
2193    begin
2194       pragma Assert
2195         (Present (Node)
2196           and then
2197             In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2198       In_Tree.Project_Nodes.Table (Node).Field3 := To;
2199    end Set_First_String_Type_Of;
2200
2201    --------------------
2202    -- Set_First_Term --
2203    --------------------
2204
2205    procedure Set_First_Term
2206      (Node    : Project_Node_Id;
2207       In_Tree : Project_Node_Tree_Ref;
2208       To      : Project_Node_Id)
2209    is
2210    begin
2211       pragma Assert
2212         (Present (Node)
2213           and then
2214             In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
2215       In_Tree.Project_Nodes.Table (Node).Field1 := To;
2216    end Set_First_Term;
2217
2218    ---------------------------
2219    -- Set_First_Variable_Of --
2220    ---------------------------
2221
2222    procedure Set_First_Variable_Of
2223      (Node    : Project_Node_Id;
2224       In_Tree : Project_Node_Tree_Ref;
2225       To      : Variable_Node_Id)
2226    is
2227    begin
2228       pragma Assert
2229         (Present (Node)
2230           and then
2231             (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
2232                or else
2233              In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration));
2234       In_Tree.Project_Nodes.Table (Node).Variables := To;
2235    end Set_First_Variable_Of;
2236
2237    ------------------------------
2238    -- Set_First_With_Clause_Of --
2239    ------------------------------
2240
2241    procedure Set_First_With_Clause_Of
2242      (Node    : Project_Node_Id;
2243       In_Tree : Project_Node_Tree_Ref;
2244       To      : Project_Node_Id)
2245    is
2246    begin
2247       pragma Assert
2248         (Present (Node)
2249           and then
2250             In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2251       In_Tree.Project_Nodes.Table (Node).Field1 := To;
2252    end Set_First_With_Clause_Of;
2253
2254    --------------------------
2255    -- Set_Is_Extending_All --
2256    --------------------------
2257
2258    procedure Set_Is_Extending_All
2259      (Node    : Project_Node_Id;
2260       In_Tree : Project_Node_Tree_Ref)
2261    is
2262    begin
2263       pragma Assert
2264         (Present (Node)
2265           and then
2266             (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
2267                or else
2268              In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
2269       In_Tree.Project_Nodes.Table (Node).Flag2 := True;
2270    end Set_Is_Extending_All;
2271
2272    -----------------------------
2273    -- Set_Is_Not_Last_In_List --
2274    -----------------------------
2275
2276    procedure Set_Is_Not_Last_In_List
2277      (Node    : Project_Node_Id;
2278       In_Tree : Project_Node_Tree_Ref)
2279    is
2280    begin
2281       pragma Assert
2282         (Present (Node)
2283           and then In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
2284       In_Tree.Project_Nodes.Table (Node).Flag1 := True;
2285    end Set_Is_Not_Last_In_List;
2286
2287    -----------------
2288    -- Set_Kind_Of --
2289    -----------------
2290
2291    procedure Set_Kind_Of
2292      (Node    : Project_Node_Id;
2293       In_Tree : Project_Node_Tree_Ref;
2294       To      : Project_Node_Kind)
2295    is
2296    begin
2297       pragma Assert (Present (Node));
2298       In_Tree.Project_Nodes.Table (Node).Kind := To;
2299    end Set_Kind_Of;
2300
2301    ---------------------
2302    -- Set_Location_Of --
2303    ---------------------
2304
2305    procedure Set_Location_Of
2306      (Node    : Project_Node_Id;
2307       In_Tree : Project_Node_Tree_Ref;
2308       To      : Source_Ptr)
2309    is
2310    begin
2311       pragma Assert (Present (Node));
2312       In_Tree.Project_Nodes.Table (Node).Location := To;
2313    end Set_Location_Of;
2314
2315    -----------------------------
2316    -- Set_Extended_Project_Of --
2317    -----------------------------
2318
2319    procedure Set_Extended_Project_Of
2320      (Node    : Project_Node_Id;
2321       In_Tree : Project_Node_Tree_Ref;
2322       To      : Project_Node_Id)
2323    is
2324    begin
2325       pragma Assert
2326         (Present (Node)
2327           and then
2328             In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
2329       In_Tree.Project_Nodes.Table (Node).Field2 := To;
2330    end Set_Extended_Project_Of;
2331
2332    ----------------------------------
2333    -- Set_Extended_Project_Path_Of --
2334    ----------------------------------
2335
2336    procedure Set_Extended_Project_Path_Of
2337      (Node    : Project_Node_Id;
2338       In_Tree : Project_Node_Tree_Ref;
2339       To      : Path_Name_Type)
2340    is
2341    begin
2342       pragma Assert
2343         (Present (Node)
2344           and then
2345             In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2346       In_Tree.Project_Nodes.Table (Node).Value := Name_Id (To);
2347    end Set_Extended_Project_Path_Of;
2348
2349    ------------------------------
2350    -- Set_Extending_Project_Of --
2351    ------------------------------
2352
2353    procedure Set_Extending_Project_Of
2354      (Node    : Project_Node_Id;
2355       In_Tree : Project_Node_Tree_Ref;
2356       To      : Project_Node_Id)
2357    is
2358    begin
2359       pragma Assert
2360         (Present (Node)
2361           and then
2362             In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
2363       In_Tree.Project_Nodes.Table (Node).Field3 := To;
2364    end Set_Extending_Project_Of;
2365
2366    -----------------
2367    -- Set_Name_Of --
2368    -----------------
2369
2370    procedure Set_Name_Of
2371      (Node    : Project_Node_Id;
2372       In_Tree : Project_Node_Tree_Ref;
2373       To      : Name_Id)
2374    is
2375    begin
2376       pragma Assert (Present (Node));
2377       In_Tree.Project_Nodes.Table (Node).Name := To;
2378    end Set_Name_Of;
2379
2380    -------------------------------
2381    -- Set_Next_Declarative_Item --
2382    -------------------------------
2383
2384    procedure Set_Next_Declarative_Item
2385      (Node    : Project_Node_Id;
2386       In_Tree : Project_Node_Tree_Ref;
2387       To      : Project_Node_Id)
2388    is
2389    begin
2390       pragma Assert
2391         (Present (Node)
2392           and then
2393             In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
2394       In_Tree.Project_Nodes.Table (Node).Field2 := To;
2395    end Set_Next_Declarative_Item;
2396
2397    -----------------------
2398    -- Set_Next_End_Node --
2399    -----------------------
2400
2401    procedure Set_Next_End_Node (To : Project_Node_Id) is
2402    begin
2403       Next_End_Nodes.Increment_Last;
2404       Next_End_Nodes.Table (Next_End_Nodes.Last) := To;
2405    end Set_Next_End_Node;
2406
2407    ---------------------------------
2408    -- Set_Next_Expression_In_List --
2409    ---------------------------------
2410
2411    procedure Set_Next_Expression_In_List
2412      (Node    : Project_Node_Id;
2413       In_Tree : Project_Node_Tree_Ref;
2414       To      : Project_Node_Id)
2415    is
2416    begin
2417       pragma Assert
2418         (Present (Node)
2419           and then
2420             In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
2421       In_Tree.Project_Nodes.Table (Node).Field2 := To;
2422    end Set_Next_Expression_In_List;
2423
2424    -----------------------------
2425    -- Set_Next_Literal_String --
2426    -----------------------------
2427
2428    procedure Set_Next_Literal_String
2429      (Node    : Project_Node_Id;
2430       In_Tree : Project_Node_Tree_Ref;
2431       To      : Project_Node_Id)
2432    is
2433    begin
2434       pragma Assert
2435         (Present (Node)
2436           and then
2437             In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String);
2438       In_Tree.Project_Nodes.Table (Node).Field1 := To;
2439    end Set_Next_Literal_String;
2440
2441    ---------------------------------
2442    -- Set_Next_Package_In_Project --
2443    ---------------------------------
2444
2445    procedure Set_Next_Package_In_Project
2446      (Node    : Project_Node_Id;
2447       In_Tree : Project_Node_Tree_Ref;
2448       To      : Project_Node_Id)
2449    is
2450    begin
2451       pragma Assert
2452         (Present (Node)
2453           and then
2454             In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
2455       In_Tree.Project_Nodes.Table (Node).Field3 := To;
2456    end Set_Next_Package_In_Project;
2457
2458    --------------------------
2459    -- Set_Next_String_Type --
2460    --------------------------
2461
2462    procedure Set_Next_String_Type
2463      (Node    : Project_Node_Id;
2464       In_Tree : Project_Node_Tree_Ref;
2465       To      : Project_Node_Id)
2466    is
2467    begin
2468       pragma Assert
2469         (Present (Node)
2470           and then
2471          In_Tree.Project_Nodes.Table (Node).Kind =
2472            N_String_Type_Declaration);
2473       In_Tree.Project_Nodes.Table (Node).Field2 := To;
2474    end Set_Next_String_Type;
2475
2476    -------------------
2477    -- Set_Next_Term --
2478    -------------------
2479
2480    procedure Set_Next_Term
2481      (Node    : Project_Node_Id;
2482       In_Tree : Project_Node_Tree_Ref;
2483       To      : Project_Node_Id)
2484    is
2485    begin
2486       pragma Assert
2487         (Present (Node)
2488           and then
2489             In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
2490       In_Tree.Project_Nodes.Table (Node).Field2 := To;
2491    end Set_Next_Term;
2492
2493    -----------------------
2494    -- Set_Next_Variable --
2495    -----------------------
2496
2497    procedure Set_Next_Variable
2498      (Node    : Project_Node_Id;
2499       In_Tree : Project_Node_Tree_Ref;
2500       To      : Project_Node_Id)
2501    is
2502    begin
2503       pragma Assert
2504         (Present (Node)
2505           and then
2506            (In_Tree.Project_Nodes.Table (Node).Kind =
2507               N_Typed_Variable_Declaration
2508                or else
2509             In_Tree.Project_Nodes.Table (Node).Kind =
2510               N_Variable_Declaration));
2511       In_Tree.Project_Nodes.Table (Node).Field3 := To;
2512    end Set_Next_Variable;
2513
2514    -----------------------------
2515    -- Set_Next_With_Clause_Of --
2516    -----------------------------
2517
2518    procedure Set_Next_With_Clause_Of
2519      (Node    : Project_Node_Id;
2520       In_Tree : Project_Node_Tree_Ref;
2521       To      : Project_Node_Id)
2522    is
2523    begin
2524       pragma Assert
2525         (Present (Node)
2526           and then
2527             In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
2528       In_Tree.Project_Nodes.Table (Node).Field2 := To;
2529    end Set_Next_With_Clause_Of;
2530
2531    -----------------------
2532    -- Set_Package_Id_Of --
2533    -----------------------
2534
2535    procedure Set_Package_Id_Of
2536      (Node    : Project_Node_Id;
2537       In_Tree : Project_Node_Tree_Ref;
2538       To      : Package_Node_Id)
2539    is
2540    begin
2541       pragma Assert
2542         (Present (Node)
2543           and then
2544             In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
2545       In_Tree.Project_Nodes.Table (Node).Pkg_Id := To;
2546    end Set_Package_Id_Of;
2547
2548    -------------------------
2549    -- Set_Package_Node_Of --
2550    -------------------------
2551
2552    procedure Set_Package_Node_Of
2553      (Node    : Project_Node_Id;
2554       In_Tree : Project_Node_Tree_Ref;
2555       To      : Project_Node_Id)
2556    is
2557    begin
2558       pragma Assert
2559         (Present (Node)
2560           and then
2561             (In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
2562                or else
2563              In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
2564       In_Tree.Project_Nodes.Table (Node).Field2 := To;
2565    end Set_Package_Node_Of;
2566
2567    ----------------------
2568    -- Set_Path_Name_Of --
2569    ----------------------
2570
2571    procedure Set_Path_Name_Of
2572      (Node    : Project_Node_Id;
2573       In_Tree : Project_Node_Tree_Ref;
2574       To      : Path_Name_Type)
2575    is
2576    begin
2577       pragma Assert
2578         (Present (Node)
2579           and then
2580             (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
2581                or else
2582              In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
2583       In_Tree.Project_Nodes.Table (Node).Path_Name := To;
2584    end Set_Path_Name_Of;
2585
2586    ---------------------------
2587    -- Set_Previous_End_Node --
2588    ---------------------------
2589    procedure Set_Previous_End_Node (To : Project_Node_Id) is
2590    begin
2591       Previous_End_Node := To;
2592    end Set_Previous_End_Node;
2593
2594    ----------------------------
2595    -- Set_Previous_Line_Node --
2596    ----------------------------
2597
2598    procedure Set_Previous_Line_Node (To : Project_Node_Id) is
2599    begin
2600       Previous_Line_Node := To;
2601    end Set_Previous_Line_Node;
2602
2603    --------------------------------
2604    -- Set_Project_Declaration_Of --
2605    --------------------------------
2606
2607    procedure Set_Project_Declaration_Of
2608      (Node    : Project_Node_Id;
2609       In_Tree : Project_Node_Tree_Ref;
2610       To      : Project_Node_Id)
2611    is
2612    begin
2613       pragma Assert
2614         (Present (Node)
2615          and then
2616            In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2617       In_Tree.Project_Nodes.Table (Node).Field2 := To;
2618    end Set_Project_Declaration_Of;
2619
2620    ------------------------------
2621    -- Set_Project_Qualifier_Of --
2622    ------------------------------
2623
2624    procedure Set_Project_Qualifier_Of
2625      (Node    : Project_Node_Id;
2626       In_Tree : Project_Node_Tree_Ref;
2627       To      : Project_Qualifier)
2628    is
2629    begin
2630       pragma Assert
2631         (Present (Node)
2632           and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2633       In_Tree.Project_Nodes.Table (Node).Qualifier := To;
2634    end Set_Project_Qualifier_Of;
2635
2636    ---------------------------
2637    -- Set_Parent_Project_Of --
2638    ---------------------------
2639
2640    procedure Set_Parent_Project_Of
2641      (Node    : Project_Node_Id;
2642       In_Tree : Project_Node_Tree_Ref;
2643       To      : Project_Node_Id)
2644    is
2645    begin
2646       pragma Assert
2647         (Present (Node)
2648           and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2649       In_Tree.Project_Nodes.Table (Node).Field4 := To;
2650    end Set_Parent_Project_Of;
2651
2652    -----------------------------------------------
2653    -- Set_Project_File_Includes_Unkept_Comments --
2654    -----------------------------------------------
2655
2656    procedure Set_Project_File_Includes_Unkept_Comments
2657      (Node    : Project_Node_Id;
2658       In_Tree : Project_Node_Tree_Ref;
2659       To      : Boolean)
2660    is
2661       Declaration : constant Project_Node_Id :=
2662                       Project_Declaration_Of (Node, In_Tree);
2663    begin
2664       In_Tree.Project_Nodes.Table (Declaration).Flag1 := To;
2665    end Set_Project_File_Includes_Unkept_Comments;
2666
2667    -------------------------
2668    -- Set_Project_Node_Of --
2669    -------------------------
2670
2671    procedure Set_Project_Node_Of
2672      (Node         : Project_Node_Id;
2673       In_Tree      : Project_Node_Tree_Ref;
2674       To           : Project_Node_Id;
2675       Limited_With : Boolean := False)
2676    is
2677    begin
2678       pragma Assert
2679         (Present (Node)
2680           and then
2681             (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
2682                or else
2683              In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
2684                or else
2685              In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
2686       In_Tree.Project_Nodes.Table (Node).Field1 := To;
2687
2688       if In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
2689         and then not Limited_With
2690       then
2691          In_Tree.Project_Nodes.Table (Node).Field3 := To;
2692       end if;
2693    end Set_Project_Node_Of;
2694
2695    ---------------------------------------
2696    -- Set_Project_Of_Renamed_Package_Of --
2697    ---------------------------------------
2698
2699    procedure Set_Project_Of_Renamed_Package_Of
2700      (Node    : Project_Node_Id;
2701       In_Tree : Project_Node_Tree_Ref;
2702       To      : Project_Node_Id)
2703    is
2704    begin
2705       pragma Assert
2706         (Present (Node)
2707           and then
2708             In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
2709       In_Tree.Project_Nodes.Table (Node).Field1 := To;
2710    end Set_Project_Of_Renamed_Package_Of;
2711
2712    -------------------------
2713    -- Set_Source_Index_Of --
2714    -------------------------
2715
2716    procedure Set_Source_Index_Of
2717      (Node    : Project_Node_Id;
2718       In_Tree : Project_Node_Tree_Ref;
2719       To      : Int)
2720    is
2721    begin
2722       pragma Assert
2723         (Present (Node)
2724           and then
2725            (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
2726             or else
2727             In_Tree.Project_Nodes.Table (Node).Kind =
2728               N_Attribute_Declaration));
2729       In_Tree.Project_Nodes.Table (Node).Src_Index := To;
2730    end Set_Source_Index_Of;
2731
2732    ------------------------
2733    -- Set_String_Type_Of --
2734    ------------------------
2735
2736    procedure Set_String_Type_Of
2737      (Node    : Project_Node_Id;
2738       In_Tree : Project_Node_Tree_Ref;
2739       To      : Project_Node_Id)
2740    is
2741    begin
2742       pragma Assert
2743         (Present (Node)
2744           and then
2745            (In_Tree.Project_Nodes.Table (Node).Kind =
2746               N_Variable_Reference
2747                or else
2748             In_Tree.Project_Nodes.Table (Node).Kind =
2749               N_Typed_Variable_Declaration)
2750           and then
2751             In_Tree.Project_Nodes.Table (To).Kind = N_String_Type_Declaration);
2752
2753       if In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference then
2754          In_Tree.Project_Nodes.Table (Node).Field3 := To;
2755       else
2756          In_Tree.Project_Nodes.Table (Node).Field2 := To;
2757       end if;
2758    end Set_String_Type_Of;
2759
2760    -------------------------
2761    -- Set_String_Value_Of --
2762    -------------------------
2763
2764    procedure Set_String_Value_Of
2765      (Node    : Project_Node_Id;
2766       In_Tree : Project_Node_Tree_Ref;
2767       To      : Name_Id)
2768    is
2769    begin
2770       pragma Assert
2771         (Present (Node)
2772           and then
2773             (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
2774                or else
2775              In_Tree.Project_Nodes.Table (Node).Kind = N_Comment
2776                or else
2777              In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String));
2778       In_Tree.Project_Nodes.Table (Node).Value := To;
2779    end Set_String_Value_Of;
2780
2781    ---------------------
2782    -- Source_Index_Of --
2783    ---------------------
2784
2785    function Source_Index_Of
2786      (Node    : Project_Node_Id;
2787       In_Tree : Project_Node_Tree_Ref) return Int
2788    is
2789    begin
2790       pragma Assert
2791         (Present (Node)
2792           and then
2793             (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
2794               or else
2795              In_Tree.Project_Nodes.Table (Node).Kind =
2796                N_Attribute_Declaration));
2797       return In_Tree.Project_Nodes.Table (Node).Src_Index;
2798    end Source_Index_Of;
2799
2800    --------------------
2801    -- String_Type_Of --
2802    --------------------
2803
2804    function String_Type_Of
2805      (Node    : Project_Node_Id;
2806       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
2807    is
2808    begin
2809       pragma Assert
2810         (Present (Node)
2811           and then
2812            (In_Tree.Project_Nodes.Table (Node).Kind =
2813               N_Variable_Reference
2814                or else
2815             In_Tree.Project_Nodes.Table (Node).Kind =
2816               N_Typed_Variable_Declaration));
2817
2818       if In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference then
2819          return In_Tree.Project_Nodes.Table (Node).Field3;
2820       else
2821          return In_Tree.Project_Nodes.Table (Node).Field2;
2822       end if;
2823    end String_Type_Of;
2824
2825    ---------------------
2826    -- String_Value_Of --
2827    ---------------------
2828
2829    function String_Value_Of
2830      (Node    : Project_Node_Id;
2831       In_Tree : Project_Node_Tree_Ref) return Name_Id
2832    is
2833    begin
2834       pragma Assert
2835         (Present (Node)
2836           and then
2837            (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
2838               or else
2839             In_Tree.Project_Nodes.Table (Node).Kind = N_Comment
2840                or else
2841             In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String));
2842       return In_Tree.Project_Nodes.Table (Node).Value;
2843    end String_Value_Of;
2844
2845    --------------------
2846    -- Value_Is_Valid --
2847    --------------------
2848
2849    function Value_Is_Valid
2850      (For_Typed_Variable : Project_Node_Id;
2851       In_Tree            : Project_Node_Tree_Ref;
2852       Value              : Name_Id) return Boolean
2853    is
2854    begin
2855       pragma Assert
2856         (Present (For_Typed_Variable)
2857           and then
2858            (In_Tree.Project_Nodes.Table (For_Typed_Variable).Kind =
2859                                      N_Typed_Variable_Declaration));
2860
2861       declare
2862          Current_String : Project_Node_Id :=
2863                             First_Literal_String
2864                               (String_Type_Of (For_Typed_Variable, In_Tree),
2865                                In_Tree);
2866
2867       begin
2868          while Present (Current_String)
2869            and then
2870              String_Value_Of (Current_String, In_Tree) /= Value
2871          loop
2872             Current_String :=
2873               Next_Literal_String (Current_String, In_Tree);
2874          end loop;
2875
2876          return Present (Current_String);
2877       end;
2878
2879    end Value_Is_Valid;
2880
2881    -------------------------------
2882    -- There_Are_Unkept_Comments --
2883    -------------------------------
2884
2885    function There_Are_Unkept_Comments return Boolean is
2886    begin
2887       return Unkept_Comments;
2888    end There_Are_Unkept_Comments;
2889
2890    --------------------
2891    -- Create_Project --
2892    --------------------
2893
2894    function Create_Project
2895      (In_Tree        : Project_Node_Tree_Ref;
2896       Name           : Name_Id;
2897       Full_Path      : Path_Name_Type;
2898       Is_Config_File : Boolean := False) return Project_Node_Id
2899    is
2900       Project   : Project_Node_Id;
2901       Qualifier : Project_Qualifier := Unspecified;
2902    begin
2903       Project := Default_Project_Node (In_Tree, N_Project);
2904       Set_Name_Of (Project, In_Tree, Name);
2905       Set_Directory_Of
2906         (Project, In_Tree,
2907          Path_Name_Type (Get_Directory (File_Name_Type (Full_Path))));
2908       Set_Path_Name_Of (Project, In_Tree, Full_Path);
2909
2910       Set_Project_Declaration_Of
2911         (Project, In_Tree,
2912          Default_Project_Node (In_Tree, N_Project_Declaration));
2913
2914       if Is_Config_File then
2915          Qualifier := Configuration;
2916       end if;
2917
2918       if not Is_Config_File then
2919          Prj.Tree.Tree_Private_Part.Projects_Htable.Set
2920            (In_Tree.Projects_HT,
2921             Name,
2922             Prj.Tree.Tree_Private_Part.Project_Name_And_Node'
2923               (Name           => Name,
2924                Display_Name   => Name,
2925                Canonical_Path => No_Path,
2926                Node           => Project,
2927                Extended       => False,
2928                Proj_Qualifier => Qualifier));
2929       end if;
2930
2931       return Project;
2932    end Create_Project;
2933
2934    ----------------
2935    -- Add_At_End --
2936    ----------------
2937
2938    procedure Add_At_End
2939      (Tree                  : Project_Node_Tree_Ref;
2940       Parent                : Project_Node_Id;
2941       Expr                  : Project_Node_Id;
2942       Add_Before_First_Pkg  : Boolean := False;
2943       Add_Before_First_Case : Boolean := False)
2944    is
2945       Real_Parent          : Project_Node_Id;
2946       New_Decl, Decl, Next : Project_Node_Id;
2947       Last, L              : Project_Node_Id;
2948
2949    begin
2950       if Kind_Of (Expr, Tree) /= N_Declarative_Item then
2951          New_Decl := Default_Project_Node (Tree, N_Declarative_Item);
2952          Set_Current_Item_Node (New_Decl, Tree, Expr);
2953       else
2954          New_Decl := Expr;
2955       end if;
2956
2957       if Kind_Of (Parent, Tree) = N_Project then
2958          Real_Parent := Project_Declaration_Of (Parent, Tree);
2959       else
2960          Real_Parent := Parent;
2961       end if;
2962
2963       Decl := First_Declarative_Item_Of (Real_Parent, Tree);
2964
2965       if Decl = Empty_Node then
2966          Set_First_Declarative_Item_Of (Real_Parent, Tree, New_Decl);
2967       else
2968          loop
2969             Next := Next_Declarative_Item (Decl, Tree);
2970             exit when Next = Empty_Node
2971               or else
2972                (Add_Before_First_Pkg
2973                  and then Kind_Of (Current_Item_Node (Next, Tree), Tree) =
2974                                                         N_Package_Declaration)
2975               or else
2976                (Add_Before_First_Case
2977                  and then Kind_Of (Current_Item_Node (Next, Tree), Tree) =
2978                                                         N_Case_Construction);
2979             Decl := Next;
2980          end loop;
2981
2982          --  In case Expr is in fact a range of declarative items
2983
2984          Last := New_Decl;
2985          loop
2986             L := Next_Declarative_Item (Last, Tree);
2987             exit when L = Empty_Node;
2988             Last := L;
2989          end loop;
2990
2991          --  In case Expr is in fact a range of declarative items
2992
2993          Last := New_Decl;
2994          loop
2995             L := Next_Declarative_Item (Last, Tree);
2996             exit when L = Empty_Node;
2997             Last := L;
2998          end loop;
2999
3000          Set_Next_Declarative_Item (Last, Tree, Next);
3001          Set_Next_Declarative_Item (Decl, Tree, New_Decl);
3002       end if;
3003    end Add_At_End;
3004
3005    ---------------------------
3006    -- Create_Literal_String --
3007    ---------------------------
3008
3009    function Create_Literal_String
3010      (Str  : Namet.Name_Id;
3011       Tree : Project_Node_Tree_Ref) return Project_Node_Id
3012    is
3013       Node : Project_Node_Id;
3014    begin
3015       Node := Default_Project_Node (Tree, N_Literal_String, Prj.Single);
3016       Set_Next_Literal_String (Node, Tree, Empty_Node);
3017       Set_String_Value_Of (Node, Tree, Str);
3018       return Node;
3019    end Create_Literal_String;
3020
3021    ---------------------------
3022    -- Enclose_In_Expression --
3023    ---------------------------
3024
3025    function Enclose_In_Expression
3026      (Node : Project_Node_Id;
3027       Tree : Project_Node_Tree_Ref) return Project_Node_Id
3028    is
3029       Expr : Project_Node_Id;
3030    begin
3031       if Kind_Of (Node, Tree) /= N_Expression then
3032          Expr := Default_Project_Node (Tree, N_Expression, Single);
3033          Set_First_Term
3034            (Expr, Tree, Default_Project_Node (Tree, N_Term, Single));
3035          Set_Current_Term (First_Term (Expr, Tree), Tree, Node);
3036          return Expr;
3037       else
3038          return Node;
3039       end if;
3040    end Enclose_In_Expression;
3041
3042    --------------------
3043    -- Create_Package --
3044    --------------------
3045
3046    function Create_Package
3047      (Tree    : Project_Node_Tree_Ref;
3048       Project : Project_Node_Id;
3049       Pkg     : String) return Project_Node_Id
3050    is
3051       Pack : Project_Node_Id;
3052       N    : Name_Id;
3053
3054    begin
3055       Name_Len := Pkg'Length;
3056       Name_Buffer (1 .. Name_Len) := Pkg;
3057       N := Name_Find;
3058
3059       --  Check if the package already exists
3060
3061       Pack := First_Package_Of (Project, Tree);
3062       while Pack /= Empty_Node loop
3063          if Prj.Tree.Name_Of (Pack, Tree) = N then
3064             return Pack;
3065          end if;
3066
3067          Pack := Next_Package_In_Project (Pack, Tree);
3068       end loop;
3069
3070       --  Create the package and add it to the declarative item
3071
3072       Pack := Default_Project_Node (Tree, N_Package_Declaration);
3073       Set_Name_Of (Pack, Tree, N);
3074
3075       --  Find the correct package id to use
3076
3077       Set_Package_Id_Of (Pack, Tree, Package_Node_Id_Of (N));
3078
3079       --  Add it to the list of packages
3080
3081       Set_Next_Package_In_Project
3082         (Pack, Tree, First_Package_Of (Project, Tree));
3083       Set_First_Package_Of (Project, Tree, Pack);
3084
3085       Add_At_End (Tree, Project_Declaration_Of (Project, Tree), Pack);
3086
3087       return Pack;
3088    end Create_Package;
3089
3090    ----------------------
3091    -- Create_Attribute --
3092    ----------------------
3093
3094    function Create_Attribute
3095      (Tree       : Project_Node_Tree_Ref;
3096       Prj_Or_Pkg : Project_Node_Id;
3097       Name       : Name_Id;
3098       Index_Name : Name_Id       := No_Name;
3099       Kind       : Variable_Kind := List;
3100       At_Index   : Integer       := 0;
3101       Value      : Project_Node_Id := Empty_Node) return Project_Node_Id
3102    is
3103       Node : constant Project_Node_Id :=
3104                Default_Project_Node (Tree, N_Attribute_Declaration, Kind);
3105
3106       Case_Insensitive : Boolean;
3107
3108       Pkg      : Package_Node_Id;
3109       Start_At : Attribute_Node_Id;
3110       Expr     : Project_Node_Id;
3111
3112    begin
3113       Set_Name_Of (Node, Tree, Name);
3114
3115       if Index_Name /= No_Name then
3116          Set_Associative_Array_Index_Of (Node, Tree, Index_Name);
3117       end if;
3118
3119       if Prj_Or_Pkg /= Empty_Node then
3120          Add_At_End (Tree, Prj_Or_Pkg, Node);
3121       end if;
3122
3123       --  Find out the case sensitivity of the attribute
3124
3125       if Prj_Or_Pkg /= Empty_Node
3126         and then Kind_Of (Prj_Or_Pkg, Tree) = N_Package_Declaration
3127       then
3128          Pkg      := Prj.Attr.Package_Node_Id_Of (Name_Of (Prj_Or_Pkg, Tree));
3129          Start_At := First_Attribute_Of (Pkg);
3130       else
3131          Start_At := Attribute_First;
3132       end if;
3133
3134       Start_At := Attribute_Node_Id_Of (Name, Start_At);
3135       Case_Insensitive :=
3136         Attribute_Kind_Of (Start_At) = Case_Insensitive_Associative_Array;
3137       Tree.Project_Nodes.Table (Node).Flag1 := Case_Insensitive;
3138
3139       if At_Index /= 0 then
3140          if Attribute_Kind_Of (Start_At) =
3141               Optional_Index_Associative_Array
3142            or else Attribute_Kind_Of (Start_At) =
3143               Optional_Index_Case_Insensitive_Associative_Array
3144          then
3145             --  Results in:   for Name ("index" at index) use "value";
3146             --  This is currently only used for executables.
3147
3148             Set_Source_Index_Of (Node, Tree, To => Int (At_Index));
3149
3150          else
3151             --  Results in:   for Name ("index") use "value" at index;
3152
3153             --  ??? This limitation makes no sense, we should be able to
3154             --  set the source index on an expression.
3155
3156             pragma Assert (Kind_Of (Value, Tree) = N_Literal_String);
3157             Set_Source_Index_Of (Value, Tree, To => Int (At_Index));
3158          end if;
3159       end if;
3160
3161       if Value /= Empty_Node then
3162          Expr := Enclose_In_Expression (Value, Tree);
3163          Set_Expression_Of (Node, Tree, Expr);
3164       end if;
3165
3166       return Node;
3167    end Create_Attribute;
3168
3169 end Prj.Tree;