File : asis-extensions.ads


------------------------------------------------------------------------------
--                                                                          --
--                        ASIS-for-GNAT COMPONENTS                          --
--                                                                          --
--                      A S I S . E X T E N S I O N S                       --
--                                                                          --
--                                 S p e c                                  --
--                                                                          --
--            Copyright (c) 1995-1999, Free Software Foundation, Inc.       --
--                                                                          --
-- ASIS-for-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 --
-- Software Foundation;  either version 2,  or  (at your option)  any later --
-- version. ASIS-for-GNAT is distributed  in the hope  that it will be use- --
-- ful, but WITHOUT ANY WARRANTY; without even the implied warranty of MER- --
-- CHANTABILITY  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  ASIS-for-GNAT; see  file --
-- COPYING. If not, write to the Free Software Foundation,  59 Temple Place --
-- Suite 330,  Boston, MA 02111-1307, USA.                                  --
--                                                                          --
-- As a special exception,  if other files  instantiate  generics from this --
-- unit, or you link  this unit with other files  to produce an executable, --
-- this  unit  does not  by itself cause  the resulting  executable  to  be --
-- covered  by the  GNU  General  Public  License.  This exception does not --
-- however invalidate  any other reasons why  the executable file  might be --
-- covered by the  GNU Public License.                                      --
--                                                                          --
-- ASIS-for-GNAT was originally developed  by the ASIS-for-GNAT team at the --
-- Software  Engineering  Laboratory  of  the Swiss  Federal  Institute  of --
-- Technology (LGL-EPFL) in Lausanne,  Switzerland, in cooperation with the --
-- Scientific  Research  Computer  Center of  Moscow State University (SRCC --
-- MSU), Russia,  with funding partially provided  by grants from the Swiss --
-- National  Science  Foundation  and  the  Swiss  Academy  of  Engineering --
-- Sciences.  ASIS-for-GNAT is now maintained by  Ada Core Technologies Inc --
-- (http://www.gnat.com).                                                   --
--                                                                          --
------------------------------------------------------------------------------

--  This package contains some ASIS extensions which are neede by the ASIS
--  implementation for GNAT itself, or which are considered to be useful for
--  ASIS applications.
--
--  Most of these extensions may be implemented as secondary ASIS queries,
--  but we oftenly use some optimization based on direct traversing of the
--  GNAT tree and obtaining the needed semantic information from it.

--  In this package we follow the GNAT, but not ASIS coding and documentation
--  style, but for some queries we use the ASIS-style lists of Appropriate,
--  Expected and returned kinds.

with Ada.Unchecked_Deallocation;

with Asis.Text; use Asis.Text;

package Asis.Extensions is

   -----------------------
   -- List Access Types --
   -----------------------

   type Element_List_Access is access Element_List;
   type Compilation_Unit_List_Access is access Compilation_Unit_List;

   procedure Free is new Ada.Unchecked_Deallocation
     (Element_List, Element_List_Access);

   procedure Free is new Ada.Unchecked_Deallocation
     (Compilation_Unit_List, Compilation_Unit_List_Access);

   ------------------------------------------------------
   -- Placeholders for Traverse_Element instantiations --
   ------------------------------------------------------

   --  If you do not need the state of traversing, and if you do not need
   --  actual for Post-Operation in this case (this is the common case for
   --  many situations when some simple traversing is requred), the following
   --  declarations may be used:

   type No_State is (Not_Used);
   --  Placeholder for the State_Information formal type

   procedure No_Op
     (Element : Asis.Element;
      Control : in out Traverse_Control;
      State   : in out No_State);
   --  Placeholder for the formal Post_Operation procedure

   --------------------
   -- Test functions --
   --------------------

   function Is_Primitive_Operation
     (Declaration : Asis.Element)
      return        Boolean;
   --  Checks if its argument is a declaration of a (user-defined) primitive
   --  operation of some type (both explicit and implicit declarations are
   --  expected). Returns False for a declaration of a non-primitive operation
   --  and for any unexpected argument
   --
   --  Expected Element_Kinds:
   --     A_Procedure_Declaration
   --     A_Function_Declaration
   --     A_Procedure_Renaming_Declaration
   --     A_Function_Renaming_Declaration

   function Acts_As_Spec (Declaration : Asis.Element) return Boolean;
   --  Checks if its argument is a subprogram body declaration for which no
   --  separate subprogram declaration exists. Returns False for any
   --  unexpected argument
   --
   --  Expected Element_Kinds:
   --     A_Procedure_Body_Declaration
   --     A_Function_Body_Declaration
   --     A_Procedure_Body_Stub
   --     A_Function_Body_Stub

   function Is_Renaming_As_Body (Declaration : Asis.Element) return Boolean;
   --  Checks if its argument is a reanming-as-body declaration.
   --  Returns False for any unexpected argument.
   --
   --  Expected Element_Kinds:
   --     A_Procedure_Renaning_Declaration
   --     A_Function_Renaming_Declaration

   function Is_Completed (Declaration : Asis.Element) return Boolean;
   --  Checks is its argument (which is expected to be a declaration requiring
   --  completion) has a completion in its enclosed ASIS Context.
   --
   --  Expected Element_Kinds (this list is not complete ???)
   --     A_Procedure_Declaration
   --     A_Function_Declaration

   function Is_True_Expression
     (Expression : Asis.Expression)
      return       Boolean;
   --  Checks if Expression is an expression in Ada sense, that is if it
   --  is an expression as defined in RM 4.4, and the type of this expression
   --  can be represented in ASIS. For cases of An_Expression Element for
   --  which Is_True_Expression is True, the Corresponding_Expression_Type
   --  query should yield non-Nil result
   --
   --  Expected Element_Kinds:
   --     An_Expression

   function Is_Static (Expression : Asis.Expression) return Boolean;
   --  Checks if Expression is static in the GNAT sense, that is if the
   --  compiler computes its value during the compilation time. We believe,
   --  that this notion of a static expression is close to the definition of
   --  static expression in RM 95, but we can not guarantee this. Returns
   --  False for any unexpected Element
   --
   --  Expected Element_Kinds:
   --     An_Expression for which Is_True_Expression yields True.

   -----------------------------------------------------
   -- Modified versions of the "primary" ASIS queries --
   -----------------------------------------------------

   --  This section contains the modified versions of the queries defined
   --  in the standard ASIS packages. The names of these modified versions
   --  may or may not be the same as in the "core" ASIS

   -------------------
   -- Asis.Elements --
   -------------------

   generic

      type State_Information is limited private;

      with procedure Pre_Operation
                       (Element : in     Asis.Element;
                        Control : in out Traverse_Control;
                        State   : in out State_Information) is <>;

      with procedure Post_Operation
                       (Element : in     Asis.Element;
                        Control : in out Traverse_Control;
                        State   : in out State_Information) is <>;

   procedure Traverse_Unit
     (Unit    : in     Asis.Compilation_Unit;
      Control : in out Traverse_Control;
      State   : in out State_Information);
   --  This is slightly generalized version of Asis.Iterator.Traverse_Element.
   --  Traverse_Unit instantieates traverse_Element passing its formal
   --  parameters as actuals. It goes into all the first-depth-level structural
   --  components of the argument unit and applies the instance of
   --  Traverse_Element to it.
   --
   --  If the value of traverse Control becomes Terminate_Immediately,
   --  traversing of all the unit componets is terminated (that is, if it
   --  happens in some context clause Element, the Unit declaration Element
   --  will not be traversed.
   --
   --  Appropriate Unit_Kinds:
   --     A_Procedure
   --     A_Function
   --     A_Package
   --
   --     A_Generic_Procedure
   --     A_Generic_Function
   --     A_Generic_Package
   --
   --     A_Procedure_Instance
   --     A_Function_Instance
   --     A_Package_Instance
   --
   --     A_Procedure_Renaming
   --     A_Function_Renaming
   --     A_Package_Renaming
   --
   --     A_Generic_Procedure_Renaming
   --     A_Generic_Function_Renaming
   --     A_Generic_Package_Renaming
   --
   --     A_Procedure_Body
   --     A_Procedure_Body
   --     A_Function_Body
   --     A_Package_Body
   --
   --     A_Procedure_Body_Subunit
   --     A_Function_Body_Subunit
   --     A_Package_Body_Subunit
   --     A_Task_Body_Subunit
   --     A_Protected_Body_Subunit

   -----------------------
   -- Asis.Declarations --
   -----------------------

   function Formal_Subprogram_Default
     (Declaration : Asis.Generic_Formal_Parameter)
      return        Asis.Expression;
   --  This is a modified version of the query Formal_Subprogram_Default
   --  adjusted for use in the implementation of Asis.Elements.Traverse_Element
   --  generic procedure. Similarly to that ASIS query, it returns the name
   --  appearing after the reserved word IS in the given generic for
   --  A_Name_Default Element, but if its argument is of another kind from
   --  Default_Kinds, it returns Nil_Element instead of raising
   --  ASIS_Inappropriate_Element.
   --
   --  Appropriate Declaration_Kinds:
   --      A_Formal_Function_Declaration
   --      A_Formal_Procedure_Declaration
   --
   --  Returns Element_Kinds:
   --      An_Expression

   function Primary_Owner
     (Declaration : Asis.Declaration)
      return        Asis.Declaration;
   --  In the case that Declaration is Is_Primary_Operation for some tagged
   --  type, this function returns the tagged type definition for which it is
   --  a primary operation. (Note, that a subprogram declaration may be a
   --  primary operation for more then one type, but it may be a primary
   --  operation for at most one tagged type). Returns Nil_Element in all
   --  other cases.
   --
   --  Appropriate Declaration_Kinds:
   --     A_Procedure_Declaration
   --     A_Function_Declaration
   --     A_Procedure_Renaming_Declaration
   --     A_Function_Renaming_Declaration

   ----------------------
   -- Asis.Expressions --
   ----------------------

   function Corresponding_Called_Function_Unwinded
     (Expression : Asis.Expression)
      return       Asis.Declaration;
   --  A modification of Asis.Expressions.Corresponding_Called_Function which
   --  unwinds all the renamings in the case where the function name in the
   --  argument function call is defined by a renaming declaration. This
   --  function returns the declaration of the called function *entity*.
   --
   --  Appropriate Expression_Kinds:
   --      A_Function_Call
   --
   --  Returns Declaration_Kinds:
   --      Not_A_Declaration
   --      A_Function_Declaration
   --      A_Function_Body_Declaration
   --      A_Function_Body_Stub
   --      A_Function_Renaming_Declaration
   --      A_Function_Instantiation
   --      A_Formal_Function_Declaration

   ---------------------
   -- Asis.Statements --
   ---------------------

   function Corresponding_Called_Entity_Unwinded
     (Statement : Asis.Statement)
      return      Asis.Declaration;

   --  A modification of Asis.Statements.Corresponding_Called_Entity which
   --  unwinds all the renamings in the case where the procedure or entry name
   --  in the argument call is defined by a renaming declaration. This function
   --  returns the declaration of the callable *entity*.
   --
   --  Appropriate Statement_Kinds:
   --      An_Entry_Call_Statement
   --      A_Procedure_Call_Statement
   --
   --  Returns Declaration_Kinds:
   --      Not_A_Declaration
   --      A_Procedure_Declaration
   --      A_Procedure_Body_Declaration
   --      A_Procedure_Body_Stub
   --      A_Procedure_Renaming_Declaration
   --      A_Procedure_Instantiation
   --      A_Formal_Procedure_Declaration
   --      An_Entry_Declaration

   --------------------------------------
   -- Extensions of ASIS functionality --
   --------------------------------------

   ----------------------------
   -- Asis.Compilation_Units --
   ----------------------------

   function Is_Obsolete (Right : Asis.Compilation_Unit) return Boolean;
   --  Checks if the argument unit, Right, is obsolete. A unit is not
   --  obsolete, if the source for this unit is available and if it
   --  is the same as the source used for creating the trees. All
   --  unit kinds are expected, except nil, unknown and nonexistent
   --  units. Always returns True for any non-expected unit. In case
   --  of '-SA' Context, always returns False for any expected unit.

   type Source_File_Statuses is (
      --  Status of the source file corresponding to a given unit

      No_File_Status,
      --  Nil value, used for nil, non-existent, and unknown units

      Absent,
      --  No source file available. This is always the case for the
      --  predefined Standard package, nil, unknown and non-existent
      --  units.

      Older,
      --  The available source file is older then the source used
      --  to create tree files

      Newer,
      --  The available source file is newer then the source used
      --  to create tree files

      Up_To_Date);
      --  The available source file is the same as the source used
      --  to create tree files

   function Source_File_Status
     (Right : Asis.Compilation_Unit)
      return  Source_File_Statuses;
   --  Checks the status of the source file for the argument unit.

   function Is_Main_Unit_In_Tree
     (Right : Asis.Compilation_Unit)
      return  Boolean;
   --  Checks if the argument unit, Right, is a main unit from some compilation
   --  which has created a tree within the set of tree files making up the
   --  enclosing Context of this unit.

   function Compilation_Dependencies
     (Main_Unit : Asis.Compilation_Unit)
      return      Asis.Compilation_Unit_List;
   --  Provides the full list of units upon which Main_Unit depends
   --  in the GNAT compilation system. The kind of dependencies
   --  reported by this query combine semantic dependencies as
   --  defined by RM 95 and GNAT-specific dependencies. Main_Unit
   --  should be recompiled if any of the units from the returned
   --  list has been changed.
   --
   --  Main_Unit should be a main unit from some compilation which
   --  has created a tree wile from the set of tree files making up
   --  the enclosing Context of Main_Unit.
   --
   --  ASIS_Inappropriate_Compilation_Unit is raised if Main_Unit
   --  does not satisfy this restriction.
   --
   --  Note, that this query is supposed to be used for ASIS Contexts
   --  representing complete Ada partitions, otherwise it may return
   --  formally correct, but meaningless results.
   --
   --  The interface of this query is still subject to design discussions???
   --  In particular, some limitations may be imposed on appropriate unit
   --  kinds, or a  special parameter may be added to filter out some parts
   --  of the result
   --
   --  Appropriate Unit_Kinds:
   --     A_Procedure
   --     A_Function
   --     A_Package
   --     A_Generic_Procedure
   --     A_Generic_Function
   --     A_Generic_Package
   --
   --     A_Procedure_Instance
   --     A_Function_Instance
   --     A_Package_Instance
   --
   --     A_Procedure_Renaming
   --     A_Function_Renaming
   --     A_Package_Renaming
   --
   --     A_Generic_Procedure_Renaming
   --     A_Generic_Function_Renaming
   --     A_Generic_Package_Renaming
   --
   --     A_Procedure_Body
   --     A_Function_Body
   --     A_Package_Body
   --
   --     A_Procedure_Body_Subunit
   --     A_Function_Body_Subunit
   --     A_Package_Body_Subunit
   --     A_Task_Body_Subunit
   --     A_Protected_Body_Subunit
   --
   --  Returns Unit_Kinds:
   --     A_Procedure
   --     A_Function
   --     A_Package
   --     A_Generic_Procedure
   --     A_Generic_Function
   --     A_Generic_Package
   --
   --     A_Procedure_Instance
   --     A_Function_Instance
   --     A_Package_Instance
   --
   --     A_Procedure_Renaming
   --     A_Function_Renaming
   --     A_Package_Renaming
   --
   --     A_Generic_Procedure_Renaming
   --     A_Generic_Function_Renaming
   --     A_Generic_Package_Renaming
   --
   --     A_Procedure_Body
   --     A_Function_Body
   --     A_Package_Body
   --
   --     A_Procedure_Body_Subunit
   --     A_Function_Body_Subunit
   --     A_Package_Body_Subunit
   --     A_Task_Body_Subunit
   --     A_Protected_Body_Subunit

   ------------------------------------
   -- Extensions to Asis.Expressions --
   ------------------------------------

   function Corresponding_First_Definition
     (Defining_Name : Asis.Defining_Name)
      return          Asis.Defining_Name;
   --  In case there is more then one defining occurence of an argument
   --  Defining_Name representing the same view of the same entity (such as a
   --  defining unit name for a program unit for which separate spec and body
   --  are present and a formal parameter name for a generic subprogram or
   --  subprogram having a separate spec) this function returns the first
   --  defining occurence which actially introduces the corresponding entity.
   --  If there are only one defining occurence of the argument Name, or if
   --  for some reason the first defining occurence cannot be returned, the
   --  argument name is returned.
   --
   --  Appropriate Element kinds:
   --      A_Defining_Name
   --
   --  Returns Element kinds:
   --      A_Defining_Name

   function Corresponding_Body_Parameter_Definition
     (Defining_Name : Asis.Defining_Name)
      return          Asis.Defining_Name;
   --  When applying to a defining name which is a name of a formal parameter
   --  of a subprogram, this function returns the defining name of this
   --  parameter from a subprogram body. If there is no body for this
   --  subprogram, Nil_Element is returned. If Defining_Name is not a
   --  defining name of a formal subprogram parameter, Nil_Element is
   --  returned.
   --
   --  Appropriate Element kinds:
   --      A_Defining_Identifier
   --
   --  Returns Element kinds:
   --      A_Defining_Identifier
   --      Not_An_Element

   -----------------------------
   -- Extensions to Asis.Text --
   -----------------------------

   function Element_Span_In_Template
     (Element : Asis.Element)
      return    Asis.Text.Span;
   --  If Is_Part_Of_Instance is True for the argument Element, then this
   --  function returns the span of the corresponding piece of code in the
   --  generic template. Otherwise a Nil_Span is returned. Nil_Span is also
   --  returned if Is_Part_Of_Implicit Element is True for Element.

   function Element_Image_In_Template
     (Element : Asis.Element)
      return    Program_Text;
   --  If Is_Part_Of_Instancce is True for the argument Element, then this
   --  function returns the image of the corresponding piece of code in the
   --  generic template. Otherwise a null string is returned. A null string
   --  is also returned if Is_Part_Of_Implicit_ELement is true for Element

   --------------------------------
   -- General_Purpose Extensions --
   --------------------------------

   function Get_Last_Component (E : Asis.Element) return Asis.Element;
   --  Returns the right-most direct component of its argument. Returns
   --  Nil_Element if its argument has no components. It is an error to
   --  call this functon for Nil_Element

   function Components (E : Asis.Element) return Asis.Element_List;
   --  Returns the list of all the first-level components of its argument.
   --  Nil_Element is returned for a terminal component.
   --  The implementation
   --  of this function is not very effective - we do not use any dynamic
   --  element lists, we simply compute the components twice - first time
   --  to get to know the overall number of components, and second
   --  time to fill in the result Element_List

end Asis.Extensions