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