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-2005, 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,  51  Franklin  Street,  Fifth  Floor, --
  20 -- Boston, MA 02110-1301, 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
  30 --  It is also possible to define new packages with their attributes
  31
  32 with Table;
  33
  34 package Prj.Attr is
  35
  36    procedure Initialize;
  37    --  Initialize the predefined project level attributes and the predefined
  38    --  packages and their attribute. This procedure should be called by
  39    --  Prj.Initialize.
  40
  41    type Attribute_Kind is
  42      (Unknown,
  43       Single,
  44       Associative_Array,
  45       Optional_Index_Associative_Array,
  46       Case_Insensitive_Associative_Array,
  47       Optional_Index_Case_Insensitive_Associative_Array);
  48    --  Characteristics of an attribute. Optional_Index indicates that there
  49    --  may be an optional index in the index of the associative array, as in
  50    --     for Switches ("files.ada" at 2) use ...
  51
  52    subtype Defined_Attribute_Kind is Attribute_Kind
  53      range Single .. Optional_Index_Case_Insensitive_Associative_Array;
  54    --  Subset of Attribute_Kinds that may be used for the attributes that is
  55    --  used when defining a new package.
  56
  57    Max_Attribute_Name_Length : constant := 64;
  58    --  The maximum length of attribute names
  59
  60    subtype Attribute_Name_Length is
  61      Positive range 1 .. Max_Attribute_Name_Length;
  62
  63    type Attribute_Data (Name_Length : Attribute_Name_Length := 1) is record
  64       Name : String (1 .. Name_Length);
  65       --  The name of the attribute
  66
  67       Attr_Kind  : Defined_Attribute_Kind;
  68       --  The type of the attribute
  69
  70       Index_Is_File_Name : Boolean;
  71       --  For associative arrays, indicate if the index is a file name, so
  72       --  that the attribute kind may be modified depending on the case
  73       --  sensitivity of file names. This is only taken into account when
  74       --  Attr_Kind is Associative_Array or Optional_Index_Associative_Array.
  75
  76       Opt_Index : Boolean;
  77       --  True if there may be an optional index in the value of the index,
  78       --  as in:
  79       --    "file.ada" at 2
  80       --    ("main.adb", "file.ada" at 1)
  81
  82       Var_Kind : Defined_Variable_Kind;
  83       --  The attribute value kind: single or list
  84
  85    end record;
  86    --  Name and characteristics of an attribute in a package registered
  87    --  explicitly with Register_New_Package (see below).
  88
  89    type Attribute_Data_Array is array (Positive range <>) of Attribute_Data;
  90    --  A list of attribute name/characteristics to be used as parameter of
  91    --  procedure Register_New_Package below.
  92
  93    --  In the subprograms below, when it is specified that the subprogram
  94    --  "fails", procedure Prj.Com.Fail is called. Unless it is specified
  95    --  otherwise, if Prj.Com.Fail returns, exception Prj.Prj_Error is raised.
  96
  97    procedure Register_New_Package
  98      (Name       : String;
  99       Attributes : Attribute_Data_Array);
 100    --  Add a new package with its attributes. This procedure can only be
 101    --  called after Initialize, but before any other call to a service of
 102    --  the Project Manager. Fail if the name of the package is empty or not
 103    --  unique, or if the names of the attributes are not different.
 104
 105    ----------------
 106    -- Attributes --
 107    ----------------
 108
 109    type Attribute_Node_Id is private;
 110    --  The type to refers to an attribute, self-initialized
 111
 112    Empty_Attribute : constant Attribute_Node_Id;
 113    --  Indicates no attribute. Default value of Attribute_Node_Id objects.
 114
 115    Attribute_First : constant Attribute_Node_Id;
 116    --  First attribute node id of project level attributes
 117
 118    function Attribute_Node_Id_Of
 119      (Name        : Name_Id;
 120       Starting_At : Attribute_Node_Id) return Attribute_Node_Id;
 121    --  Returns the node id of an attribute at the project level or in
 122    --  a package. Starting_At indicates the first known attribute node where
 123    --  to start the search. Returns Empty_Attribute if the attribute cannot
 124    --  be found.
 125
 126    function Attribute_Kind_Of
 127      (Attribute : Attribute_Node_Id) return Attribute_Kind;
 128    --  Returns the attribute kind of a known attribute. Returns Unknown if
 129    --  Attribute is Empty_Attribute.
 130
 131    procedure Set_Attribute_Kind_Of
 132      (Attribute : Attribute_Node_Id;
 133       To        : Attribute_Kind);
 134    --  Set the attribute kind of a known attribute. Does nothing if
 135    --  Attribute is Empty_Attribute.
 136
 137    function Attribute_Name_Of (Attribute : Attribute_Node_Id) return Name_Id;
 138    --  Returns the name of a known attribute. Returns No_Name if Attribute is
 139    --  Empty_Attribute.
 140
 141    function Variable_Kind_Of
 142      (Attribute : Attribute_Node_Id) return Variable_Kind;
 143    --  Returns the variable kind of a known attribute. Returns Undefined if
 144    --  Attribute is Empty_Attribute.
 145
 146    procedure Set_Variable_Kind_Of
 147      (Attribute : Attribute_Node_Id;
 148       To        : Variable_Kind);
 149    --  Set the variable kind of a known attribute. Does nothing if Attribute is
 150    --  Empty_Attribute.
 151
 152    function Optional_Index_Of (Attribute : Attribute_Node_Id) return Boolean;
 153    --  Returns True if Attribute is a known attribute and may have an
 154    --  optional index. Returns False otherwise.
 155
 156    function Next_Attribute
 157      (After : Attribute_Node_Id) return Attribute_Node_Id;
 158    --  Returns the attribute that follow After in the list of project level
 159    --  attributes or the list of attributes in a package.
 160    --  Returns Empty_Attribute if After is either Empty_Attribute or is the
 161    --  last of the list.
 162
 163    --------------
 164    -- Packages --
 165    --------------
 166
 167    type Package_Node_Id is private;
 168    --  Type to refer to a package, self initialized
 169
 170    Empty_Package : constant Package_Node_Id;
 171    --  Default value of Package_Node_Id objects
 172
 173    procedure Register_New_Package (Name : String; Id : out Package_Node_Id);
 174    --  Add a new package. Fails if Name (the package name) is empty or is
 175    --  already the name of a package, and set Id to Empty_Package,
 176    --  if Prj.Com.Fail returns. Initially, the new package has no attributes.
 177    --  Id may be used to add attributes using procedure Register_New_Attribute
 178    --  below.
 179
 180    procedure Register_New_Attribute
 181      (Name               : String;
 182       In_Package         : Package_Node_Id;
 183       Attr_Kind          : Defined_Attribute_Kind;
 184       Var_Kind           : Defined_Variable_Kind;
 185       Index_Is_File_Name : Boolean := False;
 186       Opt_Index          : Boolean := False);
 187    --  Add a new attribute to registered package In_Package. Fails if Name
 188    --  (the attribute name) is empty, if In_Package is Empty_Package or if
 189    --  the attribute name has a duplicate name. See definition of type
 190    --  Attribute_Data above for the meaning of parameters Attr_Kind, Var_Kind,
 191    --  Index_Is_File_Name and Opt_Index.
 192
 193    function Package_Node_Id_Of (Name : Name_Id) return Package_Node_Id;
 194    --  Returns the package node id of the package with name Name. Returns
 195    --  Empty_Package if there is no package with this name.
 196
 197    function First_Attribute_Of
 198      (Pkg : Package_Node_Id) return Attribute_Node_Id;
 199    --  Returns the first attribute in the list of attributes of package Pkg.
 200    --  Returns Empty_Attribute if Pkg is Empty_Package.
 201
 202 private
 203    ----------------
 204    -- Attributes --
 205    ----------------
 206
 207    Attributes_Initial   : constant := 50;
 208    Attributes_Increment : constant := 50;
 209
 210    Attribute_Node_Low_Bound  : constant := 0;
 211    Attribute_Node_High_Bound : constant := 099_999_999;
 212
 213    type Attr_Node_Id is
 214      range Attribute_Node_Low_Bound .. Attribute_Node_High_Bound;
 215    --  Index type for table Attrs in the body
 216
 217    type Attribute_Node_Id is record
 218       Value : Attr_Node_Id := Attribute_Node_Low_Bound;
 219    end record;
 220    --  Full declaration of self-initialized private type
 221
 222    Empty_Attr : constant Attr_Node_Id := Attribute_Node_Low_Bound;
 223
 224    Empty_Attribute : constant Attribute_Node_Id := (Value => Empty_Attr);
 225
 226    First_Attribute : constant Attr_Node_Id := Attribute_Node_Low_Bound + 1;
 227
 228    First_Attribute_Node_Id : constant Attribute_Node_Id :=
 229                                (Value => First_Attribute);
 230
 231    Attribute_First : constant Attribute_Node_Id := First_Attribute_Node_Id;
 232
 233    --------------
 234    -- Packages --
 235    --------------
 236
 237    Packages_Initial   : constant := 10;
 238    Packages_Increment : constant := 50;
 239
 240    Package_Node_Low_Bound  : constant := 0;
 241    Package_Node_High_Bound : constant := 099_999_999;
 242
 243    type Pkg_Node_Id is
 244      range Package_Node_Low_Bound .. Package_Node_High_Bound;
 245    --  Index type for table Package_Attributes in the body
 246
 247    type Package_Node_Id is record
 248       Value : Pkg_Node_Id := Package_Node_Low_Bound;
 249    end record;
 250    --  Full declaration of self-initialized private type
 251
 252    Empty_Pkg : constant Pkg_Node_Id := Package_Node_Low_Bound;
 253
 254    Empty_Package : constant Package_Node_Id := (Value => Empty_Pkg);
 255
 256    First_Package : constant Pkg_Node_Id := Package_Node_Low_Bound + 1;
 257
 258    First_Package_Node_Id  : constant Package_Node_Id :=
 259                               (Value => First_Package);
 260
 261    Package_First : constant Package_Node_Id := First_Package_Node_Id;
 262
 263    ----------------
 264    -- Attributes --
 265    ----------------
 266
 267    type Attribute_Record is record
 268       Name           : Name_Id;
 269       Var_Kind       : Variable_Kind;
 270       Optional_Index : Boolean;
 271       Attr_Kind      : Attribute_Kind;
 272       Next           : Attr_Node_Id;
 273    end record;
 274    --  Data for an attribute
 275
 276    package Attrs is
 277       new Table.Table (Table_Component_Type => Attribute_Record,
 278                        Table_Index_Type     => Attr_Node_Id,
 279                        Table_Low_Bound      => First_Attribute,
 280                        Table_Initial        => Attributes_Initial,
 281                        Table_Increment      => Attributes_Increment,
 282                        Table_Name           => "Prj.Attr.Attrs");
 283    --  The table of the attributes
 284
 285    --------------
 286    -- Packages --
 287    --------------
 288
 289    type Package_Record is record
 290       Name            : Name_Id;
 291       Known           : Boolean := True;
 292       First_Attribute : Attr_Node_Id;
 293    end record;
 294    --  Data for a package
 295
 296    package Package_Attributes is
 297       new Table.Table (Table_Component_Type => Package_Record,
 298                        Table_Index_Type     => Pkg_Node_Id,
 299                        Table_Low_Bound      => First_Package,
 300                        Table_Initial        => Packages_Initial,
 301                        Table_Increment      => Packages_Increment,
 302                        Table_Name           => "Prj.Attr.Packages");
 303    --  The table of the packages
 304
 305 end Prj.Attr;