------------------------------------------------------------------------------
--                                                                          --
--                        ASIS-for-GNAT COMPONENTS                          --
--                                                                          --
--                      A S I S . E X T E N S I O N S                       --
--                                                                          --
--                                 S p e c                                  --
--                                                                          --
--                            $Revision: 1.27 $
--                                                                          --
--            Copyright (c) 1995-2001, 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 needed 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 required), 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 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 renaming-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_Label (Defining_Name : in Asis.Defining_Name) return Boolean;
   --  Check if the argument is a statement label

   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 (Element : Asis.Element) return Boolean;
   --  Checks if Element represent a static expression or a static range
   --  constraint. "Static" is considered in the GNAT sense, that is if the
   --  compiler computes it during the compilation time. We believe,
   --  that GNAT notions of a static expression and a static range are close
   --  to the corresponding definitions 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.
   --
   --  Expected Constraint_Kinds:
   --     A_Range_Attribute_Reference

   function Has_Enumeration_Type
     (Expression : Asis.Expression)
      return       Boolean;
   --  Checks if Expression has some enumeration type (including types derived
   --  from enumeration types). Returns False for any unexpected Element
   --
   --  Expected Element_Kinds:
   --     An_Expression for which Is_True_Expression yields True.

   function Has_Integer_Type (Expression : Asis.Expression) return Boolean;
   --  Checks if Expression has some integer type (including types derived
   --  from integer types). Returns False for any unexpected Element
   --
   --  Expected Element_Kinds:
   --     An_Expression for which Is_True_Expression yields True.

   function Is_Uniquely_Defined
     (Reference : Asis.Expression)
      return      Boolean;
   --  Check if Reference has a unique definition. The Reference is expected
   --  to be of An_Identifier, A_Character_Literal, An_Enumeration_Literal or
   --  An_Operator_Symbol kind, that is, of the same kind as the argument of
   --  Asis.Expressions.Corresponding_Name_Definition). This test may be used
   --  to prevent calls of Asis.Expressions.Corresponding_Name_Definition and
   --  Asis.Expressions.Corresponding_Name_Declaration which raise
   --  ASIS_Inappropriate_Element (see the documentation of these queries).
   --  Returns False for any unexpected argument.
   --
   --  Expected Element_Kinds:
   --     An_Identifier
   --     An_Operator_Symbol

   -----------------------------------------------------
   -- 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 instantiates 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 components 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 Primitive_Owner
     (Declaration : Asis.Declaration)
      return        Asis.Type_Definition;
   --  In the case that Declaration the explicit declaration of a subprogram
   --  which Is_Dispatching_Operation for some tagged type, this function
   --  returns this tagged type definition. for which it is a primary
   --  operation. (Note, that a subprogram declaration may be a primitive
   --  operation for more then one type, but it may be a primitive
   --  operation for at most one tagged type. Note  also, that for implicitly
   --  declared dispatching operations the primary ASIS query
   --  Asis.Declarations.Corresponding_Type may be used to find the type which
   --  "owns" the operation). Returns Nil_Element in all other cases.
   --
   --  Appropriate Declaration_Kinds:
   --     A_Procedure_Declaration
   --     A_Function_Declaration
   --     A_Procedure_Renaming_Declaration
   --     A_Function_Renaming_Declaration
   --
   --  Returns Definition_Kinds:
   --     A_Tagged_Private_Type_Definition
   --     A_Private_Extension_Definition
   --
   --  Returns Type_Kinds:
   --     A_Derived_Record_Extension_Definition
   --     A_Tagged_Record_Type_Definition
   --
   --  Returns Element_Kinds
   --     Not_An_Element

   ----------------------
   -- 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 Main_Unit_In_Current_Tree
     (The_Context : Asis.Context)
      return        Asis.Compilation_Unit;
   --  If the tree currently accessed by ASIS is from the set of trees making
   --  up The_Context, then this function returns the corresponding main unit,
   --  that is, the Compilation_Unit corresponding to the source file which
   --  has been compiled to create this tree file. Otherwise (this also
   --  inludes the case when the currently accessed tree is null tree),
   --  returns the main unit for the first tree in the set of trees making up
   --  The_Context (the meaning of the notion "the first tree" is
   --  implementation-dependent), and if this set is empty, returns
   --  Nil_Compilation_Unit.
   --
   --  This function does not check if the argument Context is open.
   --
   --  This function is practically useful for "-C1" Contexts

   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

   function Original_Text_Name
     (Compilation_Unit : in Asis.Compilation_Unit)
      return Wide_String;
   --  In case if the source of the Compilation_Unit contains a
   --  Source_Reference pragma, returns the file name from this pragma,
   --  otherwise returns the same result as Asis.Compilation_Units.Text_Name
   --
   --  All Unit_Kinds are appropriate.

   ------------------------------------
   -- 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 occurrence 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 occurrence which actually introduces the corresponding entity.
   --  If there are only one defining occurrence of the argument Name, or if
   --  for some reason the first defining occurrence 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

   function Static_Expression_Value_Image
     (Expression : Asis.Expression)
      return       Wide_String;
   --  PARTIALLY IMPLEMENTED!!!
   --  Computes the value of Expression (which should be a static expression!)
   --  and represents it as a (wide) string. For enumeration expressions, the
   --  image of the Pos value of the defining enumeration or character literal
   --  corresponding to the  value of the expression is returned (see
   --  Asis.Declarations.Position_Number_Image query).
   --
   --  For ASIS Expression Elements for which Is_True_Expression yields False
   --  and empty string is returned
   --
   --  For non-static expressions, an empty string is returned.
   --
   --  Currently this function is implemented only for discrete types. For
   --  other types an empty string is returned.
   --
   --  Appropriate Element_Kinds:
   --     An_Expression

   function Static_Range_Low_Bound_Value_Image
     (Range_Element : Asis.Range_Constraint)
      return          Wide_String;
   --  PARTIALLY IMPLEMENTED!!!
   --  For A_Range_Attribute_Reference constraint defining by a static range,
   --  this function computes the value of the corresponding low bound and
   --  represents it as a (wide) string. For enumeration ranges, the
   --  image of the Pos value of the defining enumeration or character literal
   --  corresponding to the  value of the low bound is returned (see
   --  Asis.Extensions.Static_Expression_Value_Image and
   --  Asis.Declarations.Position_Number_Image queries).
   --
   --  For non-static expressions ranges, an empty string is returned.
   --
   --  Currently this function is implemented only for discrete types. For
   --  other types an empty string is returned.
   --
   --  Appropriate Constraint_Kinds:
   --     A_Range_Attribute_Reference

   function Static_Range_High_Bound_Value_Image
     (Range_Element : Asis.Range_Constraint)
      return          Wide_String;
   --  PARTIALLY IMPLEMENTED!!!
   --  For A_Range_Attribute_Reference constraint defining by a static range,
   --  this function computes the value of the corresponding high bound and
   --  represents it as a (wide) string. For enumeration ranges, the
   --  image of the Pos value of the defining enumeration or character literal
   --  corresponding to the  value of the high bound is returned (see
   --  Asis.Extensions.Static_Expression_Value_Image and
   --  Asis.Declarations.Position_Number_Image queries).
   --
   --  For non-static expressions ranges, an empty string is returned.
   --
   --  Currently this function is implemented only for discrete types. For
   --  other types an empty string is returned.
   --
   --  Appropriate Constraint_Kinds:
   --     A_Range_Attribute_Reference
   --
   --  Appropriate Discrete_Range_Kinds:
   --     A_Discrete_Range_Attribute_Reference

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

   function Original_Line_Number
     (Element       : Asis.Element;
      Compiled_Line : Line_Number_Positive)
      return Line_Number;
   --  If the enclosing compilation unit of the argument Element contains a
   --  Source_Reference pragma, this function converts the line number of
   --  the file which actually was compiled ("physical" file) into the
   --  corresponding line number in the original file. For the line containing
   --  a Source_Reference pragma zero is returned.
   --
   --  Raises ASIS_Inappropriate_Line_Number if Compiled_Line is greater then
   --  the maximum line number of the compiled file

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