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