Subversion Repositories openrisc

------------------------------------------------------------------------------
--                                                                          --
--                         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;