URL
https://opencores.org/ocsvn/openrisc/openrisc/trunk
Subversion Repositories openrisc
[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [prj-attr.ads] - Rev 839
Go to most recent revision | Compare with Previous | Blame | View Log
------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- P R J . A T T R -- -- -- -- S p e c -- -- -- -- Copyright (C) 2001-2011, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 3, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- -- for more details. You should have received a copy of the GNU General -- -- Public License distributed with GNAT; see file COPYING3. If not, go to -- -- http://www.gnu.org/licenses for a complete copy of the license. -- -- -- -- GNAT was originally developed by the GNAT team at New York University. -- -- Extensive contributions were provided by Ada Core Technologies Inc. -- -- -- ------------------------------------------------------------------------------ -- This package defines packages and attributes in GNAT project files. -- There are predefined packages and attributes. -- It is also possible to define new packages with their attributes with Table; with GNAT.Strings; package Prj.Attr is function Package_Name_List return GNAT.Strings.String_List; -- Returns the list of valid package names, including those added by -- procedures Register_New_Package below. The String_Access components of -- the returned String_List should never be freed. procedure Initialize; -- Initialize the predefined project level attributes and the predefined -- packages and their attribute. This procedure should be called by -- Prj.Initialize. type Attribute_Kind is ( Unknown, -- The attribute does not exist Single, -- Single variable attribute (not an associative array) Associative_Array, -- Associative array attribute with a case sensitive index Optional_Index_Associative_Array, -- Associative array attribute with a case sensitive index and an -- optional source index. Case_Insensitive_Associative_Array, -- Associative array attribute with a case insensitive index Optional_Index_Case_Insensitive_Associative_Array -- Associative array attribute with a case insensitive index and an -- optional source index. ); -- Characteristics of an attribute. Optional_Index indicates that there -- may be an optional index in the index of the associative array, as in -- for Switches ("files.ada" at 2) use ... subtype Defined_Attribute_Kind is Attribute_Kind range Single .. Optional_Index_Case_Insensitive_Associative_Array; -- Subset of Attribute_Kinds that may be used for the attributes that is -- used when defining a new package. subtype All_Case_Insensitive_Associative_Array is Attribute_Kind range Case_Insensitive_Associative_Array .. Optional_Index_Case_Insensitive_Associative_Array; -- Subtype including both cases of Case_Insensitive_Associative_Array Max_Attribute_Name_Length : constant := 64; -- The maximum length of attribute names subtype Attribute_Name_Length is Positive range 1 .. Max_Attribute_Name_Length; type Attribute_Data (Name_Length : Attribute_Name_Length := 1) is record Name : String (1 .. Name_Length); -- The name of the attribute Attr_Kind : Defined_Attribute_Kind; -- The type of the attribute Index_Is_File_Name : Boolean; -- For associative arrays, indicate if the index is a file name, so -- that the attribute kind may be modified depending on the case -- sensitivity of file names. This is only taken into account when -- Attr_Kind is Associative_Array or Optional_Index_Associative_Array. Opt_Index : Boolean; -- True if there may be an optional index in the value of the index, -- as in: -- "file.ada" at 2 -- ("main.adb", "file.ada" at 1) Var_Kind : Defined_Variable_Kind; -- The attribute value kind: single or list end record; -- Name and characteristics of an attribute in a package registered -- explicitly with Register_New_Package (see below). type Attribute_Data_Array is array (Positive range <>) of Attribute_Data; -- A list of attribute name/characteristics to be used as parameter of -- procedure Register_New_Package below. -- In the subprograms below, when it is specified that the subprogram -- "fails", procedure Prj.Com.Fail is called. Unless it is specified -- otherwise, if Prj.Com.Fail returns, exception Prj.Prj_Error is raised. procedure Register_New_Package (Name : String; Attributes : Attribute_Data_Array); -- Add a new package with its attributes. This procedure can only be -- called after Initialize, but before any other call to a service of -- the Project Manager. Fail if the name of the package is empty or not -- unique, or if the names of the attributes are not different. ---------------- -- Attributes -- ---------------- type Attribute_Node_Id is private; -- The type to refers to an attribute, self-initialized Empty_Attribute : constant Attribute_Node_Id; -- Indicates no attribute. Default value of Attribute_Node_Id objects Attribute_First : constant Attribute_Node_Id; -- First attribute node id of project level attributes function Attribute_Node_Id_Of (Name : Name_Id; Starting_At : Attribute_Node_Id) return Attribute_Node_Id; -- Returns the node id of an attribute at the project level or in -- a package. Starting_At indicates the first known attribute node where -- to start the search. Returns Empty_Attribute if the attribute cannot -- be found. function Attribute_Kind_Of (Attribute : Attribute_Node_Id) return Attribute_Kind; -- Returns the attribute kind of a known attribute. Returns Unknown if -- Attribute is Empty_Attribute. -- -- To use this function, the following code should be used: -- -- Pkg : constant Package_Node_Id := -- Prj.Attr.Package_Node_Id_Of (Name => <package name>); -- Att : constant Attribute_Node_Id := -- Prj.Attr.Attribute_Node_Id_Of -- (Name => <attribute name>, -- Starting_At => First_Attribute_Of (Pkg)); -- Kind : constant Attribute_Kind := Attribute_Kind_Of (Att); -- -- However, do not use this function once you have an already parsed -- project tree. Instead, given a Project_Node_Id corresponding to the -- attribute declaration ("for Attr (index) use ..."), use for example: -- -- if Case_Insensitive (Attr, Tree) then ... procedure Set_Attribute_Kind_Of (Attribute : Attribute_Node_Id; To : Attribute_Kind); -- Set the attribute kind of a known attribute. Does nothing if -- Attribute is Empty_Attribute. function Attribute_Name_Of (Attribute : Attribute_Node_Id) return Name_Id; -- Returns the name of a known attribute. Returns No_Name if Attribute is -- Empty_Attribute. function Variable_Kind_Of (Attribute : Attribute_Node_Id) return Variable_Kind; -- Returns the variable kind of a known attribute. Returns Undefined if -- Attribute is Empty_Attribute. procedure Set_Variable_Kind_Of (Attribute : Attribute_Node_Id; To : Variable_Kind); -- Set the variable kind of a known attribute. Does nothing if Attribute is -- Empty_Attribute. function Optional_Index_Of (Attribute : Attribute_Node_Id) return Boolean; -- Returns True if Attribute is a known attribute and may have an -- optional index. Returns False otherwise. function Is_Read_Only (Attribute : Attribute_Node_Id) return Boolean; function Next_Attribute (After : Attribute_Node_Id) return Attribute_Node_Id; -- Returns the attribute that follow After in the list of project level -- attributes or the list of attributes in a package. -- Returns Empty_Attribute if After is either Empty_Attribute or is the -- last of the list. function Others_Allowed_For (Attribute : Attribute_Node_Id) return Boolean; -- True iff the index for an associative array attributes may be others -------------- -- Packages -- -------------- type Package_Node_Id is private; -- Type to refer to a package, self initialized Empty_Package : constant Package_Node_Id; -- Default value of Package_Node_Id objects Unknown_Package : constant Package_Node_Id; -- Value of an unknown package that has been found but is unknown procedure Register_New_Package (Name : String; Id : out Package_Node_Id); -- Add a new package. Fails if Name (the package name) is empty or is -- already the name of a package, and set Id to Empty_Package, -- if Prj.Com.Fail returns. Initially, the new package has no attributes. -- Id may be used to add attributes using procedure Register_New_Attribute -- below. procedure Register_New_Attribute (Name : String; In_Package : Package_Node_Id; Attr_Kind : Defined_Attribute_Kind; Var_Kind : Defined_Variable_Kind; Index_Is_File_Name : Boolean := False; Opt_Index : Boolean := False); -- Add a new attribute to registered package In_Package. Fails if Name -- (the attribute name) is empty, if In_Package is Empty_Package or if -- the attribute name has a duplicate name. See definition of type -- Attribute_Data above for the meaning of parameters Attr_Kind, Var_Kind, -- Index_Is_File_Name and Opt_Index. function Package_Node_Id_Of (Name : Name_Id) return Package_Node_Id; -- Returns the package node id of the package with name Name. Returns -- Empty_Package if there is no package with this name. function First_Attribute_Of (Pkg : Package_Node_Id) return Attribute_Node_Id; -- Returns the first attribute in the list of attributes of package Pkg. -- Returns Empty_Attribute if Pkg is Empty_Package. private ---------------- -- Attributes -- ---------------- Attributes_Initial : constant := 50; Attributes_Increment : constant := 100; Attribute_Node_Low_Bound : constant := 0; Attribute_Node_High_Bound : constant := 099_999_999; type Attr_Node_Id is range Attribute_Node_Low_Bound .. Attribute_Node_High_Bound; -- Index type for table Attrs in the body type Attribute_Node_Id is record Value : Attr_Node_Id := Attribute_Node_Low_Bound; end record; -- Full declaration of self-initialized private type Empty_Attr : constant Attr_Node_Id := Attribute_Node_Low_Bound; Empty_Attribute : constant Attribute_Node_Id := (Value => Empty_Attr); First_Attribute : constant Attr_Node_Id := Attribute_Node_Low_Bound + 1; First_Attribute_Node_Id : constant Attribute_Node_Id := (Value => First_Attribute); Attribute_First : constant Attribute_Node_Id := First_Attribute_Node_Id; -------------- -- Packages -- -------------- Packages_Initial : constant := 10; Packages_Increment : constant := 100; Package_Node_Low_Bound : constant := 0; Package_Node_High_Bound : constant := 099_999_999; type Pkg_Node_Id is range Package_Node_Low_Bound .. Package_Node_High_Bound; -- Index type for table Package_Attributes in the body type Package_Node_Id is record Value : Pkg_Node_Id := Package_Node_Low_Bound; end record; -- Full declaration of self-initialized private type Empty_Pkg : constant Pkg_Node_Id := Package_Node_Low_Bound; Empty_Package : constant Package_Node_Id := (Value => Empty_Pkg); Unknown_Pkg : constant Pkg_Node_Id := Package_Node_High_Bound; Unknown_Package : constant Package_Node_Id := (Value => Unknown_Pkg); First_Package : constant Pkg_Node_Id := Package_Node_Low_Bound + 1; First_Package_Node_Id : constant Package_Node_Id := (Value => First_Package); Package_First : constant Package_Node_Id := First_Package_Node_Id; ---------------- -- Attributes -- ---------------- type Attribute_Record is record Name : Name_Id; Var_Kind : Variable_Kind; Optional_Index : Boolean; Attr_Kind : Attribute_Kind; Read_Only : Boolean; Others_Allowed : Boolean; Next : Attr_Node_Id; end record; -- Data for an attribute package Attrs is new Table.Table (Table_Component_Type => Attribute_Record, Table_Index_Type => Attr_Node_Id, Table_Low_Bound => First_Attribute, Table_Initial => Attributes_Initial, Table_Increment => Attributes_Increment, Table_Name => "Prj.Attr.Attrs"); -- The table of the attributes -------------- -- Packages -- -------------- type Package_Record is record Name : Name_Id; Known : Boolean := True; First_Attribute : Attr_Node_Id; end record; -- Data for a package package Package_Attributes is new Table.Table (Table_Component_Type => Package_Record, Table_Index_Type => Pkg_Node_Id, Table_Low_Bound => First_Package, Table_Initial => Packages_Initial, Table_Increment => Packages_Increment, Table_Name => "Prj.Attr.Packages"); -- The table of the packages end Prj.Attr;
Go to most recent revision | Compare with Previous | Blame | View Log