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