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