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