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-2013, 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 3,  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 COPYING3.  If not, go to --
19-- http://www.gnu.org/licenses for a complete copy of the license.          --
20--                                                                          --
21-- GNAT was originally developed  by the GNAT team at  New York University. --
22-- Extensive contributions were provided by Ada Core Technologies Inc.      --
23--                                                                          --
24------------------------------------------------------------------------------
25
26--  This package defines packages and attributes in GNAT project files.
27--  There are predefined packages and attributes.
28
29--  It is also possible to define new packages with their attributes
30
31with Table;
32
33with GNAT.Strings;
34
35package Prj.Attr is
36
37   function Package_Name_List return GNAT.Strings.String_List;
38   --  Returns the list of valid package names, including those added by
39   --  procedures Register_New_Package below. The String_Access components of
40   --  the returned String_List should never be freed.
41
42   procedure Initialize;
43   --  Initialize the predefined project level attributes and the predefined
44   --  packages and their attribute. This procedure should be called by
45   --  Prj.Initialize.
46
47   type Attribute_Kind is (
48      Unknown,
49      --  The attribute does not exist
50
51      Single,
52      --  Single variable attribute (not an associative array)
53
54      Associative_Array,
55      --  Associative array attribute with a case sensitive index
56
57      Optional_Index_Associative_Array,
58      --  Associative array attribute with a case sensitive index and an
59      --  optional source index.
60
61      Case_Insensitive_Associative_Array,
62      --  Associative array attribute with a case insensitive index
63
64      Optional_Index_Case_Insensitive_Associative_Array
65      --  Associative array attribute with a case insensitive index and an
66      --  optional source index.
67   );
68   --  Characteristics of an attribute. Optional_Index indicates that there
69   --  may be an optional index in the index of the associative array, as in
70   --     for Switches ("files.ada" at 2) use ...
71
72   subtype Defined_Attribute_Kind is Attribute_Kind
73     range Single .. Optional_Index_Case_Insensitive_Associative_Array;
74   --  Subset of Attribute_Kinds that may be used for the attributes that is
75   --  used when defining a new package.
76
77   subtype All_Case_Insensitive_Associative_Array is Attribute_Kind range
78     Case_Insensitive_Associative_Array ..
79     Optional_Index_Case_Insensitive_Associative_Array;
80   --  Subtype including both cases of Case_Insensitive_Associative_Array
81
82   Max_Attribute_Name_Length : constant := 64;
83   --  The maximum length of attribute names
84
85   subtype Attribute_Name_Length is
86     Positive range 1 .. Max_Attribute_Name_Length;
87
88   type Attribute_Data (Name_Length : Attribute_Name_Length := 1) is record
89      Name : String (1 .. Name_Length);
90      --  The name of the attribute
91
92      Attr_Kind  : Defined_Attribute_Kind;
93      --  The type of the attribute
94
95      Index_Is_File_Name : Boolean;
96      --  For associative arrays, indicate if the index is a file name, so
97      --  that the attribute kind may be modified depending on the case
98      --  sensitivity of file names. This is only taken into account when
99      --  Attr_Kind is Associative_Array or Optional_Index_Associative_Array.
100
101      Opt_Index : Boolean;
102      --  True if there may be an optional index in the value of the index,
103      --  as in:
104      --    "file.ada" at 2
105      --    ("main.adb", "file.ada" at 1)
106
107      Var_Kind : Defined_Variable_Kind;
108      --  The attribute value kind: single or list
109
110   end record;
111   --  Name and characteristics of an attribute in a package registered
112   --  explicitly with Register_New_Package (see below).
113
114   type Attribute_Data_Array is array (Positive range <>) of Attribute_Data;
115   --  A list of attribute name/characteristics to be used as parameter of
116   --  procedure Register_New_Package below.
117
118   --  In the subprograms below, when it is specified that the subprogram
119   --  "fails", procedure Prj.Com.Fail is called. Unless it is specified
120   --  otherwise, if Prj.Com.Fail returns, exception Prj.Prj_Error is raised.
121
122   procedure Register_New_Package
123     (Name       : String;
124      Attributes : Attribute_Data_Array);
125   --  Add a new package with its attributes. This procedure can only be
126   --  called after Initialize, but before any other call to a service of
127   --  the Project Manager. Fail if the name of the package is empty or not
128   --  unique, or if the names of the attributes are not different.
129
130   ----------------
131   -- Attributes --
132   ----------------
133
134   type Attribute_Node_Id is private;
135   --  The type to refers to an attribute, self-initialized
136
137   Empty_Attribute : constant Attribute_Node_Id;
138   --  Indicates no attribute. Default value of Attribute_Node_Id objects
139
140   Attribute_First : constant Attribute_Node_Id;
141   --  First attribute node id of project level attributes
142
143   function Attribute_Node_Id_Of
144     (Name        : Name_Id;
145      Starting_At : Attribute_Node_Id) return Attribute_Node_Id;
146   --  Returns the node id of an attribute at the project level or in
147   --  a package. Starting_At indicates the first known attribute node where
148   --  to start the search. Returns Empty_Attribute if the attribute cannot
149   --  be found.
150
151   function Attribute_Kind_Of
152     (Attribute : Attribute_Node_Id) return Attribute_Kind;
153   --  Returns the attribute kind of a known attribute. Returns Unknown if
154   --  Attribute is Empty_Attribute.
155   --
156   --  To use this function, the following code should be used:
157   --
158   --      Pkg : constant Package_Node_Id :=
159   --              Prj.Attr.Package_Node_Id_Of (Name => <package name>);
160   --      Att : constant Attribute_Node_Id :=
161   --              Prj.Attr.Attribute_Node_Id_Of
162   --                (Name        => <attribute name>,
163   --                 Starting_At => First_Attribute_Of (Pkg));
164   --      Kind : constant Attribute_Kind := Attribute_Kind_Of (Att);
165   --
166   --  However, do not use this function once you have an already parsed
167   --  project tree. Instead, given a Project_Node_Id corresponding to the
168   --  attribute declaration ("for Attr (index) use ..."), use for example:
169   --
170   --      if Case_Insensitive (Attr, Tree) then ...
171
172   procedure Set_Attribute_Kind_Of
173     (Attribute : Attribute_Node_Id;
174      To        : Attribute_Kind);
175   --  Set the attribute kind of a known attribute. Does nothing if
176   --  Attribute is Empty_Attribute.
177
178   function Attribute_Name_Of (Attribute : Attribute_Node_Id) return Name_Id;
179   --  Returns the name of a known attribute. Returns No_Name if Attribute is
180   --  Empty_Attribute.
181
182   function Variable_Kind_Of
183     (Attribute : Attribute_Node_Id) return Variable_Kind;
184   --  Returns the variable kind of a known attribute. Returns Undefined if
185   --  Attribute is Empty_Attribute.
186
187   procedure Set_Variable_Kind_Of
188     (Attribute : Attribute_Node_Id;
189      To        : Variable_Kind);
190   --  Set the variable kind of a known attribute. Does nothing if Attribute is
191   --  Empty_Attribute.
192
193   function Optional_Index_Of (Attribute : Attribute_Node_Id) return Boolean;
194   --  Returns True if Attribute is a known attribute and may have an
195   --  optional index. Returns False otherwise.
196
197   function Is_Read_Only (Attribute : Attribute_Node_Id) return Boolean;
198
199   function Next_Attribute
200     (After : Attribute_Node_Id) return Attribute_Node_Id;
201   --  Returns the attribute that follow After in the list of project level
202   --  attributes or the list of attributes in a package.
203   --  Returns Empty_Attribute if After is either Empty_Attribute or is the
204   --  last of the list.
205
206   function Others_Allowed_For (Attribute : Attribute_Node_Id) return Boolean;
207   --  True iff the index for an associative array attributes may be others
208
209   --------------
210   -- Packages --
211   --------------
212
213   type Package_Node_Id is private;
214   --  Type to refer to a package, self initialized
215
216   Empty_Package : constant Package_Node_Id;
217   --  Default value of Package_Node_Id objects
218
219   Unknown_Package : constant Package_Node_Id;
220   --  Value of an unknown package that has been found but is unknown
221
222   procedure Register_New_Package (Name : String; Id : out Package_Node_Id);
223   --  Add a new package. Fails if Name (the package name) is empty or is
224   --  already the name of a package, and set Id to Empty_Package,
225   --  if Prj.Com.Fail returns. Initially, the new package has no attributes.
226   --  Id may be used to add attributes using procedure Register_New_Attribute
227   --  below.
228
229   procedure Register_New_Attribute
230     (Name               : String;
231      In_Package         : Package_Node_Id;
232      Attr_Kind          : Defined_Attribute_Kind;
233      Var_Kind           : Defined_Variable_Kind;
234      Index_Is_File_Name : Boolean := False;
235      Opt_Index          : Boolean := False);
236   --  Add a new attribute to registered package In_Package. Fails if Name
237   --  (the attribute name) is empty, if In_Package is Empty_Package or if
238   --  the attribute name has a duplicate name. See definition of type
239   --  Attribute_Data above for the meaning of parameters Attr_Kind, Var_Kind,
240   --  Index_Is_File_Name and Opt_Index.
241
242   function Package_Node_Id_Of (Name : Name_Id) return Package_Node_Id;
243   --  Returns the package node id of the package with name Name. Returns
244   --  Empty_Package if there is no package with this name.
245
246   function First_Attribute_Of
247     (Pkg : Package_Node_Id) return Attribute_Node_Id;
248   --  Returns the first attribute in the list of attributes of package Pkg.
249   --  Returns Empty_Attribute if Pkg is Empty_Package or Unknown_Package.
250
251private
252   ----------------
253   -- Attributes --
254   ----------------
255
256   Attributes_Initial   : constant := 50;
257   Attributes_Increment : constant := 100;
258
259   Attribute_Node_Low_Bound  : constant := 0;
260   Attribute_Node_High_Bound : constant := 099_999_999;
261
262   type Attr_Node_Id is
263     range Attribute_Node_Low_Bound .. Attribute_Node_High_Bound;
264   --  Index type for table Attrs in the body
265
266   type Attribute_Node_Id is record
267      Value : Attr_Node_Id := Attribute_Node_Low_Bound;
268   end record;
269   --  Full declaration of self-initialized private type
270
271   Empty_Attr : constant Attr_Node_Id := Attribute_Node_Low_Bound;
272
273   Empty_Attribute : constant Attribute_Node_Id := (Value => Empty_Attr);
274
275   First_Attribute : constant Attr_Node_Id := Attribute_Node_Low_Bound + 1;
276
277   First_Attribute_Node_Id : constant Attribute_Node_Id :=
278                               (Value => First_Attribute);
279
280   Attribute_First : constant Attribute_Node_Id := First_Attribute_Node_Id;
281
282   --------------
283   -- Packages --
284   --------------
285
286   Packages_Initial   : constant := 10;
287   Packages_Increment : constant := 100;
288
289   Package_Node_Low_Bound  : constant := 0;
290   Package_Node_High_Bound : constant := 099_999_999;
291
292   type Pkg_Node_Id is
293     range Package_Node_Low_Bound .. Package_Node_High_Bound;
294   --  Index type for table Package_Attributes in the body
295
296   type Package_Node_Id is record
297      Value : Pkg_Node_Id := Package_Node_Low_Bound;
298   end record;
299   --  Full declaration of self-initialized private type
300
301   Empty_Pkg       : constant Pkg_Node_Id     := Package_Node_Low_Bound;
302   Empty_Package   : constant Package_Node_Id := (Value => Empty_Pkg);
303   Unknown_Pkg     : constant Pkg_Node_Id     := Package_Node_High_Bound;
304   Unknown_Package : constant Package_Node_Id := (Value => Unknown_Pkg);
305   First_Package   : constant Pkg_Node_Id     := Package_Node_Low_Bound + 1;
306
307   First_Package_Node_Id  : constant Package_Node_Id :=
308                              (Value => First_Package);
309
310   Package_First : constant Package_Node_Id := First_Package_Node_Id;
311
312   ----------------
313   -- Attributes --
314   ----------------
315
316   type Attribute_Record is record
317      Name           : Name_Id;
318      Var_Kind       : Variable_Kind;
319      Optional_Index : Boolean;
320      Attr_Kind      : Attribute_Kind;
321      Read_Only      : Boolean;
322      Others_Allowed : Boolean;
323      Next           : Attr_Node_Id;
324   end record;
325   --  Data for an attribute
326
327   package Attrs is
328      new Table.Table (Table_Component_Type => Attribute_Record,
329                       Table_Index_Type     => Attr_Node_Id,
330                       Table_Low_Bound      => First_Attribute,
331                       Table_Initial        => Attributes_Initial,
332                       Table_Increment      => Attributes_Increment,
333                       Table_Name           => "Prj.Attr.Attrs");
334   --  The table of the attributes
335
336   --------------
337   -- Packages --
338   --------------
339
340   type Package_Record is record
341      Name             : Name_Id;
342      Known            : Boolean := True;
343      First_Attribute  : Attr_Node_Id;
344   end record;
345   --  Data for a package
346
347   package Package_Attributes is
348      new Table.Table (Table_Component_Type => Package_Record,
349                       Table_Index_Type     => Pkg_Node_Id,
350                       Table_Low_Bound      => First_Package,
351                       Table_Initial        => Packages_Initial,
352                       Table_Increment      => Packages_Increment,
353                       Table_Name           => "Prj.Attr.Packages");
354   --  The table of the packages
355
356end Prj.Attr;
357