gcc/ada/prj-attr.ads

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             P R J . A T T R                              --
   6 --                                                                          --
   7 --                                 S p e c                                  --
   8 --                                                                          --
   9 --             Copyright (C) 2001-2004 Free Software Foundation, Inc.       --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  19 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  20 -- MA 02111-1307, USA.                                                      --
  21 --                                                                          --
  22 -- GNAT was originally developed  by the GNAT team at  New York University. --
  23 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  24 --                                                                          --
  25 ------------------------------------------------------------------------------
  26
  27 --  This package defines packages and attributes in GNAT project files.
  28 --  There are predefined packages and attributes.
  29 --  It is also possible to define new packages with their attributes.
  30
  31 with Types; use Types;
  32
  33 package Prj.Attr is
  34
  35    procedure Initialize;
  36    --  Initialize the predefined project level attributes and the predefined
  37    --  packages and their attribute. This procedure should be called by
  38    --  Prj.Initialize.
  39
  40    type Attribute_Kind is
  41      (Unknown,
  42       Single,
  43       Associative_Array,
  44       Optional_Index_Associative_Array,
  45       Case_Insensitive_Associative_Array,
  46       Optional_Index_Case_Insensitive_Associative_Array);
  47    --  Characteristics of an attribute. Optional_Index indicates that there
  48    --  may be an optional index in the index of the associative array, as in
  49    --     for Switches ("files.ada" at 2) use ...
  50
  51    subtype Defined_Attribute_Kind is Attribute_Kind
  52      range Single .. Optional_Index_Case_Insensitive_Associative_Array;
  53    --  Subset of Attribute_Kinds that may be used for the attributes that is
  54    --  used when defining a new package.
  55
  56    Max_Attribute_Name_Length : constant := 64;
  57    --  The maximum length of attribute names
  58
  59    subtype Attribute_Name_Length is
  60      Positive range 1 .. Max_Attribute_Name_Length;
  61
  62    type Attribute_Data (Name_Length : Attribute_Name_Length := 1) is record
  63       Name : String (1 .. Name_Length);
  64       --  The name of the attribute
  65
  66       Attr_Kind  : Defined_Attribute_Kind;
  67       --  The type of the attribute
  68
  69       Index_Is_File_Name : Boolean;
  70       --  For associative arrays, indicate if the index is a file name, so
  71       --  that the attribute kind may be modified depending on the case
  72       --  sensitivity of file names. This is only taken into account when
  73       --  Attr_Kind is Associative_Array or Optional_Index_Associative_Array.
  74
  75       Opt_Index : Boolean;
  76       --  True if there may be an optional index in the value of the index,
  77       --  as in:
  78       --    "file.ada" at 2
  79       --    ("main.adb", "file.ada" at 1)
  80
  81       Var_Kind : Defined_Variable_Kind;
  82       --  The attribute value kind: single or list
  83
  84    end record;
  85    --  Name and characteristics of an attribute in a package registered
  86    --  explicitly with Register_New_Package (see below).
  87
  88    type Attribute_Data_Array is array (Positive range <>) of Attribute_Data;
  89
  90    procedure Register_New_Package
  91      (Name       : String;
  92       Attributes : Attribute_Data_Array);
  93    --  Add a new package with its attributes.
  94    --  This procedure can only be called after Initialize, but before any
  95    --  other call to a service of the Project Managers.
  96    --  The name of the package must be unique. The names of the attributes
  97    --  must be different.
  98
  99    --  The following declarations are only for the Project Manager, that is
 100    --  the packages of the Prj or MLib hierarchies.
 101
 102    ----------------
 103    -- Attributes --
 104    ----------------
 105
 106    type Attribute_Node_Id is private;
 107    --  The type to refers to an attribute, self-initialized
 108
 109    Empty_Attribute : constant Attribute_Node_Id;
 110    --  Indicates no attribute. Default value of Attribute_Node_Id objects.
 111
 112    Attribute_First : constant Attribute_Node_Id;
 113    --  First attribute node id of project level attributes
 114
 115    function Attribute_Node_Id_Of
 116      (Name        : Name_Id;
 117       Starting_At : Attribute_Node_Id) return Attribute_Node_Id;
 118    --  Returns the node id of an attribute at the project level or in
 119    --  a package. Starting_At indicates the first known attribute node where
 120    --  to start the search. Returns Empty_Attribute if the attribute cannot
 121    --  be found.
 122
 123    function Attribute_Kind_Of
 124      (Attribute : Attribute_Node_Id) return Attribute_Kind;
 125    --  Returns the attribute kind of a known attribute. Returns Unknown if
 126    --  Attribute is Empty_Attribute.
 127
 128    procedure Set_Attribute_Kind_Of
 129      (Attribute : Attribute_Node_Id;
 130       To        : Attribute_Kind);
 131    --  Set the attribute kind of a known attribute. Does nothing if
 132    --  Attribute is Empty_Attribute.
 133
 134    function Attribute_Name_Of (Attribute : Attribute_Node_Id) return Name_Id;
 135    --  Returns the name of a known attribute. Returns No_Name if Attribute is
 136    --  Empty_Attribute.
 137
 138    function Variable_Kind_Of
 139      (Attribute : Attribute_Node_Id) return Variable_Kind;
 140    --  Returns the variable kind of a known attribute. Returns Undefined if
 141    --  Attribute is Empty_Attribute.
 142
 143    procedure Set_Variable_Kind_Of
 144      (Attribute : Attribute_Node_Id;
 145       To        : Variable_Kind);
 146    --  Set the variable kind of a known attribute. Does nothing if Attribute is
 147    --  Empty_Attribute.
 148
 149    function Optional_Index_Of (Attribute : Attribute_Node_Id) return Boolean;
 150    --  Returns True if Attribute is a known attribute and may have an
 151    --  optional index. Returns False otherwise.
 152
 153    function Next_Attribute
 154      (After : Attribute_Node_Id) return Attribute_Node_Id;
 155    --  Returns the attribute that follow After in the list of project level
 156    --  attributes or the list of attributes in a package.
 157    --  Returns Empty_Attribute if After is either Empty_Attribute or is the
 158    --  last of the list.
 159
 160    --------------
 161    -- Packages --
 162    --------------
 163
 164    type Package_Node_Id is private;
 165    --  Type to refer to a package, self initialized
 166
 167    Empty_Package : constant Package_Node_Id;
 168    --  Default value of Package_Node_Id objects
 169
 170    procedure Register_New_Package (Name : String; Id : out Package_Node_Id);
 171    --  Add a new package. Fails if the package has a duplicate name.
 172    --  Initially, the new package has no attributes. Id may be used to add
 173    --  attributes using procedure Register_New_Attribute below.
 174
 175    procedure Register_New_Attribute
 176      (Name               : String;
 177       In_Package         : Package_Node_Id;
 178       Attr_Kind          : Defined_Attribute_Kind;
 179       Var_Kind           : Defined_Variable_Kind;
 180       Index_Is_File_Name : Boolean := False;
 181       Opt_Index          : Boolean := False);
 182    --  Add a new attribute to registered package In_Package. Fails if the
 183    --  attribute has a duplicate name. See definition of type Attribute_Data
 184    --  above for the meaning of parameters Attr_Kind, Var_Kind,
 185    --  Index_Is_File_Name and Opt_Index.
 186
 187    function Package_Node_Id_Of (Name : Name_Id) return Package_Node_Id;
 188    --  Returns the package node id of the package with name Name. Returns
 189    --  Empty_Package if there is no package with this name.
 190
 191    procedure Add_Unknown_Package (Name : Name_Id; Id : out Package_Node_Id);
 192    --  Add a new package. The Name cannot be the name of a predefined or
 193    --  already registered package.
 194
 195    function First_Attribute_Of
 196      (Pkg : Package_Node_Id) return Attribute_Node_Id;
 197    --  Returns the first attribute in the list of attributes of package Pkg.
 198    --  Returns Empty_Attribute if Pkg is Empty_Package.
 199
 200    procedure Add_Attribute
 201      (To_Package     : Package_Node_Id;
 202       Attribute_Name : Name_Id;
 203       Attribute_Node : out Attribute_Node_Id);
 204    --  Add an attribute to the list for package To_Package. Attribute_Name
 205    --  cannot be the name of an existing attribute of the package.
 206    --  Does nothing if To_Package is Empty_Package.
 207
 208 private
 209    ----------------
 210    -- Attributes --
 211    ----------------
 212
 213    Attributes_Initial   : constant := 50;
 214    Attributes_Increment : constant := 50;
 215
 216    Attribute_Node_Low_Bound  : constant := 0;
 217    Attribute_Node_High_Bound : constant := 099_999_999;
 218
 219    type Attr_Node_Id is
 220      range Attribute_Node_Low_Bound .. Attribute_Node_High_Bound;
 221    --  Index type for table Attrs in the body
 222
 223    type Attribute_Node_Id is record
 224       Value : Attr_Node_Id := Attribute_Node_Low_Bound;
 225    end record;
 226    --  Full declaration of self-initialized private type
 227
 228    Empty_Attr : constant Attr_Node_Id := Attribute_Node_Low_Bound;
 229
 230    Empty_Attribute : constant Attribute_Node_Id := (Value => Empty_Attr);
 231
 232    First_Attribute : constant Attr_Node_Id := Attribute_Node_Low_Bound + 1;
 233
 234    First_Attribute_Node_Id : constant Attribute_Node_Id :=
 235                                (Value => First_Attribute);
 236
 237    Attribute_First : constant Attribute_Node_Id := First_Attribute_Node_Id;
 238
 239    --------------
 240    -- Packages --
 241    --------------
 242
 243    Packages_Initial   : constant := 10;
 244    Packages_Increment : constant := 50;
 245
 246    Package_Node_Low_Bound  : constant := 0;
 247    Package_Node_High_Bound : constant := 099_999_999;
 248
 249    type Pkg_Node_Id is
 250      range Package_Node_Low_Bound .. Package_Node_High_Bound;
 251    --  Index type for table Package_Attributes in the body
 252
 253    type Package_Node_Id is record
 254       Value : Pkg_Node_Id := Package_Node_Low_Bound;
 255    end record;
 256    --  Full declaration of self-initialized private type
 257
 258    Empty_Pkg : constant Pkg_Node_Id := Package_Node_Low_Bound;
 259
 260    Empty_Package : constant Package_Node_Id := (Value => Empty_Pkg);
 261
 262    First_Package : constant Pkg_Node_Id := Package_Node_Low_Bound + 1;
 263
 264    First_Package_Node_Id  : constant Package_Node_Id :=
 265                               (Value => First_Package);
 266
 267    Package_First : constant Package_Node_Id := First_Package_Node_Id;
 268
 269 end Prj.Attr;