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          Free (Proj.Project_Path);
1004          Unchecked_Free (Proj);
1005       end if;
1006    end Free;
1007
1008    -------------------------------
1009    -- Is_Followed_By_Empty_Line --
1010    -------------------------------
1011
1012    function Is_Followed_By_Empty_Line
1013      (Node    : Project_Node_Id;
1014       In_Tree : Project_Node_Tree_Ref) return Boolean
1015    is
1016    begin
1017       pragma Assert
1018         (Present (Node)
1019           and then
1020             In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
1021       return In_Tree.Project_Nodes.Table (Node).Flag2;
1022    end Is_Followed_By_Empty_Line;
1023
1024    ----------------------
1025    -- Is_Extending_All --
1026    ----------------------
1027
1028    function Is_Extending_All
1029      (Node    : Project_Node_Id;
1030       In_Tree : Project_Node_Tree_Ref) return Boolean is
1031    begin
1032       pragma Assert
1033         (Present (Node)
1034           and then
1035            (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
1036               or else
1037             In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
1038       return In_Tree.Project_Nodes.Table (Node).Flag2;
1039    end Is_Extending_All;
1040
1041    -------------------------
1042    -- Is_Not_Last_In_List --
1043    -------------------------
1044
1045    function Is_Not_Last_In_List
1046      (Node    : Project_Node_Id;
1047       In_Tree : Project_Node_Tree_Ref) return Boolean is
1048    begin
1049       pragma Assert
1050         (Present (Node)
1051           and then
1052             In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
1053       return In_Tree.Project_Nodes.Table (Node).Flag1;
1054    end Is_Not_Last_In_List;
1055
1056    -------------------------------------
1057    -- Imported_Or_Extended_Project_Of --
1058    -------------------------------------
1059
1060    function Imported_Or_Extended_Project_Of
1061      (Project   : Project_Node_Id;
1062       In_Tree   : Project_Node_Tree_Ref;
1063       With_Name : Name_Id) return Project_Node_Id
1064    is
1065       With_Clause : Project_Node_Id :=
1066         First_With_Clause_Of (Project, In_Tree);
1067       Result      : Project_Node_Id := Empty_Node;
1068
1069    begin
1070       --  First check all the imported projects
1071
1072       while Present (With_Clause) loop
1073
1074          --  Only non limited imported project may be used as prefix
1075          --  of variable or attributes.
1076
1077          Result := Non_Limited_Project_Node_Of (With_Clause, In_Tree);
1078          exit when Present (Result)
1079            and then Name_Of (Result, In_Tree) = With_Name;
1080          With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
1081       end loop;
1082
1083       --  If it is not an imported project, it might be an extended project
1084
1085       if No (With_Clause) then
1086          Result := Project;
1087          loop
1088             Result :=
1089               Extended_Project_Of
1090                 (Project_Declaration_Of (Result, In_Tree), In_Tree);
1091
1092             exit when No (Result)
1093               or else Name_Of (Result, In_Tree) = With_Name;
1094          end loop;
1095       end if;
1096
1097       return Result;
1098    end Imported_Or_Extended_Project_Of;
1099
1100    -------------
1101    -- Kind_Of --
1102    -------------
1103
1104    function Kind_Of
1105      (Node    : Project_Node_Id;
1106       In_Tree : Project_Node_Tree_Ref) return Project_Node_Kind is
1107    begin
1108       pragma Assert (Present (Node));
1109       return In_Tree.Project_Nodes.Table (Node).Kind;
1110    end Kind_Of;
1111
1112    -----------------
1113    -- Location_Of --
1114    -----------------
1115
1116    function Location_Of
1117      (Node    : Project_Node_Id;
1118       In_Tree : Project_Node_Tree_Ref) return Source_Ptr is
1119    begin
1120       pragma Assert (Present (Node));
1121       return In_Tree.Project_Nodes.Table (Node).Location;
1122    end Location_Of;
1123
1124    -------------
1125    -- Name_Of --
1126    -------------
1127
1128    function Name_Of
1129      (Node    : Project_Node_Id;
1130       In_Tree : Project_Node_Tree_Ref) return Name_Id is
1131    begin
1132       pragma Assert (Present (Node));
1133       return In_Tree.Project_Nodes.Table (Node).Name;
1134    end Name_Of;
1135
1136    --------------------
1137    -- Next_Case_Item --
1138    --------------------
1139
1140    function Next_Case_Item
1141      (Node    : Project_Node_Id;
1142       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1143    is
1144    begin
1145       pragma Assert
1146         (Present (Node)
1147           and then
1148             In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
1149       return In_Tree.Project_Nodes.Table (Node).Field3;
1150    end Next_Case_Item;
1151
1152    ------------------
1153    -- Next_Comment --
1154    ------------------
1155
1156    function Next_Comment
1157      (Node    : Project_Node_Id;
1158       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is
1159    begin
1160       pragma Assert
1161         (Present (Node)
1162           and then
1163             In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
1164       return In_Tree.Project_Nodes.Table (Node).Comments;
1165    end Next_Comment;
1166
1167    ---------------------------
1168    -- Next_Declarative_Item --
1169    ---------------------------
1170
1171    function Next_Declarative_Item
1172      (Node    : Project_Node_Id;
1173       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1174    is
1175    begin
1176       pragma Assert
1177         (Present (Node)
1178           and then
1179             In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
1180       return In_Tree.Project_Nodes.Table (Node).Field2;
1181    end Next_Declarative_Item;
1182
1183    -----------------------------
1184    -- Next_Expression_In_List --
1185    -----------------------------
1186
1187    function Next_Expression_In_List
1188      (Node    : Project_Node_Id;
1189       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1190    is
1191    begin
1192       pragma Assert
1193         (Present (Node)
1194           and then
1195             In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
1196       return In_Tree.Project_Nodes.Table (Node).Field2;
1197    end Next_Expression_In_List;
1198
1199    -------------------------
1200    -- Next_Literal_String --
1201    -------------------------
1202
1203    function Next_Literal_String
1204      (Node    : Project_Node_Id;
1205       In_Tree : Project_Node_Tree_Ref)
1206       return Project_Node_Id
1207    is
1208    begin
1209       pragma Assert
1210         (Present (Node)
1211           and then
1212             In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String);
1213       return In_Tree.Project_Nodes.Table (Node).Field1;
1214    end Next_Literal_String;
1215
1216    -----------------------------
1217    -- Next_Package_In_Project --
1218    -----------------------------
1219
1220    function Next_Package_In_Project
1221      (Node    : Project_Node_Id;
1222       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1223    is
1224    begin
1225       pragma Assert
1226         (Present (Node)
1227           and then
1228             In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
1229       return In_Tree.Project_Nodes.Table (Node).Field3;
1230    end Next_Package_In_Project;
1231
1232    ----------------------
1233    -- Next_String_Type --
1234    ----------------------
1235
1236    function Next_String_Type
1237      (Node    : Project_Node_Id;
1238       In_Tree : Project_Node_Tree_Ref)
1239       return Project_Node_Id
1240    is
1241    begin
1242       pragma Assert
1243         (Present (Node)
1244           and then
1245          In_Tree.Project_Nodes.Table (Node).Kind =
1246            N_String_Type_Declaration);
1247       return In_Tree.Project_Nodes.Table (Node).Field2;
1248    end Next_String_Type;
1249
1250    ---------------
1251    -- Next_Term --
1252    ---------------
1253
1254    function Next_Term
1255      (Node    : Project_Node_Id;
1256       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1257    is
1258    begin
1259       pragma Assert
1260         (Present (Node)
1261           and then
1262             In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
1263       return In_Tree.Project_Nodes.Table (Node).Field2;
1264    end Next_Term;
1265
1266    -------------------
1267    -- Next_Variable --
1268    -------------------
1269
1270    function Next_Variable
1271      (Node    : Project_Node_Id;
1272       In_Tree : Project_Node_Tree_Ref)
1273       return Project_Node_Id
1274    is
1275    begin
1276       pragma Assert
1277         (Present (Node)
1278           and then
1279            (In_Tree.Project_Nodes.Table (Node).Kind =
1280               N_Typed_Variable_Declaration
1281                or else
1282             In_Tree.Project_Nodes.Table (Node).Kind =
1283               N_Variable_Declaration));
1284
1285       return In_Tree.Project_Nodes.Table (Node).Field3;
1286    end Next_Variable;
1287
1288    -------------------------
1289    -- Next_With_Clause_Of --
1290    -------------------------
1291
1292    function Next_With_Clause_Of
1293      (Node    : Project_Node_Id;
1294       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1295    is
1296    begin
1297       pragma Assert
1298         (Present (Node)
1299           and then
1300             In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
1301       return In_Tree.Project_Nodes.Table (Node).Field2;
1302    end Next_With_Clause_Of;
1303
1304    --------
1305    -- No --
1306    --------
1307
1308    function No (Node : Project_Node_Id) return Boolean is
1309    begin
1310       return Node = Empty_Node;
1311    end No;
1312
1313    ---------------------------------
1314    -- Non_Limited_Project_Node_Of --
1315    ---------------------------------
1316
1317    function Non_Limited_Project_Node_Of
1318      (Node    : Project_Node_Id;
1319       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1320    is
1321    begin
1322       pragma Assert
1323         (Present (Node)
1324           and then
1325            (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
1326       return In_Tree.Project_Nodes.Table (Node).Field3;
1327    end Non_Limited_Project_Node_Of;
1328
1329    -------------------
1330    -- Package_Id_Of --
1331    -------------------
1332
1333    function Package_Id_Of
1334      (Node    : Project_Node_Id;
1335       In_Tree : Project_Node_Tree_Ref) return Package_Node_Id
1336    is
1337    begin
1338       pragma Assert
1339         (Present (Node)
1340           and then
1341             In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
1342       return In_Tree.Project_Nodes.Table (Node).Pkg_Id;
1343    end Package_Id_Of;
1344
1345    ---------------------
1346    -- Package_Node_Of --
1347    ---------------------
1348
1349    function Package_Node_Of
1350      (Node    : Project_Node_Id;
1351       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1352    is
1353    begin
1354       pragma Assert
1355         (Present (Node)
1356           and then
1357             (In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
1358                or else
1359              In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
1360       return In_Tree.Project_Nodes.Table (Node).Field2;
1361    end Package_Node_Of;
1362
1363    ------------------
1364    -- Path_Name_Of --
1365    ------------------
1366
1367    function Path_Name_Of
1368      (Node    : Project_Node_Id;
1369       In_Tree : Project_Node_Tree_Ref) return Path_Name_Type
1370    is
1371    begin
1372       pragma Assert
1373         (Present (Node)
1374           and then
1375             (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
1376                or else
1377              In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
1378       return In_Tree.Project_Nodes.Table (Node).Path_Name;
1379    end Path_Name_Of;
1380
1381    -------------
1382    -- Present --
1383    -------------
1384
1385    function Present (Node : Project_Node_Id) return Boolean is
1386    begin
1387       return Node /= Empty_Node;
1388    end Present;
1389
1390    ----------------------------
1391    -- Project_Declaration_Of --
1392    ----------------------------
1393
1394    function Project_Declaration_Of
1395      (Node    : Project_Node_Id;
1396       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1397    is
1398    begin
1399       pragma Assert
1400         (Present (Node)
1401           and then
1402             In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
1403       return In_Tree.Project_Nodes.Table (Node).Field2;
1404    end Project_Declaration_Of;
1405
1406    --------------------------
1407    -- Project_Qualifier_Of --
1408    --------------------------
1409
1410    function Project_Qualifier_Of
1411      (Node    : Project_Node_Id;
1412       In_Tree : Project_Node_Tree_Ref) return Project_Qualifier
1413    is
1414    begin
1415       pragma Assert
1416         (Present (Node)
1417           and then
1418             In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
1419       return In_Tree.Project_Nodes.Table (Node).Qualifier;
1420    end Project_Qualifier_Of;
1421
1422    -----------------------
1423    -- Parent_Project_Of --
1424    -----------------------
1425
1426    function Parent_Project_Of
1427      (Node    : Project_Node_Id;
1428       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1429    is
1430    begin
1431       pragma Assert
1432         (Present (Node)
1433           and then
1434             In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
1435       return In_Tree.Project_Nodes.Table (Node).Field4;
1436    end Parent_Project_Of;
1437
1438    -------------------------------------------
1439    -- Project_File_Includes_Unkept_Comments --
1440    -------------------------------------------
1441
1442    function Project_File_Includes_Unkept_Comments
1443      (Node    : Project_Node_Id;
1444       In_Tree : Project_Node_Tree_Ref) return Boolean
1445    is
1446       Declaration : constant Project_Node_Id :=
1447                       Project_Declaration_Of (Node, In_Tree);
1448    begin
1449       return In_Tree.Project_Nodes.Table (Declaration).Flag1;
1450    end Project_File_Includes_Unkept_Comments;
1451
1452    ---------------------
1453    -- Project_Node_Of --
1454    ---------------------
1455
1456    function Project_Node_Of
1457      (Node    : Project_Node_Id;
1458       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1459    is
1460    begin
1461       pragma Assert
1462         (Present (Node)
1463           and then
1464            (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
1465               or else
1466             In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
1467               or else
1468             In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
1469       return In_Tree.Project_Nodes.Table (Node).Field1;
1470    end Project_Node_Of;
1471
1472    -----------------------------------
1473    -- Project_Of_Renamed_Package_Of --
1474    -----------------------------------
1475
1476    function Project_Of_Renamed_Package_Of
1477      (Node    : Project_Node_Id;
1478       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1479    is
1480    begin
1481       pragma Assert
1482         (Present (Node)
1483           and then
1484             In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
1485       return In_Tree.Project_Nodes.Table (Node).Field1;
1486    end Project_Of_Renamed_Package_Of;
1487
1488    --------------------------
1489    -- Remove_Next_End_Node --
1490    --------------------------
1491
1492    procedure Remove_Next_End_Node is
1493    begin
1494       Next_End_Nodes.Decrement_Last;
1495    end Remove_Next_End_Node;
1496
1497    -----------------
1498    -- Reset_State --
1499    -----------------
1500
1501    procedure Reset_State is
1502    begin
1503       End_Of_Line_Node   := Empty_Node;
1504       Previous_Line_Node := Empty_Node;
1505       Previous_End_Node  := Empty_Node;
1506       Unkept_Comments    := False;
1507       Comments.Set_Last (0);
1508    end Reset_State;
1509
1510    ----------------------
1511    -- Restore_And_Free --
1512    ----------------------
1513
1514    procedure Restore_And_Free (S : in out Comment_State) is
1515       procedure Unchecked_Free is new
1516         Ada.Unchecked_Deallocation (Comment_Array, Comments_Ptr);
1517
1518    begin
1519       End_Of_Line_Node   := S.End_Of_Line_Node;
1520       Previous_Line_Node := S.Previous_Line_Node;
1521       Previous_End_Node  := S.Previous_End_Node;
1522       Next_End_Nodes.Set_Last (0);
1523       Unkept_Comments    := S.Unkept_Comments;
1524
1525       Comments.Set_Last (0);
1526
1527       for J in S.Comments'Range loop
1528          Comments.Increment_Last;
1529          Comments.Table (Comments.Last) := S.Comments (J);
1530       end loop;
1531
1532       Unchecked_Free (S.Comments);
1533    end Restore_And_Free;
1534
1535    ----------
1536    -- Save --
1537    ----------
1538
1539    procedure Save (S : out Comment_State) is
1540       Cmts : constant Comments_Ptr := new Comment_Array (1 .. Comments.Last);
1541
1542    begin
1543       for J in 1 .. Comments.Last loop
1544          Cmts (J) := Comments.Table (J);
1545       end loop;
1546
1547       S :=
1548         (End_Of_Line_Node   => End_Of_Line_Node,
1549          Previous_Line_Node => Previous_Line_Node,
1550          Previous_End_Node  => Previous_End_Node,
1551          Unkept_Comments    => Unkept_Comments,
1552          Comments           => Cmts);
1553    end Save;
1554
1555    ----------
1556    -- Scan --
1557    ----------
1558
1559    procedure Scan (In_Tree : Project_Node_Tree_Ref) is
1560       Empty_Line : Boolean := False;
1561
1562    begin
1563       --  If there are comments, then they will not be kept. Set the flag and
1564       --  clear the comments.
1565
1566       if Comments.Last > 0 then
1567          Unkept_Comments := True;
1568          Comments.Set_Last (0);
1569       end if;
1570
1571       --  Loop until a token other that End_Of_Line or Comment is found
1572
1573       loop
1574          Prj.Err.Scanner.Scan;
1575
1576          case Token is
1577             when Tok_End_Of_Line =>
1578                if Prev_Token = Tok_End_Of_Line then
1579                   Empty_Line := True;
1580
1581                   if Comments.Last > 0 then
1582                      Comments.Table (Comments.Last).Is_Followed_By_Empty_Line
1583                      := True;
1584                   end if;
1585                end if;
1586
1587             when Tok_Comment =>
1588                --  If this is a line comment, add it to the comment table
1589
1590                if Prev_Token = Tok_End_Of_Line
1591                  or else Prev_Token = No_Token
1592                then
1593                   Comments.Increment_Last;
1594                   Comments.Table (Comments.Last) :=
1595                     (Value                     => Comment_Id,
1596                      Follows_Empty_Line        => Empty_Line,
1597                      Is_Followed_By_Empty_Line => False);
1598
1599                --  Otherwise, it is an end of line comment. If there is
1600                --  an end of line node specified, associate the comment with
1601                --  this node.
1602
1603                elsif Present (End_Of_Line_Node) then
1604                   declare
1605                      Zones : constant Project_Node_Id :=
1606                                Comment_Zones_Of (End_Of_Line_Node, In_Tree);
1607                   begin
1608                      In_Tree.Project_Nodes.Table (Zones).Value := Comment_Id;
1609                   end;
1610
1611                --  Otherwise, this end of line node cannot be kept
1612
1613                else
1614                   Unkept_Comments := True;
1615                   Comments.Set_Last (0);
1616                end if;
1617
1618                Empty_Line := False;
1619
1620             when others =>
1621                --  If there are comments, where the first comment is not
1622                --  following an empty line, put the initial uninterrupted
1623                --  comment zone with the node of the preceding line (either
1624                --  a Previous_Line or a Previous_End node), if any.
1625
1626                if Comments.Last > 0 and then
1627                  not Comments.Table (1).Follows_Empty_Line then
1628                   if Present (Previous_Line_Node) then
1629                      Add_Comments
1630                        (To      => Previous_Line_Node,
1631                         Where   => After,
1632                         In_Tree => In_Tree);
1633
1634                   elsif Present (Previous_End_Node) then
1635                      Add_Comments
1636                        (To      => Previous_End_Node,
1637                         Where   => After_End,
1638                         In_Tree => In_Tree);
1639                   end if;
1640                end if;
1641
1642                --  If there are still comments and the token is "end", then
1643                --  put these comments with the Next_End node, if any;
1644                --  otherwise, these comments cannot be kept. Always clear
1645                --  the comments.
1646
1647                if Comments.Last > 0 and then Token = Tok_End then
1648                   if Next_End_Nodes.Last > 0 then
1649                      Add_Comments
1650                        (To      => Next_End_Nodes.Table (Next_End_Nodes.Last),
1651                         Where   => Before_End,
1652                         In_Tree => In_Tree);
1653
1654                   else
1655                      Unkept_Comments := True;
1656                   end if;
1657
1658                   Comments.Set_Last (0);
1659                end if;
1660
1661                --  Reset the End_Of_Line, Previous_Line and Previous_End nodes
1662                --  so that they are not used again.
1663
1664                End_Of_Line_Node   := Empty_Node;
1665                Previous_Line_Node := Empty_Node;
1666                Previous_End_Node  := Empty_Node;
1667
1668                --  And return
1669
1670                exit;
1671          end case;
1672       end loop;
1673    end Scan;
1674
1675    ------------------------------------
1676    -- Set_Associative_Array_Index_Of --
1677    ------------------------------------
1678
1679    procedure Set_Associative_Array_Index_Of
1680      (Node    : Project_Node_Id;
1681       In_Tree : Project_Node_Tree_Ref;
1682       To      : Name_Id)
1683    is
1684    begin
1685       pragma Assert
1686         (Present (Node)
1687           and then
1688             (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
1689                or else
1690              In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
1691       In_Tree.Project_Nodes.Table (Node).Value := To;
1692    end Set_Associative_Array_Index_Of;
1693
1694    --------------------------------
1695    -- Set_Associative_Package_Of --
1696    --------------------------------
1697
1698    procedure Set_Associative_Package_Of
1699      (Node    : Project_Node_Id;
1700       In_Tree : Project_Node_Tree_Ref;
1701       To      : Project_Node_Id)
1702    is
1703    begin
1704       pragma Assert
1705          (Present (Node)
1706           and then
1707             In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration);
1708       In_Tree.Project_Nodes.Table (Node).Field3 := To;
1709    end Set_Associative_Package_Of;
1710
1711    --------------------------------
1712    -- Set_Associative_Project_Of --
1713    --------------------------------
1714
1715    procedure Set_Associative_Project_Of
1716      (Node    : Project_Node_Id;
1717       In_Tree : Project_Node_Tree_Ref;
1718       To      : Project_Node_Id)
1719    is
1720    begin
1721       pragma Assert
1722         (Present (Node)
1723           and then
1724            (In_Tree.Project_Nodes.Table (Node).Kind =
1725               N_Attribute_Declaration));
1726       In_Tree.Project_Nodes.Table (Node).Field2 := To;
1727    end Set_Associative_Project_Of;
1728
1729    --------------------------
1730    -- Set_Case_Insensitive --
1731    --------------------------
1732
1733    procedure Set_Case_Insensitive
1734      (Node    : Project_Node_Id;
1735       In_Tree : Project_Node_Tree_Ref;
1736       To      : Boolean)
1737    is
1738    begin
1739       pragma Assert
1740         (Present (Node)
1741           and then
1742            (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
1743                or else
1744             In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
1745       In_Tree.Project_Nodes.Table (Node).Flag1 := To;
1746    end Set_Case_Insensitive;
1747
1748    ------------------------------------
1749    -- Set_Case_Variable_Reference_Of --
1750    ------------------------------------
1751
1752    procedure Set_Case_Variable_Reference_Of
1753      (Node    : Project_Node_Id;
1754       In_Tree : Project_Node_Tree_Ref;
1755       To      : Project_Node_Id)
1756    is
1757    begin
1758       pragma Assert
1759         (Present (Node)
1760           and then
1761             In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
1762       In_Tree.Project_Nodes.Table (Node).Field1 := To;
1763    end Set_Case_Variable_Reference_Of;
1764
1765    ---------------------------
1766    -- Set_Current_Item_Node --
1767    ---------------------------
1768
1769    procedure Set_Current_Item_Node
1770      (Node    : Project_Node_Id;
1771       In_Tree : Project_Node_Tree_Ref;
1772       To      : Project_Node_Id)
1773    is
1774    begin
1775       pragma Assert
1776         (Present (Node)
1777           and then
1778             In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
1779       In_Tree.Project_Nodes.Table (Node).Field1 := To;
1780    end Set_Current_Item_Node;
1781
1782    ----------------------
1783    -- Set_Current_Term --
1784    ----------------------
1785
1786    procedure Set_Current_Term
1787      (Node    : Project_Node_Id;
1788       In_Tree : Project_Node_Tree_Ref;
1789       To      : Project_Node_Id)
1790    is
1791    begin
1792       pragma Assert
1793         (Present (Node)
1794           and then
1795             In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
1796       In_Tree.Project_Nodes.Table (Node).Field1 := To;
1797    end Set_Current_Term;
1798
1799    ----------------------
1800    -- Set_Directory_Of --
1801    ----------------------
1802
1803    procedure Set_Directory_Of
1804      (Node    : Project_Node_Id;
1805       In_Tree : Project_Node_Tree_Ref;
1806       To      : Path_Name_Type)
1807    is
1808    begin
1809       pragma Assert
1810         (Present (Node)
1811           and then
1812             In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
1813       In_Tree.Project_Nodes.Table (Node).Directory := To;
1814    end Set_Directory_Of;
1815
1816    ---------------------
1817    -- Set_End_Of_Line --
1818    ---------------------
1819
1820    procedure Set_End_Of_Line (To : Project_Node_Id) is
1821    begin
1822       End_Of_Line_Node := To;
1823    end Set_End_Of_Line;
1824
1825    ----------------------------
1826    -- Set_Expression_Kind_Of --
1827    ----------------------------
1828
1829    procedure Set_Expression_Kind_Of
1830      (Node    : Project_Node_Id;
1831       In_Tree : Project_Node_Tree_Ref;
1832       To      : Variable_Kind)
1833    is
1834    begin
1835       pragma Assert
1836         (Present (Node)
1837            and then
1838              (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
1839                 or else
1840               In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
1841                 or else
1842               In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Declaration
1843                 or else
1844               In_Tree.Project_Nodes.Table (Node).Kind =
1845                 N_Typed_Variable_Declaration
1846                 or else
1847               In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration
1848                 or else
1849               In_Tree.Project_Nodes.Table (Node).Kind = N_Expression
1850                 or else
1851               In_Tree.Project_Nodes.Table (Node).Kind = N_Term
1852                 or else
1853               In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
1854                 or else
1855               In_Tree.Project_Nodes.Table (Node).Kind =
1856                 N_Attribute_Reference));
1857       In_Tree.Project_Nodes.Table (Node).Expr_Kind := To;
1858    end Set_Expression_Kind_Of;
1859
1860    -----------------------
1861    -- Set_Expression_Of --
1862    -----------------------
1863
1864    procedure Set_Expression_Of
1865      (Node    : Project_Node_Id;
1866       In_Tree : Project_Node_Tree_Ref;
1867       To      : Project_Node_Id)
1868    is
1869    begin
1870       pragma Assert
1871         (Present (Node)
1872           and then
1873            (In_Tree.Project_Nodes.Table (Node).Kind =
1874               N_Attribute_Declaration
1875                or else
1876             In_Tree.Project_Nodes.Table (Node).Kind =
1877               N_Typed_Variable_Declaration
1878                or else
1879             In_Tree.Project_Nodes.Table (Node).Kind =
1880               N_Variable_Declaration));
1881       In_Tree.Project_Nodes.Table (Node).Field1 := To;
1882    end Set_Expression_Of;
1883
1884    -------------------------------
1885    -- Set_External_Reference_Of --
1886    -------------------------------
1887
1888    procedure Set_External_Reference_Of
1889      (Node    : Project_Node_Id;
1890       In_Tree : Project_Node_Tree_Ref;
1891       To      : Project_Node_Id)
1892    is
1893    begin
1894       pragma Assert
1895         (Present (Node)
1896           and then
1897             In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
1898       In_Tree.Project_Nodes.Table (Node).Field1 := To;
1899    end Set_External_Reference_Of;
1900
1901    -----------------------------
1902    -- Set_External_Default_Of --
1903    -----------------------------
1904
1905    procedure Set_External_Default_Of
1906      (Node    : Project_Node_Id;
1907       In_Tree : Project_Node_Tree_Ref;
1908       To      : Project_Node_Id)
1909    is
1910    begin
1911       pragma Assert
1912         (Present (Node)
1913           and then
1914             In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
1915       In_Tree.Project_Nodes.Table (Node).Field2 := To;
1916    end Set_External_Default_Of;
1917
1918    ----------------------------
1919    -- Set_First_Case_Item_Of --
1920    ----------------------------
1921
1922    procedure Set_First_Case_Item_Of
1923      (Node    : Project_Node_Id;
1924       In_Tree : Project_Node_Tree_Ref;
1925       To      : Project_Node_Id)
1926    is
1927    begin
1928       pragma Assert
1929         (Present (Node)
1930           and then
1931             In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
1932       In_Tree.Project_Nodes.Table (Node).Field2 := To;
1933    end Set_First_Case_Item_Of;
1934
1935    -------------------------
1936    -- Set_First_Choice_Of --
1937    -------------------------
1938
1939    procedure Set_First_Choice_Of
1940      (Node    : Project_Node_Id;
1941       In_Tree : Project_Node_Tree_Ref;
1942       To      : Project_Node_Id)
1943    is
1944    begin
1945       pragma Assert
1946         (Present (Node)
1947           and then
1948             In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
1949       In_Tree.Project_Nodes.Table (Node).Field1 := To;
1950    end Set_First_Choice_Of;
1951
1952    -----------------------------
1953    -- Set_First_Comment_After --
1954    -----------------------------
1955
1956    procedure Set_First_Comment_After
1957      (Node    : Project_Node_Id;
1958       In_Tree : Project_Node_Tree_Ref;
1959       To      : Project_Node_Id)
1960    is
1961       Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree);
1962    begin
1963       In_Tree.Project_Nodes.Table (Zone).Field2 := To;
1964    end Set_First_Comment_After;
1965
1966    ---------------------------------
1967    -- Set_First_Comment_After_End --
1968    ---------------------------------
1969
1970    procedure Set_First_Comment_After_End
1971      (Node    : Project_Node_Id;
1972       In_Tree : Project_Node_Tree_Ref;
1973       To      : Project_Node_Id)
1974    is
1975       Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree);
1976    begin
1977       In_Tree.Project_Nodes.Table (Zone).Comments := To;
1978    end Set_First_Comment_After_End;
1979
1980    ------------------------------
1981    -- Set_First_Comment_Before --
1982    ------------------------------
1983
1984    procedure Set_First_Comment_Before
1985      (Node    : Project_Node_Id;
1986       In_Tree : Project_Node_Tree_Ref;
1987       To      : Project_Node_Id)
1988
1989    is
1990       Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree);
1991    begin
1992       In_Tree.Project_Nodes.Table (Zone).Field1 := To;
1993    end Set_First_Comment_Before;
1994
1995    ----------------------------------
1996    -- Set_First_Comment_Before_End --
1997    ----------------------------------
1998
1999    procedure Set_First_Comment_Before_End
2000      (Node    : Project_Node_Id;
2001       In_Tree : Project_Node_Tree_Ref;
2002       To      : Project_Node_Id)
2003    is
2004       Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree);
2005    begin
2006       In_Tree.Project_Nodes.Table (Zone).Field2 := To;
2007    end Set_First_Comment_Before_End;
2008
2009    ------------------------
2010    -- Set_Next_Case_Item --
2011    ------------------------
2012
2013    procedure Set_Next_Case_Item
2014      (Node    : Project_Node_Id;
2015       In_Tree : Project_Node_Tree_Ref;
2016       To      : Project_Node_Id)
2017    is
2018    begin
2019       pragma Assert
2020         (Present (Node)
2021           and then
2022             In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
2023       In_Tree.Project_Nodes.Table (Node).Field3 := To;
2024    end Set_Next_Case_Item;
2025
2026    ----------------------
2027    -- Set_Next_Comment --
2028    ----------------------
2029
2030    procedure Set_Next_Comment
2031      (Node    : Project_Node_Id;
2032       In_Tree : Project_Node_Tree_Ref;
2033       To      : Project_Node_Id)
2034    is
2035    begin
2036       pragma Assert
2037         (Present (Node)
2038           and then
2039             In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
2040       In_Tree.Project_Nodes.Table (Node).Comments := To;
2041    end Set_Next_Comment;
2042
2043    -----------------------------------
2044    -- Set_First_Declarative_Item_Of --
2045    -----------------------------------
2046
2047    procedure Set_First_Declarative_Item_Of
2048      (Node    : Project_Node_Id;
2049       In_Tree : Project_Node_Tree_Ref;
2050       To      : Project_Node_Id)
2051    is
2052    begin
2053       pragma Assert
2054         (Present (Node)
2055           and then
2056             (In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration
2057                or else
2058              In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item
2059                or else
2060              In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration));
2061
2062       if In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration then
2063          In_Tree.Project_Nodes.Table (Node).Field1 := To;
2064       else
2065          In_Tree.Project_Nodes.Table (Node).Field2 := To;
2066       end if;
2067    end Set_First_Declarative_Item_Of;
2068
2069    ----------------------------------
2070    -- Set_First_Expression_In_List --
2071    ----------------------------------
2072
2073    procedure Set_First_Expression_In_List
2074      (Node    : Project_Node_Id;
2075       In_Tree : Project_Node_Tree_Ref;
2076       To      : Project_Node_Id)
2077    is
2078    begin
2079       pragma Assert
2080         (Present (Node)
2081           and then
2082             In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String_List);
2083       In_Tree.Project_Nodes.Table (Node).Field1 := To;
2084    end Set_First_Expression_In_List;
2085
2086    ------------------------------
2087    -- Set_First_Literal_String --
2088    ------------------------------
2089
2090    procedure Set_First_Literal_String
2091      (Node    : Project_Node_Id;
2092       In_Tree : Project_Node_Tree_Ref;
2093       To      : Project_Node_Id)
2094    is
2095    begin
2096       pragma Assert
2097         (Present (Node)
2098           and then
2099          In_Tree.Project_Nodes.Table (Node).Kind =
2100            N_String_Type_Declaration);
2101       In_Tree.Project_Nodes.Table (Node).Field1 := To;
2102    end Set_First_Literal_String;
2103
2104    --------------------------
2105    -- Set_First_Package_Of --
2106    --------------------------
2107
2108    procedure Set_First_Package_Of
2109      (Node    : Project_Node_Id;
2110       In_Tree : Project_Node_Tree_Ref;
2111       To      : Package_Declaration_Id)
2112    is
2113    begin
2114       pragma Assert
2115         (Present (Node)
2116           and then
2117             In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2118       In_Tree.Project_Nodes.Table (Node).Packages := To;
2119    end Set_First_Package_Of;
2120
2121    ------------------------------
2122    -- Set_First_String_Type_Of --
2123    ------------------------------
2124
2125    procedure Set_First_String_Type_Of
2126      (Node    : Project_Node_Id;
2127       In_Tree : Project_Node_Tree_Ref;
2128       To      : Project_Node_Id)
2129    is
2130    begin
2131       pragma Assert
2132         (Present (Node)
2133           and then
2134             In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2135       In_Tree.Project_Nodes.Table (Node).Field3 := To;
2136    end Set_First_String_Type_Of;
2137
2138    --------------------
2139    -- Set_First_Term --
2140    --------------------
2141
2142    procedure Set_First_Term
2143      (Node    : Project_Node_Id;
2144       In_Tree : Project_Node_Tree_Ref;
2145       To      : Project_Node_Id)
2146    is
2147    begin
2148       pragma Assert
2149         (Present (Node)
2150           and then
2151             In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
2152       In_Tree.Project_Nodes.Table (Node).Field1 := To;
2153    end Set_First_Term;
2154
2155    ---------------------------
2156    -- Set_First_Variable_Of --
2157    ---------------------------
2158
2159    procedure Set_First_Variable_Of
2160      (Node    : Project_Node_Id;
2161       In_Tree : Project_Node_Tree_Ref;
2162       To      : Variable_Node_Id)
2163    is
2164    begin
2165       pragma Assert
2166         (Present (Node)
2167           and then
2168             (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
2169                or else
2170              In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration));
2171       In_Tree.Project_Nodes.Table (Node).Variables := To;
2172    end Set_First_Variable_Of;
2173
2174    ------------------------------
2175    -- Set_First_With_Clause_Of --
2176    ------------------------------
2177
2178    procedure Set_First_With_Clause_Of
2179      (Node    : Project_Node_Id;
2180       In_Tree : Project_Node_Tree_Ref;
2181       To      : Project_Node_Id)
2182    is
2183    begin
2184       pragma Assert
2185         (Present (Node)
2186           and then
2187             In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2188       In_Tree.Project_Nodes.Table (Node).Field1 := To;
2189    end Set_First_With_Clause_Of;
2190
2191    --------------------------
2192    -- Set_Is_Extending_All --
2193    --------------------------
2194
2195    procedure Set_Is_Extending_All
2196      (Node    : Project_Node_Id;
2197       In_Tree : Project_Node_Tree_Ref)
2198    is
2199    begin
2200       pragma Assert
2201         (Present (Node)
2202           and then
2203             (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
2204                or else
2205              In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
2206       In_Tree.Project_Nodes.Table (Node).Flag2 := True;
2207    end Set_Is_Extending_All;
2208
2209    -----------------------------
2210    -- Set_Is_Not_Last_In_List --
2211    -----------------------------
2212
2213    procedure Set_Is_Not_Last_In_List
2214      (Node    : Project_Node_Id;
2215       In_Tree : Project_Node_Tree_Ref)
2216    is
2217    begin
2218       pragma Assert
2219         (Present (Node)
2220           and then
2221              In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
2222       In_Tree.Project_Nodes.Table (Node).Flag1 := True;
2223    end Set_Is_Not_Last_In_List;
2224
2225    -----------------
2226    -- Set_Kind_Of --
2227    -----------------
2228
2229    procedure Set_Kind_Of
2230      (Node    : Project_Node_Id;
2231       In_Tree : Project_Node_Tree_Ref;
2232       To      : Project_Node_Kind)
2233    is
2234    begin
2235       pragma Assert (Present (Node));
2236       In_Tree.Project_Nodes.Table (Node).Kind := To;
2237    end Set_Kind_Of;
2238
2239    ---------------------
2240    -- Set_Location_Of --
2241    ---------------------
2242
2243    procedure Set_Location_Of
2244      (Node    : Project_Node_Id;
2245       In_Tree : Project_Node_Tree_Ref;
2246       To      : Source_Ptr)
2247    is
2248    begin
2249       pragma Assert (Present (Node));
2250       In_Tree.Project_Nodes.Table (Node).Location := To;
2251    end Set_Location_Of;
2252
2253    -----------------------------
2254    -- Set_Extended_Project_Of --
2255    -----------------------------
2256
2257    procedure Set_Extended_Project_Of
2258      (Node    : Project_Node_Id;
2259       In_Tree : Project_Node_Tree_Ref;
2260       To      : Project_Node_Id)
2261    is
2262    begin
2263       pragma Assert
2264         (Present (Node)
2265           and then
2266             In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
2267       In_Tree.Project_Nodes.Table (Node).Field2 := To;
2268    end Set_Extended_Project_Of;
2269
2270    ----------------------------------
2271    -- Set_Extended_Project_Path_Of --
2272    ----------------------------------
2273
2274    procedure Set_Extended_Project_Path_Of
2275      (Node    : Project_Node_Id;
2276       In_Tree : Project_Node_Tree_Ref;
2277       To      : Path_Name_Type)
2278    is
2279    begin
2280       pragma Assert
2281         (Present (Node)
2282           and then
2283             In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2284       In_Tree.Project_Nodes.Table (Node).Value := Name_Id (To);
2285    end Set_Extended_Project_Path_Of;
2286
2287    ------------------------------
2288    -- Set_Extending_Project_Of --
2289    ------------------------------
2290
2291    procedure Set_Extending_Project_Of
2292      (Node    : Project_Node_Id;
2293       In_Tree : Project_Node_Tree_Ref;
2294       To      : Project_Node_Id)
2295    is
2296    begin
2297       pragma Assert
2298         (Present (Node)
2299           and then
2300             In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
2301       In_Tree.Project_Nodes.Table (Node).Field3 := To;
2302    end Set_Extending_Project_Of;
2303
2304    -----------------
2305    -- Set_Name_Of --
2306    -----------------
2307
2308    procedure Set_Name_Of
2309      (Node    : Project_Node_Id;
2310       In_Tree : Project_Node_Tree_Ref;
2311       To      : Name_Id)
2312    is
2313    begin
2314       pragma Assert (Present (Node));
2315       In_Tree.Project_Nodes.Table (Node).Name := To;
2316    end Set_Name_Of;
2317
2318    -------------------------------
2319    -- Set_Next_Declarative_Item --
2320    -------------------------------
2321
2322    procedure Set_Next_Declarative_Item
2323      (Node    : Project_Node_Id;
2324       In_Tree : Project_Node_Tree_Ref;
2325       To      : Project_Node_Id)
2326    is
2327    begin
2328       pragma Assert
2329         (Present (Node)
2330           and then
2331             In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
2332       In_Tree.Project_Nodes.Table (Node).Field2 := To;
2333    end Set_Next_Declarative_Item;
2334
2335    -----------------------
2336    -- Set_Next_End_Node --
2337    -----------------------
2338
2339    procedure Set_Next_End_Node (To : Project_Node_Id) is
2340    begin
2341       Next_End_Nodes.Increment_Last;
2342       Next_End_Nodes.Table (Next_End_Nodes.Last) := To;
2343    end Set_Next_End_Node;
2344
2345    ---------------------------------
2346    -- Set_Next_Expression_In_List --
2347    ---------------------------------
2348
2349    procedure Set_Next_Expression_In_List
2350      (Node    : Project_Node_Id;
2351       In_Tree : Project_Node_Tree_Ref;
2352       To      : Project_Node_Id)
2353    is
2354    begin
2355       pragma Assert
2356         (Present (Node)
2357           and then
2358             In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
2359       In_Tree.Project_Nodes.Table (Node).Field2 := To;
2360    end Set_Next_Expression_In_List;
2361
2362    -----------------------------
2363    -- Set_Next_Literal_String --
2364    -----------------------------
2365
2366    procedure Set_Next_Literal_String
2367      (Node    : Project_Node_Id;
2368       In_Tree : Project_Node_Tree_Ref;
2369       To      : Project_Node_Id)
2370    is
2371    begin
2372       pragma Assert
2373         (Present (Node)
2374           and then
2375             In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String);
2376       In_Tree.Project_Nodes.Table (Node).Field1 := To;
2377    end Set_Next_Literal_String;
2378
2379    ---------------------------------
2380    -- Set_Next_Package_In_Project --
2381    ---------------------------------
2382
2383    procedure Set_Next_Package_In_Project
2384      (Node    : Project_Node_Id;
2385       In_Tree : Project_Node_Tree_Ref;
2386       To      : Project_Node_Id)
2387    is
2388    begin
2389       pragma Assert
2390         (Present (Node)
2391           and then
2392             In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
2393       In_Tree.Project_Nodes.Table (Node).Field3 := To;
2394    end Set_Next_Package_In_Project;
2395
2396    --------------------------
2397    -- Set_Next_String_Type --
2398    --------------------------
2399
2400    procedure Set_Next_String_Type
2401      (Node    : Project_Node_Id;
2402       In_Tree : Project_Node_Tree_Ref;
2403       To      : Project_Node_Id)
2404    is
2405    begin
2406       pragma Assert
2407         (Present (Node)
2408           and then
2409          In_Tree.Project_Nodes.Table (Node).Kind =
2410            N_String_Type_Declaration);
2411       In_Tree.Project_Nodes.Table (Node).Field2 := To;
2412    end Set_Next_String_Type;
2413
2414    -------------------
2415    -- Set_Next_Term --
2416    -------------------
2417
2418    procedure Set_Next_Term
2419      (Node    : Project_Node_Id;
2420       In_Tree : Project_Node_Tree_Ref;
2421       To      : Project_Node_Id)
2422    is
2423    begin
2424       pragma Assert
2425         (Present (Node)
2426           and then
2427             In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
2428       In_Tree.Project_Nodes.Table (Node).Field2 := To;
2429    end Set_Next_Term;
2430
2431    -----------------------
2432    -- Set_Next_Variable --
2433    -----------------------
2434
2435    procedure Set_Next_Variable
2436      (Node    : Project_Node_Id;
2437       In_Tree : Project_Node_Tree_Ref;
2438       To      : Project_Node_Id)
2439    is
2440    begin
2441       pragma Assert
2442         (Present (Node)
2443           and then
2444            (In_Tree.Project_Nodes.Table (Node).Kind =
2445               N_Typed_Variable_Declaration
2446                or else
2447             In_Tree.Project_Nodes.Table (Node).Kind =
2448               N_Variable_Declaration));
2449       In_Tree.Project_Nodes.Table (Node).Field3 := To;
2450    end Set_Next_Variable;
2451
2452    -----------------------------
2453    -- Set_Next_With_Clause_Of --
2454    -----------------------------
2455
2456    procedure Set_Next_With_Clause_Of
2457      (Node    : Project_Node_Id;
2458       In_Tree : Project_Node_Tree_Ref;
2459       To      : Project_Node_Id)
2460    is
2461    begin
2462       pragma Assert
2463         (Present (Node)
2464           and then
2465             In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
2466       In_Tree.Project_Nodes.Table (Node).Field2 := To;
2467    end Set_Next_With_Clause_Of;
2468
2469    -----------------------
2470    -- Set_Package_Id_Of --
2471    -----------------------
2472
2473    procedure Set_Package_Id_Of
2474      (Node    : Project_Node_Id;
2475       In_Tree : Project_Node_Tree_Ref;
2476       To      : Package_Node_Id)
2477    is
2478    begin
2479       pragma Assert
2480         (Present (Node)
2481           and then
2482             In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
2483       In_Tree.Project_Nodes.Table (Node).Pkg_Id := To;
2484    end Set_Package_Id_Of;
2485
2486    -------------------------
2487    -- Set_Package_Node_Of --
2488    -------------------------
2489
2490    procedure Set_Package_Node_Of
2491      (Node    : Project_Node_Id;
2492       In_Tree : Project_Node_Tree_Ref;
2493       To      : Project_Node_Id)
2494    is
2495    begin
2496       pragma Assert
2497         (Present (Node)
2498           and then
2499             (In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
2500                or else
2501              In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
2502       In_Tree.Project_Nodes.Table (Node).Field2 := To;
2503    end Set_Package_Node_Of;
2504
2505    ----------------------
2506    -- Set_Path_Name_Of --
2507    ----------------------
2508
2509    procedure Set_Path_Name_Of
2510      (Node    : Project_Node_Id;
2511       In_Tree : Project_Node_Tree_Ref;
2512       To      : Path_Name_Type)
2513    is
2514    begin
2515       pragma Assert
2516         (Present (Node)
2517           and then
2518             (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
2519                or else
2520              In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
2521       In_Tree.Project_Nodes.Table (Node).Path_Name := To;
2522    end Set_Path_Name_Of;
2523
2524    ---------------------------
2525    -- Set_Previous_End_Node --
2526    ---------------------------
2527    procedure Set_Previous_End_Node (To : Project_Node_Id) is
2528    begin
2529       Previous_End_Node := To;
2530    end Set_Previous_End_Node;
2531
2532    ----------------------------
2533    -- Set_Previous_Line_Node --
2534    ----------------------------
2535
2536    procedure Set_Previous_Line_Node (To : Project_Node_Id) is
2537    begin
2538       Previous_Line_Node := To;
2539    end Set_Previous_Line_Node;
2540
2541    --------------------------------
2542    -- Set_Project_Declaration_Of --
2543    --------------------------------
2544
2545    procedure Set_Project_Declaration_Of
2546      (Node    : Project_Node_Id;
2547       In_Tree : Project_Node_Tree_Ref;
2548       To      : Project_Node_Id)
2549    is
2550    begin
2551       pragma Assert
2552         (Present (Node)
2553          and then
2554            In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2555       In_Tree.Project_Nodes.Table (Node).Field2 := To;
2556    end Set_Project_Declaration_Of;
2557
2558    ------------------------------
2559    -- Set_Project_Qualifier_Of --
2560    ------------------------------
2561
2562    procedure Set_Project_Qualifier_Of
2563      (Node    : Project_Node_Id;
2564       In_Tree : Project_Node_Tree_Ref;
2565       To      : Project_Qualifier)
2566    is
2567    begin
2568       pragma Assert
2569         (Present (Node)
2570           and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2571       In_Tree.Project_Nodes.Table (Node).Qualifier := To;
2572    end Set_Project_Qualifier_Of;
2573
2574    ---------------------------
2575    -- Set_Parent_Project_Of --
2576    ---------------------------
2577
2578    procedure Set_Parent_Project_Of
2579      (Node    : Project_Node_Id;
2580       In_Tree : Project_Node_Tree_Ref;
2581       To      : Project_Node_Id)
2582    is
2583    begin
2584       pragma Assert
2585         (Present (Node)
2586           and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2587       In_Tree.Project_Nodes.Table (Node).Field4 := To;
2588    end Set_Parent_Project_Of;
2589
2590    -----------------------------------------------
2591    -- Set_Project_File_Includes_Unkept_Comments --
2592    -----------------------------------------------
2593
2594    procedure Set_Project_File_Includes_Unkept_Comments
2595      (Node    : Project_Node_Id;
2596       In_Tree : Project_Node_Tree_Ref;
2597       To      : Boolean)
2598    is
2599       Declaration : constant Project_Node_Id :=
2600                       Project_Declaration_Of (Node, In_Tree);
2601    begin
2602       In_Tree.Project_Nodes.Table (Declaration).Flag1 := To;
2603    end Set_Project_File_Includes_Unkept_Comments;
2604
2605    -------------------------
2606    -- Set_Project_Node_Of --
2607    -------------------------
2608
2609    procedure Set_Project_Node_Of
2610      (Node         : Project_Node_Id;
2611       In_Tree      : Project_Node_Tree_Ref;
2612       To           : Project_Node_Id;
2613       Limited_With : Boolean := False)
2614    is
2615    begin
2616       pragma Assert
2617         (Present (Node)
2618           and then
2619             (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
2620                or else
2621              In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
2622                or else
2623              In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
2624       In_Tree.Project_Nodes.Table (Node).Field1 := To;
2625
2626       if In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
2627         and then not Limited_With
2628       then
2629          In_Tree.Project_Nodes.Table (Node).Field3 := To;
2630       end if;
2631    end Set_Project_Node_Of;
2632
2633    ---------------------------------------
2634    -- Set_Project_Of_Renamed_Package_Of --
2635    ---------------------------------------
2636
2637    procedure Set_Project_Of_Renamed_Package_Of
2638      (Node    : Project_Node_Id;
2639       In_Tree : Project_Node_Tree_Ref;
2640       To      : Project_Node_Id)
2641    is
2642    begin
2643       pragma Assert
2644         (Present (Node)
2645           and then
2646             In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
2647       In_Tree.Project_Nodes.Table (Node).Field1 := To;
2648    end Set_Project_Of_Renamed_Package_Of;
2649
2650    -------------------------
2651    -- Set_Source_Index_Of --
2652    -------------------------
2653
2654    procedure Set_Source_Index_Of
2655      (Node    : Project_Node_Id;
2656       In_Tree : Project_Node_Tree_Ref;
2657       To      : Int)
2658    is
2659    begin
2660       pragma Assert
2661         (Present (Node)
2662           and then
2663            (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
2664             or else
2665             In_Tree.Project_Nodes.Table (Node).Kind =
2666               N_Attribute_Declaration));
2667       In_Tree.Project_Nodes.Table (Node).Src_Index := To;
2668    end Set_Source_Index_Of;
2669
2670    ------------------------
2671    -- Set_String_Type_Of --
2672    ------------------------
2673
2674    procedure Set_String_Type_Of
2675      (Node    : Project_Node_Id;
2676       In_Tree : Project_Node_Tree_Ref;
2677       To      : Project_Node_Id)
2678    is
2679    begin
2680       pragma Assert
2681         (Present (Node)
2682           and then
2683            (In_Tree.Project_Nodes.Table (Node).Kind =
2684               N_Variable_Reference
2685                or else
2686             In_Tree.Project_Nodes.Table (Node).Kind =
2687               N_Typed_Variable_Declaration)
2688           and then
2689             In_Tree.Project_Nodes.Table (To).Kind = N_String_Type_Declaration);
2690
2691       if In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference then
2692          In_Tree.Project_Nodes.Table (Node).Field3 := To;
2693       else
2694          In_Tree.Project_Nodes.Table (Node).Field2 := To;
2695       end if;
2696    end Set_String_Type_Of;
2697
2698    -------------------------
2699    -- Set_String_Value_Of --
2700    -------------------------
2701
2702    procedure Set_String_Value_Of
2703      (Node    : Project_Node_Id;
2704       In_Tree : Project_Node_Tree_Ref;
2705       To      : Name_Id)
2706    is
2707    begin
2708       pragma Assert
2709         (Present (Node)
2710           and then
2711             (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
2712                or else
2713              In_Tree.Project_Nodes.Table (Node).Kind = N_Comment
2714                or else
2715              In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String));
2716       In_Tree.Project_Nodes.Table (Node).Value := To;
2717    end Set_String_Value_Of;
2718
2719    ---------------------
2720    -- Source_Index_Of --
2721    ---------------------
2722
2723    function Source_Index_Of
2724      (Node    : Project_Node_Id;
2725       In_Tree : Project_Node_Tree_Ref) return Int
2726    is
2727    begin
2728       pragma Assert
2729         (Present (Node)
2730           and then
2731             (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
2732               or else
2733              In_Tree.Project_Nodes.Table (Node).Kind =
2734                N_Attribute_Declaration));
2735       return In_Tree.Project_Nodes.Table (Node).Src_Index;
2736    end Source_Index_Of;
2737
2738    --------------------
2739    -- String_Type_Of --
2740    --------------------
2741
2742    function String_Type_Of
2743      (Node    : Project_Node_Id;
2744       In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
2745    is
2746    begin
2747       pragma Assert
2748         (Present (Node)
2749           and then
2750            (In_Tree.Project_Nodes.Table (Node).Kind =
2751               N_Variable_Reference
2752                or else
2753             In_Tree.Project_Nodes.Table (Node).Kind =
2754               N_Typed_Variable_Declaration));
2755
2756       if In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference then
2757          return In_Tree.Project_Nodes.Table (Node).Field3;
2758       else
2759          return In_Tree.Project_Nodes.Table (Node).Field2;
2760       end if;
2761    end String_Type_Of;
2762
2763    ---------------------
2764    -- String_Value_Of --
2765    ---------------------
2766
2767    function String_Value_Of
2768      (Node    : Project_Node_Id;
2769       In_Tree : Project_Node_Tree_Ref) return Name_Id
2770    is
2771    begin
2772       pragma Assert
2773         (Present (Node)
2774           and then
2775            (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
2776               or else
2777             In_Tree.Project_Nodes.Table (Node).Kind = N_Comment
2778                or else
2779             In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String));
2780       return In_Tree.Project_Nodes.Table (Node).Value;
2781    end String_Value_Of;
2782
2783    --------------------
2784    -- Value_Is_Valid --
2785    --------------------
2786
2787    function Value_Is_Valid
2788      (For_Typed_Variable : Project_Node_Id;
2789       In_Tree            : Project_Node_Tree_Ref;
2790       Value              : Name_Id) return Boolean
2791    is
2792    begin
2793       pragma Assert
2794         (Present (For_Typed_Variable)
2795           and then
2796            (In_Tree.Project_Nodes.Table (For_Typed_Variable).Kind =
2797                                      N_Typed_Variable_Declaration));
2798
2799       declare
2800          Current_String : Project_Node_Id :=
2801                             First_Literal_String
2802                               (String_Type_Of (For_Typed_Variable, In_Tree),
2803                                In_Tree);
2804
2805       begin
2806          while Present (Current_String)
2807            and then
2808              String_Value_Of (Current_String, In_Tree) /= Value
2809          loop
2810             Current_String :=
2811               Next_Literal_String (Current_String, In_Tree);
2812          end loop;
2813
2814          return Present (Current_String);
2815       end;
2816
2817    end Value_Is_Valid;
2818
2819    -------------------------------
2820    -- There_Are_Unkept_Comments --
2821    -------------------------------
2822
2823    function There_Are_Unkept_Comments return Boolean is
2824    begin
2825       return Unkept_Comments;
2826    end There_Are_Unkept_Comments;
2827
2828    --------------------
2829    -- Create_Project --
2830    --------------------
2831
2832    function Create_Project
2833      (In_Tree        : Project_Node_Tree_Ref;
2834       Name           : Name_Id;
2835       Full_Path      : Path_Name_Type;
2836       Is_Config_File : Boolean := False) return Project_Node_Id
2837    is
2838       Project   : Project_Node_Id;
2839       Qualifier : Project_Qualifier := Unspecified;
2840    begin
2841       Project := Default_Project_Node (In_Tree, N_Project);
2842       Set_Name_Of (Project, In_Tree, Name);
2843       Set_Directory_Of
2844         (Project, In_Tree,
2845          Path_Name_Type (Get_Directory (File_Name_Type (Full_Path))));
2846       Set_Path_Name_Of (Project, In_Tree, Full_Path);
2847
2848       Set_Project_Declaration_Of
2849         (Project, In_Tree,
2850          Default_Project_Node (In_Tree, N_Project_Declaration));
2851
2852       if Is_Config_File then
2853          Qualifier := Configuration;
2854       end if;
2855
2856       if not Is_Config_File then
2857          Prj.Tree.Tree_Private_Part.Projects_Htable.Set
2858            (In_Tree.Projects_HT,
2859             Name,
2860             Prj.Tree.Tree_Private_Part.Project_Name_And_Node'
2861               (Name           => Name,
2862                Display_Name   => Name,
2863                Canonical_Path => No_Path,
2864                Node           => Project,
2865                Extended       => False,
2866                Proj_Qualifier => Qualifier));
2867       end if;
2868
2869       return Project;
2870    end Create_Project;
2871
2872    ----------------
2873    -- Add_At_End --
2874    ----------------
2875
2876    procedure Add_At_End
2877      (Tree                  : Project_Node_Tree_Ref;
2878       Parent                : Project_Node_Id;
2879       Expr                  : Project_Node_Id;
2880       Add_Before_First_Pkg  : Boolean := False;
2881       Add_Before_First_Case : Boolean := False)
2882    is
2883       Real_Parent          : Project_Node_Id;
2884       New_Decl, Decl, Next : Project_Node_Id;
2885       Last, L              : Project_Node_Id;
2886
2887    begin
2888       if Kind_Of (Expr, Tree) /= N_Declarative_Item then
2889          New_Decl := Default_Project_Node (Tree, N_Declarative_Item);
2890          Set_Current_Item_Node (New_Decl, Tree, Expr);
2891       else
2892          New_Decl := Expr;
2893       end if;
2894
2895       if Kind_Of (Parent, Tree) = N_Project then
2896          Real_Parent := Project_Declaration_Of (Parent, Tree);
2897       else
2898          Real_Parent := Parent;
2899       end if;
2900
2901       Decl := First_Declarative_Item_Of (Real_Parent, Tree);
2902
2903       if Decl = Empty_Node then
2904          Set_First_Declarative_Item_Of (Real_Parent, Tree, New_Decl);
2905       else
2906          loop
2907             Next := Next_Declarative_Item (Decl, Tree);
2908             exit when Next = Empty_Node
2909               or else
2910                (Add_Before_First_Pkg
2911                  and then Kind_Of (Current_Item_Node (Next, Tree), Tree) =
2912                                                         N_Package_Declaration)
2913               or else
2914                (Add_Before_First_Case
2915                  and then Kind_Of (Current_Item_Node (Next, Tree), Tree) =
2916                                                         N_Case_Construction);
2917             Decl := Next;
2918          end loop;
2919
2920          --  In case Expr is in fact a range of declarative items
2921
2922          Last := New_Decl;
2923          loop
2924             L := Next_Declarative_Item (Last, Tree);
2925             exit when L = Empty_Node;
2926             Last := L;
2927          end loop;
2928
2929          --  In case Expr is in fact a range of declarative items
2930
2931          Last := New_Decl;
2932          loop
2933             L := Next_Declarative_Item (Last, Tree);
2934             exit when L = Empty_Node;
2935             Last := L;
2936          end loop;
2937
2938          Set_Next_Declarative_Item (Last, Tree, Next);
2939          Set_Next_Declarative_Item (Decl, Tree, New_Decl);
2940       end if;
2941    end Add_At_End;
2942
2943    ---------------------------
2944    -- Create_Literal_String --
2945    ---------------------------
2946
2947    function Create_Literal_String
2948      (Str  : Namet.Name_Id;
2949       Tree : Project_Node_Tree_Ref) return Project_Node_Id
2950    is
2951       Node : Project_Node_Id;
2952    begin
2953       Node := Default_Project_Node (Tree, N_Literal_String, Prj.Single);
2954       Set_Next_Literal_String (Node, Tree, Empty_Node);
2955       Set_String_Value_Of (Node, Tree, Str);
2956       return Node;
2957    end Create_Literal_String;
2958
2959    ---------------------------
2960    -- Enclose_In_Expression --
2961    ---------------------------
2962
2963    function Enclose_In_Expression
2964      (Node : Project_Node_Id;
2965       Tree : Project_Node_Tree_Ref) return Project_Node_Id
2966    is
2967       Expr : constant Project_Node_Id :=
2968                Default_Project_Node (Tree, N_Expression, Single);
2969    begin
2970       Set_First_Term (Expr, Tree, Default_Project_Node (Tree, N_Term, Single));
2971       Set_Current_Term (First_Term (Expr, Tree), Tree, Node);
2972       return Expr;
2973    end Enclose_In_Expression;
2974
2975    --------------------
2976    -- Create_Package --
2977    --------------------
2978
2979    function Create_Package
2980      (Tree    : Project_Node_Tree_Ref;
2981       Project : Project_Node_Id;
2982       Pkg     : String) return Project_Node_Id
2983    is
2984       Pack : Project_Node_Id;
2985       N    : Name_Id;
2986
2987    begin
2988       Name_Len := Pkg'Length;
2989       Name_Buffer (1 .. Name_Len) := Pkg;
2990       N := Name_Find;
2991
2992       --  Check if the package already exists
2993
2994       Pack := First_Package_Of (Project, Tree);
2995       while Pack /= Empty_Node loop
2996          if Prj.Tree.Name_Of (Pack, Tree) = N then
2997             return Pack;
2998          end if;
2999
3000          Pack := Next_Package_In_Project (Pack, Tree);
3001       end loop;
3002
3003       --  Create the package and add it to the declarative item
3004
3005       Pack := Default_Project_Node (Tree, N_Package_Declaration);
3006       Set_Name_Of (Pack, Tree, N);
3007
3008       --  Find the correct package id to use
3009
3010       Set_Package_Id_Of (Pack, Tree, Package_Node_Id_Of (N));
3011
3012       --  Add it to the list of packages
3013
3014       Set_Next_Package_In_Project
3015         (Pack, Tree, First_Package_Of (Project, Tree));
3016       Set_First_Package_Of (Project, Tree, Pack);
3017
3018       Add_At_End (Tree, Project_Declaration_Of (Project, Tree), Pack);
3019
3020       return Pack;
3021    end Create_Package;
3022
3023    -------------------
3024    -- Create_Attribute --
3025    ----------------------
3026
3027    function Create_Attribute
3028      (Tree       : Project_Node_Tree_Ref;
3029       Prj_Or_Pkg : Project_Node_Id;
3030       Name       : Name_Id;
3031       Index_Name : Name_Id       := No_Name;
3032       Kind       : Variable_Kind := List;
3033       At_Index   : Integer       := 0) return Project_Node_Id
3034    is
3035       Node : constant Project_Node_Id :=
3036                Default_Project_Node (Tree, N_Attribute_Declaration, Kind);
3037
3038       Case_Insensitive : Boolean;
3039
3040       Pkg      : Package_Node_Id;
3041       Start_At : Attribute_Node_Id;
3042
3043    begin
3044       Set_Name_Of (Node, Tree, Name);
3045
3046       if At_Index /= 0 then
3047          Set_Source_Index_Of (Node, Tree, To => Int (At_Index));
3048       end if;
3049
3050       if Index_Name /= No_Name then
3051          Set_Associative_Array_Index_Of (Node, Tree, Index_Name);
3052       end if;
3053
3054       if Prj_Or_Pkg /= Empty_Node then
3055          Add_At_End (Tree, Prj_Or_Pkg, Node);
3056       end if;
3057
3058       --  Find out the case sensitivity of the attribute
3059
3060       if Prj_Or_Pkg /= Empty_Node
3061         and then Kind_Of (Prj_Or_Pkg, Tree) = N_Package_Declaration
3062       then
3063          Pkg      := Prj.Attr.Package_Node_Id_Of (Name_Of (Prj_Or_Pkg, Tree));
3064          Start_At := First_Attribute_Of (Pkg);
3065       else
3066          Start_At := Attribute_First;
3067       end if;
3068
3069       Start_At := Attribute_Node_Id_Of (Name, Start_At);
3070       Case_Insensitive :=
3071         Attribute_Kind_Of (Start_At) = Case_Insensitive_Associative_Array;
3072       Tree.Project_Nodes.Table (Node).Flag1 := Case_Insensitive;
3073
3074       return Node;
3075    end Create_Attribute;
3076
3077 end Prj.Tree;