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