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 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 2,  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 COPYING.  If not, write --
  19 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  20 -- MA 02111-1307, USA.                                                      --
  21 --                                                                          --
  22 -- GNAT was originally developed  by the GNAT team at  New York University. --
  23 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  24 --                                                                          --
  25 ------------------------------------------------------------------------------
  26
  27 with Stringt; use Stringt;
  28
  29 package body Prj.Tree is
  30
  31    use Tree_Private_Part;
  32
  33    --------------------------------
  34    -- Associative_Array_Index_Of --
  35    --------------------------------
  36
  37    function Associative_Array_Index_Of
  38      (Node : Project_Node_Id)
  39       return String_Id
  40    is
  41    begin
  42       pragma Assert
  43         (Node /= Empty_Node
  44           and then
  45             (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
  46                or else
  47              Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
  48       return Project_Nodes.Table (Node).Value;
  49    end Associative_Array_Index_Of;
  50
  51    ----------------------
  52    -- Case_Insensitive --
  53    ----------------------
  54
  55    function Case_Insensitive (Node : Project_Node_Id) return Boolean is
  56    begin
  57       pragma Assert
  58         (Node /= Empty_Node
  59           and then
  60             (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
  61                or else
  62              Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
  63       return Project_Nodes.Table (Node).Case_Insensitive;
  64    end Case_Insensitive;
  65
  66    --------------------------------
  67    -- Case_Variable_Reference_Of --
  68    --------------------------------
  69
  70    function Case_Variable_Reference_Of
  71      (Node : Project_Node_Id)
  72       return Project_Node_Id
  73    is
  74    begin
  75       pragma Assert
  76         (Node /= Empty_Node
  77           and then
  78             Project_Nodes.Table (Node).Kind = N_Case_Construction);
  79       return Project_Nodes.Table (Node).Field1;
  80    end Case_Variable_Reference_Of;
  81
  82    -----------------------
  83    -- Current_Item_Node --
  84    -----------------------
  85
  86    function Current_Item_Node
  87      (Node : Project_Node_Id)
  88       return Project_Node_Id
  89    is
  90    begin
  91       pragma Assert
  92         (Node /= Empty_Node
  93           and then
  94             Project_Nodes.Table (Node).Kind = N_Declarative_Item);
  95       return Project_Nodes.Table (Node).Field1;
  96    end Current_Item_Node;
  97
  98    ------------------
  99    -- Current_Term --
 100    ------------------
 101
 102    function Current_Term
 103      (Node : Project_Node_Id)
 104       return Project_Node_Id
 105    is
 106    begin
 107       pragma Assert
 108         (Node /= Empty_Node
 109           and then
 110             Project_Nodes.Table (Node).Kind = N_Term);
 111       return Project_Nodes.Table (Node).Field1;
 112    end Current_Term;
 113
 114    --------------------------
 115    -- Default_Project_Node --
 116    --------------------------
 117
 118    function Default_Project_Node
 119      (Of_Kind       : Project_Node_Kind;
 120       And_Expr_Kind : Variable_Kind := Undefined)
 121       return          Project_Node_Id
 122    is
 123    begin
 124       Project_Nodes.Increment_Last;
 125       Project_Nodes.Table (Project_Nodes.Last) :=
 126            (Kind             => Of_Kind,
 127             Location         => No_Location,
 128             Directory        => No_Name,
 129             Expr_Kind        => And_Expr_Kind,
 130             Variables        => Empty_Node,
 131             Packages         => Empty_Node,
 132             Pkg_Id           => Empty_Package,
 133             Name             => No_Name,
 134             Path_Name        => No_Name,
 135             Value            => No_String,
 136             Field1           => Empty_Node,
 137             Field2           => Empty_Node,
 138             Field3           => Empty_Node,
 139             Case_Insensitive => False);
 140       return Project_Nodes.Last;
 141    end Default_Project_Node;
 142
 143    ------------------
 144    -- Directory_Of --
 145    ------------------
 146
 147    function Directory_Of (Node : Project_Node_Id) return Name_Id is
 148    begin
 149       pragma Assert
 150         (Node /= Empty_Node
 151           and then
 152             Project_Nodes.Table (Node).Kind = N_Project);
 153       return Project_Nodes.Table (Node).Directory;
 154    end Directory_Of;
 155
 156    ------------------------
 157    -- Expression_Kind_Of --
 158    ------------------------
 159
 160    function Expression_Kind_Of (Node : Project_Node_Id) return Variable_Kind is
 161    begin
 162       pragma Assert
 163         (Node /= Empty_Node
 164            and then
 165              (Project_Nodes.Table (Node).Kind = N_Literal_String
 166                 or else
 167               Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
 168                 or else
 169               Project_Nodes.Table (Node).Kind = N_Variable_Declaration
 170                 or else
 171               Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration
 172                 or else
 173               Project_Nodes.Table (Node).Kind = N_Expression
 174                 or else
 175               Project_Nodes.Table (Node).Kind = N_Term
 176                 or else
 177               Project_Nodes.Table (Node).Kind = N_Variable_Reference
 178                 or else
 179               Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
 180
 181       return Project_Nodes.Table (Node).Expr_Kind;
 182    end Expression_Kind_Of;
 183
 184    -------------------
 185    -- Expression_Of --
 186    -------------------
 187
 188    function Expression_Of
 189      (Node : Project_Node_Id)
 190       return Project_Node_Id
 191    is
 192    begin
 193       pragma Assert
 194         (Node /= Empty_Node
 195           and then
 196             (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
 197                or else
 198              Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration
 199                or else
 200              Project_Nodes.Table (Node).Kind = N_Variable_Declaration));
 201
 202       return Project_Nodes.Table (Node).Field1;
 203    end Expression_Of;
 204
 205    ---------------------------
 206    -- External_Reference_Of --
 207    ---------------------------
 208
 209    function External_Reference_Of
 210      (Node : Project_Node_Id)
 211       return Project_Node_Id
 212    is
 213    begin
 214       pragma Assert
 215         (Node /= Empty_Node
 216           and then
 217             Project_Nodes.Table (Node).Kind = N_External_Value);
 218       return Project_Nodes.Table (Node).Field1;
 219    end External_Reference_Of;
 220
 221    -------------------------
 222    -- External_Default_Of --
 223    -------------------------
 224
 225    function External_Default_Of
 226      (Node : Project_Node_Id)
 227       return Project_Node_Id
 228    is
 229    begin
 230       pragma Assert
 231         (Node /= Empty_Node
 232           and then
 233             Project_Nodes.Table (Node).Kind = N_External_Value);
 234       return Project_Nodes.Table (Node).Field2;
 235    end External_Default_Of;
 236
 237    ------------------------
 238    -- First_Case_Item_Of --
 239    ------------------------
 240
 241    function First_Case_Item_Of
 242      (Node : Project_Node_Id)
 243       return Project_Node_Id
 244    is
 245    begin
 246       pragma Assert
 247         (Node /= Empty_Node
 248           and then
 249             Project_Nodes.Table (Node).Kind = N_Case_Construction);
 250       return Project_Nodes.Table (Node).Field2;
 251    end First_Case_Item_Of;
 252
 253    ---------------------
 254    -- First_Choice_Of --
 255    ---------------------
 256
 257    function First_Choice_Of
 258      (Node : Project_Node_Id)
 259       return Project_Node_Id
 260    is
 261    begin
 262       pragma Assert
 263         (Node /= Empty_Node
 264           and then
 265             Project_Nodes.Table (Node).Kind = N_Case_Item);
 266       return Project_Nodes.Table (Node).Field1;
 267    end First_Choice_Of;
 268
 269    -------------------------------
 270    -- First_Declarative_Item_Of --
 271    -------------------------------
 272
 273    function First_Declarative_Item_Of
 274      (Node : Project_Node_Id)
 275       return Project_Node_Id
 276    is
 277    begin
 278       pragma Assert
 279         (Node /= Empty_Node
 280           and then
 281             (Project_Nodes.Table (Node).Kind = N_Project_Declaration
 282                or else
 283              Project_Nodes.Table (Node).Kind = N_Case_Item
 284                or else
 285              Project_Nodes.Table (Node).Kind = N_Package_Declaration));
 286
 287       if Project_Nodes.Table (Node).Kind = N_Project_Declaration then
 288          return Project_Nodes.Table (Node).Field1;
 289       else
 290          return Project_Nodes.Table (Node).Field2;
 291       end if;
 292    end First_Declarative_Item_Of;
 293
 294    ------------------------------
 295    -- First_Expression_In_List --
 296    ------------------------------
 297
 298    function First_Expression_In_List
 299      (Node : Project_Node_Id)
 300       return Project_Node_Id
 301    is
 302    begin
 303       pragma Assert
 304         (Node /= Empty_Node
 305           and then
 306             Project_Nodes.Table (Node).Kind = N_Literal_String_List);
 307       return Project_Nodes.Table (Node).Field1;
 308    end First_Expression_In_List;
 309
 310    --------------------------
 311    -- First_Literal_String --
 312    --------------------------
 313
 314    function First_Literal_String
 315      (Node : Project_Node_Id)
 316       return Project_Node_Id
 317    is
 318    begin
 319       pragma Assert
 320         (Node /= Empty_Node
 321           and then
 322             Project_Nodes.Table (Node).Kind = N_String_Type_Declaration);
 323       return Project_Nodes.Table (Node).Field1;
 324    end First_Literal_String;
 325
 326    ----------------------
 327    -- First_Package_Of --
 328    ----------------------
 329
 330    function First_Package_Of
 331      (Node : Project_Node_Id)
 332       return Package_Declaration_Id
 333    is
 334    begin
 335       pragma Assert
 336         (Node /= Empty_Node
 337           and then
 338             Project_Nodes.Table (Node).Kind = N_Project);
 339       return Project_Nodes.Table (Node).Packages;
 340    end First_Package_Of;
 341
 342    --------------------------
 343    -- First_String_Type_Of --
 344    --------------------------
 345
 346    function First_String_Type_Of
 347      (Node : Project_Node_Id)
 348       return Project_Node_Id
 349    is
 350    begin
 351       pragma Assert
 352         (Node /= Empty_Node
 353           and then
 354             Project_Nodes.Table (Node).Kind = N_Project);
 355       return Project_Nodes.Table (Node).Field3;
 356    end First_String_Type_Of;
 357
 358    ----------------
 359    -- First_Term --
 360    ----------------
 361
 362    function First_Term
 363      (Node : Project_Node_Id)
 364       return Project_Node_Id
 365    is
 366    begin
 367       pragma Assert
 368         (Node /= Empty_Node
 369           and then
 370             Project_Nodes.Table (Node).Kind = N_Expression);
 371       return Project_Nodes.Table (Node).Field1;
 372    end First_Term;
 373
 374    -----------------------
 375    -- First_Variable_Of --
 376    -----------------------
 377
 378    function First_Variable_Of
 379      (Node : Project_Node_Id)
 380       return Variable_Node_Id
 381    is
 382    begin
 383       pragma Assert
 384         (Node /= Empty_Node
 385           and then
 386             (Project_Nodes.Table (Node).Kind = N_Project
 387                or else
 388              Project_Nodes.Table (Node).Kind = N_Package_Declaration));
 389
 390       return Project_Nodes.Table (Node).Variables;
 391    end First_Variable_Of;
 392
 393    --------------------------
 394    -- First_With_Clause_Of --
 395    --------------------------
 396
 397    function First_With_Clause_Of
 398      (Node : Project_Node_Id)
 399       return Project_Node_Id
 400    is
 401    begin
 402       pragma Assert
 403         (Node /= Empty_Node
 404           and then
 405             Project_Nodes.Table (Node).Kind = N_Project);
 406       return Project_Nodes.Table (Node).Field1;
 407    end First_With_Clause_Of;
 408
 409    ----------------
 410    -- Initialize --
 411    ----------------
 412
 413    procedure Initialize is
 414    begin
 415       Project_Nodes.Set_Last (Empty_Node);
 416       Projects_Htable.Reset;
 417    end Initialize;
 418
 419    -------------
 420    -- Kind_Of --
 421    -------------
 422
 423    function Kind_Of (Node : Project_Node_Id) return Project_Node_Kind is
 424    begin
 425       pragma Assert (Node /= Empty_Node);
 426       return Project_Nodes.Table (Node).Kind;
 427    end Kind_Of;
 428
 429    -----------------
 430    -- Location_Of --
 431    -----------------
 432
 433    function Location_Of (Node : Project_Node_Id) return Source_Ptr is
 434    begin
 435       pragma Assert (Node /= Empty_Node);
 436       return Project_Nodes.Table (Node).Location;
 437    end Location_Of;
 438
 439    -------------------------
 440    -- Modified_Project_Of --
 441    -------------------------
 442
 443    function Modified_Project_Of
 444      (Node : Project_Node_Id)
 445       return Project_Node_Id
 446    is
 447    begin
 448       pragma Assert
 449         (Node /= Empty_Node
 450           and then
 451             Project_Nodes.Table (Node).Kind = N_Project_Declaration);
 452       return Project_Nodes.Table (Node).Field2;
 453    end Modified_Project_Of;
 454
 455    ------------------------------
 456    -- Modified_Project_Path_Of --
 457    ------------------------------
 458
 459    function Modified_Project_Path_Of
 460      (Node : Project_Node_Id)
 461       return String_Id
 462    is
 463    begin
 464       pragma Assert
 465         (Node /= Empty_Node
 466           and then
 467             Project_Nodes.Table (Node).Kind = N_Project);
 468       return Project_Nodes.Table (Node).Value;
 469    end Modified_Project_Path_Of;
 470
 471    -------------
 472    -- Name_Of --
 473    -------------
 474
 475    function Name_Of (Node : Project_Node_Id) return Name_Id is
 476    begin
 477       pragma Assert (Node /= Empty_Node);
 478       return Project_Nodes.Table (Node).Name;
 479    end Name_Of;
 480
 481    --------------------
 482    -- Next_Case_Item --
 483    --------------------
 484
 485    function Next_Case_Item
 486      (Node : Project_Node_Id)
 487       return Project_Node_Id
 488    is
 489    begin
 490       pragma Assert
 491         (Node /= Empty_Node
 492           and then
 493             Project_Nodes.Table (Node).Kind = N_Case_Item);
 494       return Project_Nodes.Table (Node).Field3;
 495    end Next_Case_Item;
 496
 497    ---------------------------
 498    -- Next_Declarative_Item --
 499    ---------------------------
 500
 501    function Next_Declarative_Item
 502      (Node : Project_Node_Id)
 503       return Project_Node_Id
 504    is
 505    begin
 506       pragma Assert
 507         (Node /= Empty_Node
 508           and then
 509             Project_Nodes.Table (Node).Kind = N_Declarative_Item);
 510       return Project_Nodes.Table (Node).Field2;
 511    end Next_Declarative_Item;
 512
 513    -----------------------------
 514    -- Next_Expression_In_List --
 515    -----------------------------
 516
 517    function Next_Expression_In_List
 518      (Node : Project_Node_Id)
 519       return Project_Node_Id
 520    is
 521    begin
 522       pragma Assert
 523         (Node /= Empty_Node
 524           and then
 525             Project_Nodes.Table (Node).Kind = N_Expression);
 526       return Project_Nodes.Table (Node).Field2;
 527    end Next_Expression_In_List;
 528
 529    -------------------------
 530    -- Next_Literal_String --
 531    -------------------------
 532
 533    function Next_Literal_String
 534      (Node : Project_Node_Id)
 535       return Project_Node_Id
 536    is
 537    begin
 538       pragma Assert
 539         (Node /= Empty_Node
 540           and then
 541             Project_Nodes.Table (Node).Kind = N_Literal_String);
 542       return Project_Nodes.Table (Node).Field1;
 543    end Next_Literal_String;
 544
 545    -----------------------------
 546    -- Next_Package_In_Project --
 547    -----------------------------
 548
 549    function Next_Package_In_Project
 550      (Node : Project_Node_Id)
 551       return Project_Node_Id
 552    is
 553    begin
 554       pragma Assert
 555         (Node /= Empty_Node
 556           and then
 557             Project_Nodes.Table (Node).Kind = N_Package_Declaration);
 558       return Project_Nodes.Table (Node).Field3;
 559    end Next_Package_In_Project;
 560
 561    ----------------------
 562    -- Next_String_Type --
 563    ----------------------
 564
 565    function Next_String_Type
 566      (Node : Project_Node_Id)
 567       return Project_Node_Id
 568    is
 569    begin
 570       pragma Assert
 571         (Node /= Empty_Node
 572           and then
 573             Project_Nodes.Table (Node).Kind = N_String_Type_Declaration);
 574       return Project_Nodes.Table (Node).Field2;
 575    end Next_String_Type;
 576
 577    ---------------
 578    -- Next_Term --
 579    ---------------
 580
 581    function Next_Term
 582      (Node : Project_Node_Id)
 583       return Project_Node_Id
 584    is
 585    begin
 586       pragma Assert
 587         (Node /= Empty_Node
 588           and then
 589             Project_Nodes.Table (Node).Kind = N_Term);
 590       return Project_Nodes.Table (Node).Field2;
 591    end Next_Term;
 592
 593    -------------------
 594    -- Next_Variable --
 595    -------------------
 596
 597    function Next_Variable
 598      (Node : Project_Node_Id)
 599       return Project_Node_Id
 600    is
 601    begin
 602       pragma Assert
 603         (Node /= Empty_Node
 604           and then
 605             (Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration
 606                or else
 607              Project_Nodes.Table (Node).Kind = N_Variable_Declaration));
 608
 609       return Project_Nodes.Table (Node).Field3;
 610    end Next_Variable;
 611
 612    -------------------------
 613    -- Next_With_Clause_Of --
 614    -------------------------
 615
 616    function Next_With_Clause_Of
 617      (Node : Project_Node_Id)
 618       return Project_Node_Id
 619    is
 620    begin
 621       pragma Assert
 622         (Node /= Empty_Node
 623           and then
 624             Project_Nodes.Table (Node).Kind = N_With_Clause);
 625       return Project_Nodes.Table (Node).Field2;
 626    end Next_With_Clause_Of;
 627
 628    -------------------
 629    -- Package_Id_Of --
 630    -------------------
 631
 632    function Package_Id_Of (Node : Project_Node_Id) return Package_Node_Id is
 633    begin
 634       pragma Assert
 635         (Node /= Empty_Node
 636           and then
 637             Project_Nodes.Table (Node).Kind = N_Package_Declaration);
 638       return Project_Nodes.Table (Node).Pkg_Id;
 639    end Package_Id_Of;
 640
 641    ---------------------
 642    -- Package_Node_Of --
 643    ---------------------
 644
 645    function Package_Node_Of
 646      (Node : Project_Node_Id)
 647       return Project_Node_Id
 648    is
 649    begin
 650       pragma Assert
 651         (Node /= Empty_Node
 652           and then
 653             (Project_Nodes.Table (Node).Kind = N_Variable_Reference
 654                or else
 655              Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
 656       return Project_Nodes.Table (Node).Field2;
 657    end Package_Node_Of;
 658
 659    ------------------
 660    -- Path_Name_Of --
 661    ------------------
 662
 663    function Path_Name_Of (Node : Project_Node_Id) return Name_Id is
 664    begin
 665       pragma Assert
 666         (Node /= Empty_Node
 667           and then
 668             (Project_Nodes.Table (Node).Kind = N_Project
 669                or else
 670              Project_Nodes.Table (Node).Kind = N_With_Clause));
 671       return Project_Nodes.Table (Node).Path_Name;
 672    end Path_Name_Of;
 673
 674    ----------------------------
 675    -- Project_Declaration_Of --
 676    ----------------------------
 677
 678    function Project_Declaration_Of
 679      (Node : Project_Node_Id)
 680       return Project_Node_Id
 681    is
 682    begin
 683       pragma Assert
 684         (Node /= Empty_Node
 685           and then
 686             Project_Nodes.Table (Node).Kind = N_Project);
 687       return Project_Nodes.Table (Node).Field2;
 688    end Project_Declaration_Of;
 689
 690    ---------------------
 691    -- Project_Node_Of --
 692    ---------------------
 693
 694    function Project_Node_Of
 695      (Node : Project_Node_Id)
 696       return Project_Node_Id
 697    is
 698    begin
 699       pragma Assert
 700         (Node /= Empty_Node
 701           and then
 702            (Project_Nodes.Table (Node).Kind = N_With_Clause
 703               or else
 704             Project_Nodes.Table (Node).Kind = N_Variable_Reference
 705               or else
 706             Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
 707       return Project_Nodes.Table (Node).Field1;
 708    end Project_Node_Of;
 709
 710    -----------------------------------
 711    -- Project_Of_Renamed_Package_Of --
 712    -----------------------------------
 713
 714    function Project_Of_Renamed_Package_Of
 715      (Node : Project_Node_Id)
 716       return Project_Node_Id
 717    is
 718    begin
 719       pragma Assert
 720         (Node /= Empty_Node
 721           and then
 722             Project_Nodes.Table (Node).Kind = N_Package_Declaration);
 723       return Project_Nodes.Table (Node).Field1;
 724    end Project_Of_Renamed_Package_Of;
 725
 726    ------------------------------------
 727    -- Set_Associative_Array_Index_Of --
 728    ------------------------------------
 729
 730    procedure Set_Associative_Array_Index_Of
 731      (Node : Project_Node_Id;
 732       To   : String_Id)
 733    is
 734    begin
 735       pragma Assert
 736         (Node /= Empty_Node
 737           and then
 738             (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
 739                or else
 740              Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
 741       Project_Nodes.Table (Node).Value := To;
 742    end Set_Associative_Array_Index_Of;
 743
 744    --------------------------
 745    -- Set_Case_Insensitive --
 746    --------------------------
 747
 748    procedure Set_Case_Insensitive
 749      (Node : Project_Node_Id;
 750       To   : Boolean)
 751    is
 752    begin
 753       pragma Assert
 754         (Node /= Empty_Node
 755           and then
 756            (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
 757                or else
 758             Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
 759       Project_Nodes.Table (Node).Case_Insensitive := To;
 760    end Set_Case_Insensitive;
 761
 762    ------------------------------------
 763    -- Set_Case_Variable_Reference_Of --
 764    ------------------------------------
 765
 766    procedure Set_Case_Variable_Reference_Of
 767      (Node : Project_Node_Id;
 768       To   : Project_Node_Id)
 769    is
 770    begin
 771       pragma Assert
 772         (Node /= Empty_Node
 773           and then
 774             Project_Nodes.Table (Node).Kind = N_Case_Construction);
 775       Project_Nodes.Table (Node).Field1 := To;
 776    end Set_Case_Variable_Reference_Of;
 777
 778    ---------------------------
 779    -- Set_Current_Item_Node --
 780    ---------------------------
 781
 782    procedure Set_Current_Item_Node
 783      (Node : Project_Node_Id;
 784       To   : Project_Node_Id)
 785    is
 786    begin
 787       pragma Assert
 788         (Node /= Empty_Node
 789           and then
 790             Project_Nodes.Table (Node).Kind = N_Declarative_Item);
 791       Project_Nodes.Table (Node).Field1 := To;
 792    end Set_Current_Item_Node;
 793
 794    ----------------------
 795    -- Set_Current_Term --
 796    ----------------------
 797
 798    procedure Set_Current_Term
 799      (Node : Project_Node_Id;
 800       To   : Project_Node_Id)
 801    is
 802    begin
 803       pragma Assert
 804         (Node /= Empty_Node
 805           and then
 806             Project_Nodes.Table (Node).Kind = N_Term);
 807       Project_Nodes.Table (Node).Field1 := To;
 808    end Set_Current_Term;
 809
 810    ----------------------
 811    -- Set_Directory_Of --
 812    ----------------------
 813
 814    procedure Set_Directory_Of
 815      (Node : Project_Node_Id;
 816       To   : Name_Id)
 817    is
 818    begin
 819       pragma Assert
 820         (Node /= Empty_Node
 821           and then
 822             Project_Nodes.Table (Node).Kind = N_Project);
 823       Project_Nodes.Table (Node).Directory := To;
 824    end Set_Directory_Of;
 825
 826    ----------------------------
 827    -- Set_Expression_Kind_Of --
 828    ----------------------------
 829
 830    procedure Set_Expression_Kind_Of
 831      (Node : Project_Node_Id;
 832       To   : Variable_Kind)
 833    is
 834    begin
 835       pragma Assert
 836         (Node /= Empty_Node
 837            and then
 838              (Project_Nodes.Table (Node).Kind = N_Literal_String
 839                 or else
 840               Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
 841                 or else
 842               Project_Nodes.Table (Node).Kind = N_Variable_Declaration
 843                 or else
 844               Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration
 845                 or else
 846               Project_Nodes.Table (Node).Kind = N_Expression
 847                 or else
 848               Project_Nodes.Table (Node).Kind = N_Term
 849                 or else
 850               Project_Nodes.Table (Node).Kind = N_Variable_Reference
 851                 or else
 852               Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
 853       Project_Nodes.Table (Node).Expr_Kind := To;
 854    end Set_Expression_Kind_Of;
 855
 856    -----------------------
 857    -- Set_Expression_Of --
 858    -----------------------
 859
 860    procedure Set_Expression_Of
 861      (Node : Project_Node_Id;
 862       To   : Project_Node_Id)
 863    is
 864    begin
 865       pragma Assert
 866         (Node /= Empty_Node
 867           and then
 868             (Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
 869                or else
 870              Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration
 871                or else
 872              Project_Nodes.Table (Node).Kind = N_Variable_Declaration));
 873       Project_Nodes.Table (Node).Field1 := To;
 874    end Set_Expression_Of;
 875
 876    -------------------------------
 877    -- Set_External_Reference_Of --
 878    -------------------------------
 879
 880    procedure Set_External_Reference_Of
 881      (Node : Project_Node_Id;
 882       To   : Project_Node_Id)
 883    is
 884    begin
 885       pragma Assert
 886         (Node /= Empty_Node
 887           and then
 888             Project_Nodes.Table (Node).Kind = N_External_Value);
 889       Project_Nodes.Table (Node).Field1 := To;
 890    end Set_External_Reference_Of;
 891
 892    -----------------------------
 893    -- Set_External_Default_Of --
 894    -----------------------------
 895
 896    procedure Set_External_Default_Of
 897      (Node : Project_Node_Id;
 898       To   : Project_Node_Id)
 899    is
 900    begin
 901       pragma Assert
 902         (Node /= Empty_Node
 903           and then
 904             Project_Nodes.Table (Node).Kind = N_External_Value);
 905       Project_Nodes.Table (Node).Field2 := To;
 906    end Set_External_Default_Of;
 907
 908    ----------------------------
 909    -- Set_First_Case_Item_Of --
 910    ----------------------------
 911
 912    procedure Set_First_Case_Item_Of
 913      (Node : Project_Node_Id;
 914       To   : Project_Node_Id)
 915    is
 916    begin
 917       pragma Assert
 918         (Node /= Empty_Node
 919           and then
 920             Project_Nodes.Table (Node).Kind = N_Case_Construction);
 921       Project_Nodes.Table (Node).Field2 := To;
 922    end Set_First_Case_Item_Of;
 923
 924    -------------------------
 925    -- Set_First_Choice_Of --
 926    -------------------------
 927
 928    procedure Set_First_Choice_Of
 929      (Node : Project_Node_Id;
 930       To   : Project_Node_Id)
 931    is
 932    begin
 933       pragma Assert
 934         (Node /= Empty_Node
 935           and then
 936             Project_Nodes.Table (Node).Kind = N_Case_Item);
 937       Project_Nodes.Table (Node).Field1 := To;
 938    end Set_First_Choice_Of;
 939
 940    ------------------------
 941    -- Set_Next_Case_Item --
 942    ------------------------
 943
 944    procedure Set_Next_Case_Item
 945      (Node : Project_Node_Id;
 946       To   : Project_Node_Id)
 947    is
 948    begin
 949       pragma Assert
 950         (Node /= Empty_Node
 951           and then
 952             Project_Nodes.Table (Node).Kind = N_Case_Item);
 953       Project_Nodes.Table (Node).Field3 := To;
 954    end Set_Next_Case_Item;
 955
 956    -----------------------------------
 957    -- Set_First_Declarative_Item_Of --
 958    -----------------------------------
 959
 960    procedure Set_First_Declarative_Item_Of
 961      (Node : Project_Node_Id;
 962       To   : Project_Node_Id)
 963    is
 964    begin
 965       pragma Assert
 966         (Node /= Empty_Node
 967           and then
 968             (Project_Nodes.Table (Node).Kind = N_Project_Declaration
 969                or else
 970              Project_Nodes.Table (Node).Kind = N_Case_Item
 971                or else
 972              Project_Nodes.Table (Node).Kind = N_Package_Declaration));
 973
 974       if Project_Nodes.Table (Node).Kind = N_Project_Declaration then
 975          Project_Nodes.Table (Node).Field1 := To;
 976       else
 977          Project_Nodes.Table (Node).Field2 := To;
 978       end if;
 979    end Set_First_Declarative_Item_Of;
 980
 981    ----------------------------------
 982    -- Set_First_Expression_In_List --
 983    ----------------------------------
 984
 985    procedure Set_First_Expression_In_List
 986      (Node : Project_Node_Id;
 987       To   : Project_Node_Id)
 988    is
 989    begin
 990       pragma Assert
 991         (Node /= Empty_Node
 992           and then
 993             Project_Nodes.Table (Node).Kind = N_Literal_String_List);
 994       Project_Nodes.Table (Node).Field1 := To;
 995    end Set_First_Expression_In_List;
 996
 997    ------------------------------
 998    -- Set_First_Literal_String --
 999    ------------------------------
1000
1001    procedure Set_First_Literal_String
1002      (Node : Project_Node_Id;
1003       To   : Project_Node_Id)
1004    is
1005    begin
1006       pragma Assert
1007         (Node /= Empty_Node
1008           and then
1009             Project_Nodes.Table (Node).Kind = N_String_Type_Declaration);
1010       Project_Nodes.Table (Node).Field1 := To;
1011    end Set_First_Literal_String;
1012
1013    --------------------------
1014    -- Set_First_Package_Of --
1015    --------------------------
1016
1017    procedure Set_First_Package_Of
1018      (Node : Project_Node_Id;
1019       To   : Package_Declaration_Id)
1020    is
1021    begin
1022       pragma Assert
1023         (Node /= Empty_Node
1024           and then
1025             Project_Nodes.Table (Node).Kind = N_Project);
1026       Project_Nodes.Table (Node).Packages := To;
1027    end Set_First_Package_Of;
1028
1029    ------------------------------
1030    -- Set_First_String_Type_Of --
1031    ------------------------------
1032
1033    procedure Set_First_String_Type_Of
1034      (Node : Project_Node_Id;
1035       To   : Project_Node_Id)
1036    is
1037    begin
1038       pragma Assert
1039         (Node /= Empty_Node
1040           and then
1041             Project_Nodes.Table (Node).Kind = N_Project);
1042       Project_Nodes.Table (Node).Field3 := To;
1043    end Set_First_String_Type_Of;
1044
1045    --------------------
1046    -- Set_First_Term --
1047    --------------------
1048
1049    procedure Set_First_Term
1050      (Node : Project_Node_Id;
1051       To   : Project_Node_Id)
1052    is
1053    begin
1054       pragma Assert
1055         (Node /= Empty_Node
1056           and then
1057             Project_Nodes.Table (Node).Kind = N_Expression);
1058       Project_Nodes.Table (Node).Field1 := To;
1059    end Set_First_Term;
1060
1061    ---------------------------
1062    -- Set_First_Variable_Of --
1063    ---------------------------
1064
1065    procedure Set_First_Variable_Of
1066      (Node : Project_Node_Id;
1067       To   : Variable_Node_Id)
1068    is
1069    begin
1070       pragma Assert
1071         (Node /= Empty_Node
1072           and then
1073             (Project_Nodes.Table (Node).Kind = N_Project
1074                or else
1075              Project_Nodes.Table (Node).Kind = N_Package_Declaration));
1076       Project_Nodes.Table (Node).Variables := To;
1077    end Set_First_Variable_Of;
1078
1079    ------------------------------
1080    -- Set_First_With_Clause_Of --
1081    ------------------------------
1082
1083    procedure Set_First_With_Clause_Of
1084      (Node : Project_Node_Id;
1085       To   : Project_Node_Id)
1086    is
1087    begin
1088       pragma Assert
1089         (Node /= Empty_Node
1090           and then
1091             Project_Nodes.Table (Node).Kind = N_Project);
1092       Project_Nodes.Table (Node).Field1 := To;
1093    end Set_First_With_Clause_Of;
1094
1095    -----------------
1096    -- Set_Kind_Of --
1097    -----------------
1098
1099    procedure Set_Kind_Of
1100      (Node : Project_Node_Id;
1101       To   : Project_Node_Kind)
1102    is
1103    begin
1104       pragma Assert (Node /= Empty_Node);
1105       Project_Nodes.Table (Node).Kind := To;
1106    end Set_Kind_Of;
1107
1108    ---------------------
1109    -- Set_Location_Of --
1110    ---------------------
1111
1112    procedure Set_Location_Of
1113      (Node : Project_Node_Id;
1114       To   : Source_Ptr)
1115    is
1116    begin
1117       pragma Assert (Node /= Empty_Node);
1118       Project_Nodes.Table (Node).Location := To;
1119    end Set_Location_Of;
1120
1121    -----------------------------
1122    -- Set_Modified_Project_Of --
1123    -----------------------------
1124
1125    procedure Set_Modified_Project_Of
1126      (Node : Project_Node_Id;
1127       To   : Project_Node_Id)
1128    is
1129    begin
1130       pragma Assert
1131         (Node /= Empty_Node
1132           and then
1133             Project_Nodes.Table (Node).Kind = N_Project_Declaration);
1134       Project_Nodes.Table (Node).Field2 := To;
1135    end Set_Modified_Project_Of;
1136
1137    ----------------------------------
1138    -- Set_Modified_Project_Path_Of --
1139    ----------------------------------
1140
1141    procedure Set_Modified_Project_Path_Of
1142      (Node : Project_Node_Id;
1143       To   : String_Id)
1144    is
1145    begin
1146       pragma Assert
1147         (Node /= Empty_Node
1148           and then
1149             Project_Nodes.Table (Node).Kind = N_Project);
1150       Project_Nodes.Table (Node).Value := To;
1151    end Set_Modified_Project_Path_Of;
1152
1153    -----------------
1154    -- Set_Name_Of --
1155    -----------------
1156
1157    procedure Set_Name_Of
1158      (Node : Project_Node_Id;
1159       To   : Name_Id)
1160    is
1161    begin
1162       pragma Assert (Node /= Empty_Node);
1163       Project_Nodes.Table (Node).Name := To;
1164    end Set_Name_Of;
1165
1166    -------------------------------
1167    -- Set_Next_Declarative_Item --
1168    -------------------------------
1169
1170    procedure Set_Next_Declarative_Item
1171      (Node : Project_Node_Id;
1172       To   : Project_Node_Id)
1173    is
1174    begin
1175       pragma Assert
1176         (Node /= Empty_Node
1177           and then
1178             Project_Nodes.Table (Node).Kind = N_Declarative_Item);
1179       Project_Nodes.Table (Node).Field2 := To;
1180    end Set_Next_Declarative_Item;
1181
1182    ---------------------------------
1183    -- Set_Next_Expression_In_List --
1184    ---------------------------------
1185
1186    procedure Set_Next_Expression_In_List
1187      (Node : Project_Node_Id;
1188       To   : Project_Node_Id)
1189    is
1190    begin
1191       pragma Assert
1192         (Node /= Empty_Node
1193           and then
1194             Project_Nodes.Table (Node).Kind = N_Expression);
1195       Project_Nodes.Table (Node).Field2 := To;
1196    end Set_Next_Expression_In_List;
1197
1198    -----------------------------
1199    -- Set_Next_Literal_String --
1200    -----------------------------
1201
1202    procedure Set_Next_Literal_String
1203      (Node : Project_Node_Id;
1204       To   : Project_Node_Id)
1205    is
1206    begin
1207       pragma Assert
1208         (Node /= Empty_Node
1209           and then
1210             Project_Nodes.Table (Node).Kind = N_Literal_String);
1211       Project_Nodes.Table (Node).Field1 := To;
1212    end Set_Next_Literal_String;
1213
1214    ---------------------------------
1215    -- Set_Next_Package_In_Project --
1216    ---------------------------------
1217
1218    procedure Set_Next_Package_In_Project
1219      (Node : Project_Node_Id;
1220       To   : Project_Node_Id)
1221    is
1222    begin
1223       pragma Assert
1224         (Node /= Empty_Node
1225           and then
1226             Project_Nodes.Table (Node).Kind = N_Package_Declaration);
1227       Project_Nodes.Table (Node).Field3 := To;
1228    end Set_Next_Package_In_Project;
1229
1230    --------------------------
1231    -- Set_Next_String_Type --
1232    --------------------------
1233
1234    procedure Set_Next_String_Type
1235      (Node : Project_Node_Id;
1236       To   : Project_Node_Id)
1237    is
1238    begin
1239       pragma Assert
1240         (Node /= Empty_Node
1241           and then
1242             Project_Nodes.Table (Node).Kind = N_String_Type_Declaration);
1243       Project_Nodes.Table (Node).Field2 := To;
1244    end Set_Next_String_Type;
1245
1246    -------------------
1247    -- Set_Next_Term --
1248    -------------------
1249
1250    procedure Set_Next_Term
1251      (Node : Project_Node_Id;
1252       To   : Project_Node_Id)
1253    is
1254    begin
1255       pragma Assert
1256         (Node /= Empty_Node
1257           and then
1258             Project_Nodes.Table (Node).Kind = N_Term);
1259       Project_Nodes.Table (Node).Field2 := To;
1260    end Set_Next_Term;
1261
1262    -----------------------
1263    -- Set_Next_Variable --
1264    -----------------------
1265
1266    procedure Set_Next_Variable
1267      (Node : Project_Node_Id;
1268       To   : Project_Node_Id)
1269    is
1270    begin
1271       pragma Assert
1272         (Node /= Empty_Node
1273           and then
1274             (Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration
1275                or else
1276              Project_Nodes.Table (Node).Kind = N_Variable_Declaration));
1277       Project_Nodes.Table (Node).Field3 := To;
1278    end Set_Next_Variable;
1279
1280    -----------------------------
1281    -- Set_Next_With_Clause_Of --
1282    -----------------------------
1283
1284    procedure Set_Next_With_Clause_Of
1285      (Node : Project_Node_Id;
1286       To   : Project_Node_Id)
1287    is
1288    begin
1289       pragma Assert
1290         (Node /= Empty_Node
1291           and then
1292             Project_Nodes.Table (Node).Kind = N_With_Clause);
1293       Project_Nodes.Table (Node).Field2 := To;
1294    end Set_Next_With_Clause_Of;
1295
1296    -----------------------
1297    -- Set_Package_Id_Of --
1298    -----------------------
1299
1300    procedure Set_Package_Id_Of
1301      (Node : Project_Node_Id;
1302       To   : Package_Node_Id)
1303    is
1304    begin
1305       pragma Assert
1306         (Node /= Empty_Node
1307           and then
1308             Project_Nodes.Table (Node).Kind = N_Package_Declaration);
1309       Project_Nodes.Table (Node).Pkg_Id := To;
1310    end Set_Package_Id_Of;
1311
1312    -------------------------
1313    -- Set_Package_Node_Of --
1314    -------------------------
1315
1316    procedure Set_Package_Node_Of
1317      (Node : Project_Node_Id;
1318       To   : Project_Node_Id)
1319    is
1320    begin
1321       pragma Assert
1322         (Node /= Empty_Node
1323           and then
1324             (Project_Nodes.Table (Node).Kind = N_Variable_Reference
1325                or else
1326              Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
1327       Project_Nodes.Table (Node).Field2 := To;
1328    end Set_Package_Node_Of;
1329
1330    ----------------------
1331    -- Set_Path_Name_Of --
1332    ----------------------
1333
1334    procedure Set_Path_Name_Of
1335      (Node : Project_Node_Id;
1336       To   : Name_Id)
1337    is
1338    begin
1339       pragma Assert
1340         (Node /= Empty_Node
1341           and then
1342             (Project_Nodes.Table (Node).Kind = N_Project
1343                or else
1344              Project_Nodes.Table (Node).Kind = N_With_Clause));
1345       Project_Nodes.Table (Node).Path_Name := To;
1346    end Set_Path_Name_Of;
1347
1348    --------------------------------
1349    -- Set_Project_Declaration_Of --
1350    --------------------------------
1351
1352    procedure Set_Project_Declaration_Of
1353      (Node : Project_Node_Id;
1354       To   : Project_Node_Id)
1355    is
1356    begin
1357       pragma Assert
1358         (Node /= Empty_Node
1359          and then
1360            Project_Nodes.Table (Node).Kind = N_Project);
1361       Project_Nodes.Table (Node).Field2 := To;
1362    end Set_Project_Declaration_Of;
1363
1364    -------------------------
1365    -- Set_Project_Node_Of --
1366    -------------------------
1367
1368    procedure Set_Project_Node_Of
1369      (Node : Project_Node_Id;
1370       To   : Project_Node_Id)
1371    is
1372    begin
1373       pragma Assert
1374         (Node /= Empty_Node
1375           and then
1376             (Project_Nodes.Table (Node).Kind = N_With_Clause
1377                or else
1378              Project_Nodes.Table (Node).Kind = N_Variable_Reference
1379                or else
1380              Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
1381       Project_Nodes.Table (Node).Field1 := To;
1382    end Set_Project_Node_Of;
1383
1384    ---------------------------------------
1385    -- Set_Project_Of_Renamed_Package_Of --
1386    ---------------------------------------
1387
1388    procedure Set_Project_Of_Renamed_Package_Of
1389      (Node : Project_Node_Id;
1390       To   : Project_Node_Id)
1391    is
1392    begin
1393       pragma Assert
1394         (Node /= Empty_Node
1395           and then
1396             Project_Nodes.Table (Node).Kind = N_Package_Declaration);
1397       Project_Nodes.Table (Node).Field1 := To;
1398    end Set_Project_Of_Renamed_Package_Of;
1399
1400    ------------------------
1401    -- Set_String_Type_Of --
1402    ------------------------
1403
1404    procedure Set_String_Type_Of
1405      (Node : Project_Node_Id;
1406       To   : Project_Node_Id)
1407    is
1408    begin
1409       pragma Assert
1410         (Node /= Empty_Node
1411           and then
1412             (Project_Nodes.Table (Node).Kind = N_Variable_Reference
1413                or else
1414              Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration)
1415            and then
1416             Project_Nodes.Table (To).Kind    = N_String_Type_Declaration);
1417
1418       if Project_Nodes.Table (Node).Kind = N_Variable_Reference then
1419          Project_Nodes.Table (Node).Field3 := To;
1420       else
1421          Project_Nodes.Table (Node).Field2 := To;
1422       end if;
1423    end Set_String_Type_Of;
1424
1425    -------------------------
1426    -- Set_String_Value_Of --
1427    -------------------------
1428
1429    procedure Set_String_Value_Of
1430      (Node : Project_Node_Id;
1431       To   : String_Id)
1432    is
1433    begin
1434       pragma Assert
1435         (Node /= Empty_Node
1436           and then
1437             (Project_Nodes.Table (Node).Kind = N_With_Clause
1438                or else
1439              Project_Nodes.Table (Node).Kind = N_Literal_String));
1440       Project_Nodes.Table (Node).Value := To;
1441    end Set_String_Value_Of;
1442
1443    --------------------
1444    -- String_Type_Of --
1445    --------------------
1446
1447    function String_Type_Of  (Node : Project_Node_Id)
1448                             return Project_Node_Id is
1449    begin
1450       pragma Assert
1451         (Node /= Empty_Node
1452           and then
1453             (Project_Nodes.Table (Node).Kind = N_Variable_Reference
1454                or else
1455              Project_Nodes.Table (Node).Kind = N_Typed_Variable_Declaration));
1456
1457       if Project_Nodes.Table (Node).Kind = N_Variable_Reference then
1458          return Project_Nodes.Table (Node).Field3;
1459       else
1460          return Project_Nodes.Table (Node).Field2;
1461       end if;
1462    end String_Type_Of;
1463
1464    ---------------------
1465    -- String_Value_Of --
1466    ---------------------
1467
1468    function String_Value_Of (Node : Project_Node_Id) return String_Id is
1469    begin
1470       pragma Assert
1471         (Node /= Empty_Node
1472           and then
1473            (Project_Nodes.Table (Node).Kind = N_With_Clause
1474               or else
1475             Project_Nodes.Table (Node).Kind = N_Literal_String));
1476       return Project_Nodes.Table (Node).Value;
1477    end String_Value_Of;
1478
1479    --------------------
1480    -- Value_Is_Valid --
1481    --------------------
1482
1483    function Value_Is_Valid
1484      (For_Typed_Variable : Project_Node_Id;
1485       Value              : String_Id)
1486       return               Boolean
1487    is
1488    begin
1489       pragma Assert
1490         (For_Typed_Variable /= Empty_Node
1491           and then
1492            (Project_Nodes.Table (For_Typed_Variable).Kind =
1493                                      N_Typed_Variable_Declaration));
1494
1495       declare
1496          Current_String : Project_Node_Id :=
1497                             First_Literal_String
1498                               (String_Type_Of (For_Typed_Variable));
1499
1500       begin
1501          while Current_String /= Empty_Node
1502            and then
1503              not String_Equal (String_Value_Of (Current_String), Value)
1504          loop
1505             Current_String :=
1506               Next_Literal_String (Current_String);
1507          end loop;
1508
1509          return Current_String /= Empty_Node;
1510       end;
1511
1512    end Value_Is_Valid;
1513
1514 end Prj.Tree;