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