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