------------------------------------------------------------------------------
-- --
-- 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-2019, 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 3, or (at your option) any later --
-- version. ASIS-for-GNAT is distributed in the hope that it will be --
-- useful, but WITHOUT ANY WARRANTY; without even the implied warranty of --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- --
-- --
-- --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception distributed with GNAT; see --
-- the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- . --
-- --
-- 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 AdaCore --
-- (http://www.adacore.com). --
-- --
------------------------------------------------------------------------------
pragma Ada_2012;
-- 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 often use some optimization based on direct traversal of the GNAT
-- tree.
-- 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.Containers.Hashed_Sets;
with Ada.Unchecked_Deallocation;
with Asis.Elements; use Asis.Elements;
with Asis.Text; use Asis.Text;
with GNAT.OS_Lib; use GNAT.OS_Lib;
package Asis.Extensions is
------------------------------------------------
-- Temporary solution for transition to GNSA --
------------------------------------------------
procedure Switch_To_GNSA
(Path : in out String_Access;
Target : String := "");
-- Assumes that Path contains the full path to a tool from the compiler
-- installation (it can actually be gcc or gprbuild, but we use a general
-- aproach just in case). Resents it to the same tool from GNSA used as
-- ASIS tree builder. If Target is not a null string, assumes that this is
-- a target-specific prefix of the tool name, and strips the corresponding
-- target from the result (in GNSA we cannot have any target-specific
-- names).
------------------------
-- Element containers --
------------------------
function Elements_Hash_Wrapper
(E : Asis.Element)
return Ada.Containers.Hash_Type;
-- Wrapper for Asis.Elements.Hash to be used in the instantiation of
-- Ada.Containers.Hashed_Sets
package Element_Containers is new Ada.Containers.Hashed_Sets
(Element_Type => Asis.Element,
Hash => Elements_Hash_Wrapper,
Equivalent_Elements => Asis.Elements.Is_Equal,
"=" => Asis.Elements.Is_Equal);
-----------------------
-- 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);
----------------------------------
-- Access to Program_Text Type --
----------------------------------
type Program_Text_Access is access Program_Text;
procedure Free is new Ada.Unchecked_Deallocation
(Program_Text, Program_Text_Access);
---------------------------
-- Tree creation routine --
---------------------------
procedure Compile
(Source_File : String_Access;
Args : Argument_List;
Success : out Boolean;
GCC : String_Access := null;
Use_GPRBUILD : Boolean := False;
Result_In_Current_Dir : Boolean := True;
Compiler_Out : String := "";
All_Warnings_Off : Boolean := True;
Display_Call : Boolean := False);
-- Calls GNAT to create the tree file. The command to create the tree is
-- defined by the GCC parameter, if the actual for it is null, the standard
-- 'gcc' command is used'.
--
-- If Use_GPRBUILD is ON (and GCC is not null) it treats the command to be
-- called as gprbuild, otherwise it treats it as gcc (native or cross) and
-- forms the list of option for the generated call accordingly. It forms
-- argument string for the called program that has the following structure:
--
-- - if Use_GPRBUILD is OFF:
--
-- -c -gnatct -gnatws -gnatyN -x ada &
--
-- (except in case of calling GNAAMP, for GNAAMP '-x ada' is not set);
--
-- - if Use_GPRBUILD is ON
--
-- -c -q -f -cargs -gnatct -gnatws -gnatyN -o obj_file
--
-- If All_Warnings_Off is OFF, '-gnatws -gnatyN' are not used.
--
-- Result_In_Current_Dir is taken into account only Use_GPRBUILD is ON. If
-- This flag is OFF, '-o obj_file' is not used. obj_file is Source_File
-- with the suffix replaced '.o' (or appended with '.o' if it does not
-- have a suffix) and prepended to the full path to the current directory.
--
-- So there is no need to set these options as a part of the value of Args
-- parameter (basically Args contains only needed -I, -gnatA, -gnatec
-- options, and project file in case of the GPRBUILD call) GCC parameter
-- should contain the full path to [cross]gcc (or gprbuild) to be used to
-- create the tree (use GNAT.OS_Lib.Locate_Exec_On_Path in the client code
-- to detect this path). If this parameter is not set, the standard
-- gcc/GNAT installation is used (even if Use_GPRBUILD is set ON). Success
-- is set ON if the required tree has been created without detecting any
-- compilation errors. Otherwise it is set OFF.
--
-- If Compiler_Out is a non-empty string, this string is treated as the
-- name of a text file to redirect the compiler output into (if the file
-- does not exist, it is created). Otherwise the compiler output is
-- sent to Stderr
--
-- If Display_Call is ON, outputs into Stderr the command used to call
-- GNAT.
------------------------------------------------------
-- 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 Is_Assertion (Element : Asis.Element) return Boolean;
-- Checks if the argument element is an assertion. The definition of
-- assertion is based on the definition of the GNAT-specific pragma
-- Assertion_Policy (see GNAT Reference Manual): any aspect definition or
-- any pragma that can be specified by a parameter if this pragma is
-- considered as assertion. Returns False for any unexpected argument.
--
-- Expected Elenebt_Kinds:
-- A_Pragma
--
-- Expected Definition_Kinds:
-- An_Aspect_Specification
function Is_RCI_Unit (C : Asis.Compilation_Unit) return Boolean;
-- Checks if the argument compilation is a remote call interface (RCI)
-- unit (See E.2.3). Returns False for any unexpected element.
--
-- Expected Unit_Kinds:
-- A_Package
-- A_Procedure_Body
-- A_Function_Body
-- A_Generic_Package
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 Declaration_Kinds:
-- A_Procedure_Body_Declaration
-- A_Function_Body_Declaration
-- An_Expression_Function_Declaration
-- A_Procedure_Body_Stub
-- A_Function_Body_Stub
function Is_Aspect_Mark (Element : Asis.Element) return Boolean;
-- Checks if Element is an aspect mark from aspect_specification.
-- Returns False for any unexpected Element
--
-- Expected Expression_Kinds
-- An_Identifier
--
-- Expected Attribute_Kinds
-- A_Class_Attribute
function Is_Aspect_Specific_Name (Element : Asis.Element) return Boolean;
-- Checks if Element is an identifier or a character literal specific for
-- some aspect definition. Returns False for any unexpected Element
--
-- Expected Expression_Kinds
-- A_Character_Literal
-- An_Identifier
function Is_Call_Through_Access_To_Subprogram
(Call : Asis.Element)
return Boolean;
-- Checks if the argument is a function or procedure call when a called
-- subprogram is defined by access-to-subprogram value.
-- Returns False for any unexpected Element
--
-- Expected Statement_Kinds:
-- A_Procedure_Call_Statement
--
-- Expected Expression_Kinds:
-- A_Function_Call
function Is_Class_Wide
(Declaration : Asis.Declaration)
return Boolean;
-- Checks if the argument subtype is a subtype of some class-wide type.
-- Returns False for any unexpected Element
--
-- Expected Declaration_Kinds:
-- A_Subtype_Declaration
function Is_Default_For_Null_Procedure
(Reference : Asis.Element)
return Boolean;
-- Checks if Reference is a reference for the default actual that is used
-- in expanded generic for a null procedure. Returns False for any
-- unexpected argument.
--
-- Expected Expression_Kinds:
-- An_Identifier
function Is_Definite_Subtype (Declaration : Asis.Element) return Boolean;
-- Checks if an argument is a declaration of a definite subtype (that is,
-- if for a given type/subtype declaration this function return true, then
-- it is possible to define an object of this (sub)type without imposing
-- any constraint. Returns False for any unexpected argument.
--
-- Expected Declaration_Kinds:
-- An_Ordinary_Type_Declaration
-- A_Task_Type_Declaration
-- A_Protected_Type_Declaration
-- A_Private_Type_Declaration
-- A_Private_Extension_Declaration
-- A_Subtype_Declaration
-- A_Formal_Type_Declaration
function Is_From_SPARK_Aspect (E : Asis.Element) return Boolean;
-- Checks if the argument is from the aspect specification that is specific
-- for SPARK 2014. The code in such aspect specifications is an Ada
-- extension, it does not follow the language visibility rules, so it may
-- contain names that have no definition.
function Is_Renaming_As_Body (Declaration : Asis.Element) return Boolean;
-- Checks if its argument is a renaming-as-body declaration.
--
--
-- 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_Bool_Eq_Declaration
(Declaration : Asis.Element)
return Boolean;
-- Checks if Declaration is a declaration of the equality operation
-- returning the predefined boolean type that implicitly declares "/="
-- (See RM 95). Returns False for any unexpected element
--
-- Expected Declaration_Kinds
-- A_Function_Declaration
-- A_Function_Body_Declaration
-- A_Function_Renaming_Declaration
function Is_Implicit_Neq_Declaration
(Declaration : Asis.Element)
return Boolean;
-- Checks if Declaration is an implicit declaration of "/=" operator that
-- is declared as a consequence of some Is_Bool_Eq_Declaration declaration
-- (See RM 95). Returns False for any unexpected element
--
-- Expected Declaration_Kinds
-- A_Function_Declaration
function Is_Tagged_Type_Eq
(Declaration : Asis.Element)
return Boolean;
-- Checks if Declaration is a Is_Bool_Eq_Declaration that corresponds to
-- a tagged type and is a dispatching operation for it or the declaration
-- of the corresponding complementary implicit "/=" operation (for a
-- tagged type). Returns False for any unexpected element.
--
-- Expected Declaration_Kinds
-- A_Function_Declaration
function Is_Overriding_Operation
(Declaration : Asis.Element)
return Boolean;
-- Checks if the argument is a subprogram declaration or subprogram
-- instantiation that overrides a user-defined type primitive operation.
-- Always returns False for Is_Part_Of_Inherited arguments. Returns False
-- for any unexpected element. Note that this function checks operation
-- overriding, but not only operation hiding
--
-- Expected Declaration_Kinds
-- A_Procedure_Declaration
-- A_Function_Declaration
-- A_Procedure_Instantiation
-- A_Function_Instantiation
-- A_Procedure_Body_Declaration
-- A_Function_Body_Declaration
-- A_Null_Procedure_Declaration
-- A_Procedure_Renaming_Declaration
-- A_Function_Renaming_Declaration
function Is_Predefined_Operator
(Operator : Asis.Element)
return Boolean;
-- Checks if the argument is a reference to a predefined operator.
-- Returns False for any unexpected Element
--
-- Expected Expression_Kinds:
-- An_Operator_Symbol
function Is_Shift_Operation
(Operator : Asis.Element)
return Boolean;
-- Checks if the argument is a reference to one of the five shift
-- operations that are the result of pragma Provide_Shift_Operators
-- (Shift_Left, Shift_Right, Shift_Right_Arithmetic, Rotate_Left and
-- Rotate_Right)
--
-- Expected Expression_Kinds:
-- An_Identifier
function Is_Label (Defining_Name : 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 An_Expression Element for which
-- Is_True_Expression is False, the Corresponding_Expression_Type query
-- should yield Nil_Element. Note that this function returns False for an
-- expression having anonymous access type.
--
-- Expected Element_Kinds:
-- An_Expression
function Has_Anonymous_Type
(Expression : Asis.Expression)
return Boolean;
-- Assuming that Is_True_Expression (Expression) checks if Expression has
-- an anonymous type (that is, the type of the expression is not defined
-- by some type declaration in the program code. If for some expression
-- Has_Anonymous_Type returns True, the Corresponding_Expression_Type query
-- should yield Nil_Element for it.
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_Check_Name
(Reference : Asis.Expression)
return Boolean;
-- Check if Reference denotes a check (either predefined of introduced by
-- a GNAT Check_Name pragma. The Reference is expected to be of
-- An_Identifier kind. Returns False for any unexpected argument.
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
-- A_Character_Literal
-- An_Enumeration_Literal
function Is_Private (Declaration : Asis.Element) return Boolean;
-- Checks if Declaration is located in the private part of a package,
-- a generic package, a task or protected type or object declaration.
-- If Declaration is located in the visible part of such a construct, but
-- this enclosing construct is itself located in some private part
-- (immediately or being nested in some other constructs), this function
-- also returns True. Returns False for any unexpected argument.
--
-- Because of the performance reasons the implementation of this
-- function is based on the direct traversal of the GNAT tree, so it is not
-- an ASIS secondary query.
--
-- Expected Element_Kinds:
-- A_Declaration
--
-- Expected Declaration_Kinds
-- All except A_Loop_Parameter_Specification
-- A_Generalized_Iterator_Specification
-- An_Element_Iterator_Specification
function Is_Exported (Defining_Name : Asis.Defining_Name) return Boolean;
-- Checks if pragma Export is applied to the argument entity. In case if
-- this entity is from a subprogram body declaration, this check is made
-- for the entity from the corresponding subprogram spec (if any)
--
-- Because of the performance reasons the implementation of this
-- function is based on the direct traversal of the GNAT tree, so it is not
-- an ASIS secondary query.
--
-- Expected Element_Kinds:
-- A_Defining_Name
function Body_In_Library_Level_Instantiation
(Declaration : Asis.Element;
Instantiation_Source : out String_Access)
return Boolean;
-- This function is used in the implementation of
-- Asis.Declarations.Corresponding_Body for compile-on-the-fly Context
-- mode.
--
-- Assuming that Declaration is either a subprogram declaration or a
-- subprogram instantiation it checks if the result of Corresponding_Body
-- should be a part of expanded instantiation that corresponds to the
-- library-level instantiation. If it is, Instantiation_Source is set to
-- the full path to the source that contains this library-level
-- instantiation (appended by ASCII.NUL), otherwise it is set to null.
--
-- Expected Declaration_Kinds
-- A_Function_Declaration
-- A_Function_Instantiation
-- A_Generic_Package_Declaration
-- A_Generic_Procedure_Declaration
-- A_Generic_Function_Declaration
-- A_Package_Declaration
-- A_Package_Instantiation
-- A_Procedure_Declaration
-- A_Procedure_Instantiation
-- A_Single_Task_Declaration
-- A_Task_Type_Declaration
-- A_Protected_Type_Declaration
-- A_Single_Protected_Declaration
---------------------
-- Run-Time checks --
---------------------
type Run_Time_Checks is
(Do_Accessibility_Check,
Do_Discriminant_Check,
Do_Division_Check,
Do_Length_Check,
Do_Overflow_Check,
Do_Range_Check,
Do_Storage_Check,
Do_Tag_Check);
type Run_Time_Check_Set is array (Run_Time_Checks) of Boolean;
Empty_Check_Set : constant Run_Time_Check_Set := (others => False);
function Needed_Checks
(Element : Asis.Element)
return Run_Time_Check_Set;
-- Any Element is accepted. The returned array represents a set of run-time
-- checks that are needed for the argument Element. If the check is needed,
-- the corresponding component of the result is set ON, and OFF otherwise.
-----------------------------------------------------
-- Modified versions of the "primary" ASIS queries --
-----------------------------------------------------
function Get_Call_Parameters
(Call : Asis.Element;
Normalized : Boolean := False)
return Asis.Element_List;
-- Returns the parameter list from the call. Combines the functionality of
-- Asis.Statements.Call_Statement_Parameters and
-- Asis.Expressions.Function_Call_Parameters
--
-- Appropriate Expression_Kinds:
-- A_Function_Call
--
-- Appropriate Statement_Kinds:
-- An_Entry_Call_Statement
-- A_Procedure_Call_Statement
--
-- Returns Element_Kinds:
-- A_Parameter_Association
-- The rest of 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.Declarations --
-----------------------
function Corresponding_Representation_Items
(Defining_Name : Asis.Defining_Name)
return Asis.Element_List;
-- This function tries to rectify shortcomings of the standard ASIS queries
-- that provides representation information (such as
-- Asis.Declarations.Corresponding_Representation_Clauses and
-- Asis.Elements.Corresponding_Pragmas). First, it operates on a defining
-- name, not on a declaration, so the result is a list of representation
-- items applied to a specific entity. Second, the result contains all
-- kinds of representation items - representation specifications, aspect
-- definitions and pragmas.
--
-- The query provides the compiler view on the set of representation items
-- provided for the argument entity - it traverses the chain of
-- representation items in the tree.
--
-- Only explicit representation items are included in the returned result.
--
-- Appropriate Element kinds:
-- A_Defining_Name
--
-- Result Element Kinds:
-- A_Pragma
--
-- Result Clause_Kinds:
-- A_Representation_Clause
-- A_Component_Clause
--
-- Result Definition_Kinds:
-- An_Aspect_Specification
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 the type definition for which it is a primitive operation. (Note
-- that a subprogram declaration may be a primitive operation for more than
-- 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.
--
-- In case of a (non-tagged!) private type that has a tagged full view, a
-- type operation declared in visible part is classified as
-- Is_Dispatching_Operation, and this function will return private
-- non-tagged type definition.
--
-- Appropriate Declaration_Kinds (should be the same as expected kinds
-- for Asis.Declarations.Is_Dispatching_Operation):
-- A_Procedure_Declaration
-- A_Function_Declaration
-- An_Expression_Function_Declaration
-- A_Procedure_Renaming_Declaration
-- A_Function_Renaming_Declaration
-- A_Null_Procedure_Declaration
-- A_Procedure_Body_Declaration
-- A_Function_Body_Declaration
-- A_Procedure_Body_Stub
-- A_Function_Body_Stub
--
-- Returns Definition_Kinds:
-- A_Private_Type_Definition
-- A_Tagged_Private_Type_Definition
-- A_Private_Extension_Definition
-- A_Task_Definition
-- A_Protected_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_Unwound
(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
function Corresponding_Called_Function_Unwinded
(Expression : Asis.Expression)
return Asis.Declaration renames
Corresponding_Called_Function_Unwound;
-- For upward compatibility we have to keep the old ungrammatical names of
-- this function
---------------------
-- Asis.Statements --
---------------------
function Corresponding_Called_Entity_Unwound
(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
function Corresponding_Called_Entity_Unwinded
(Statement : Asis.Statement)
return Asis.Declaration renames
Corresponding_Called_Entity_Unwound;
-- For upward compatibility we have to keep the old ungrammatical names of
-- this function
-------------------
-- Asis.Elements --
-------------------
function Pragmas_After
(Compilation_Unit : Asis.Compilation_Unit;
Include_Pragmas : Boolean := True)
return Asis.Pragma_Element_List;
-- Returns the list of pragmas the appear immediately following the
-- Compilation_Unit, for example:
-- with G;
-- procedure P is new G;
-- pragma Pure (P);
--------------------------------------
-- Extensions of ASIS functionality --
--------------------------------------
----------------------------
-- Asis.Compilation_Units --
----------------------------
function CU_Requires_Body (Right : Asis.Compilation_Unit) return Boolean;
-- Similar to Asis.Compilation_Units.Is_Body_Required, but also checks
-- library subprogram declarations and library generic subprogram
-- declarations. For (generic) library subprogram declarations,
-- returns True unless the subprogram is completed by pragma Import.
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
-- includes 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 file 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 : 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.
function Is_Sub_Package_Implemented_As_Child_Unit
(Compilation_Unit : Asis.Compilation_Unit)
return Boolean;
-- Internally, the GNAT implementation treats subpackages of Ada.Text_IO,
-- such as Integer_IO, as implicit child units rather local packages
-- defined in the specification of Ada.Text_IO. They would have undoubtedly
-- been designed this way if child units had been available in the original
-- design of Ada. This has the advantage that code for these units is only
-- processed and loaded if used. At the compiler level, the difference is
-- made entirely invisible to the Ada program, so this transformation is
-- completely conforming to the RM. The situation with Ada.Wide_Text_IO and
-- Ada.Wide_Wide_Text_IO is the same, see the documentation of these
-- packages for full details.
--
-- But at the ASIS level, it is not practical to hide this transformation,
-- so an ASIS application can see that this is happening, and the
-- application itself must handle this as necessary. This query can be used
-- to identify ASIS Compilation Units that represents specs and bodies
-- of private children of predefined Ada text input-output packages that
-- implements the optimization described above.
--
-- Note that reverting this GNAT transformation (if needed) is not obvious.
-- You may have an ASIS Context that contains a spec and a body of a
-- private child of a Standard text IO package, but only a spec of this
-- Standard text IO package. So, if an application wants to mimic the code
-- of the Standard text input-output package, it is possible to get from
-- the private child spec into the spec of the input-output package, but
-- not from the private child body into the body of the package because
-- there is no such a body in the Context. So this is completely up to
-- an ASIS application how to deal with such private children.
-------------------------------------
-- Extensions to Asis.Declarations --
-------------------------------------
function First_Name (Dcl : Asis.Element) return Asis.Element;
-- Returns the first defining name from an argument declaration. Is
-- equivalent to
--
-- Names (Dcl) (Names (Dcl)'First)
--
-- Appropriate Element_Kinds:
-- A_Declaration
--
-- Returns Element_Kinds
-- A_Defining_Name
function Corresponding_Overridden_Operation
(Declaration : Asis.Declaration)
return Asis.Declaration;
-- In case if Is_Overriding_Operation (Declaration) is True, returns the
-- declaration of the subprogram that is overridden by Declaration (it may
-- be explicit or implicit declaration). Otherwise returns Nil_Element.
-- Note, that this query knows nothing about multiple inheritance!
--
-- Appropriate Declaration_Kinds:
-- A_Procedure_Declaration
-- A_Function_Declaration
-- A_Procedure_Instantiation
-- A_Function_Instantiation
-- A_Procedure_Body_Declaration
-- A_Function_Body_Declaration
-- A_Null_Procedure_Declaration
-- A_Procedure_Renaming_Declaration
-- A_Function_Renaming_Declaration
--
-- Returns Declaration_Kinds:
-- A_Procedure_Declaration
-- A_Function_Declaration
-- A_Procedure_Instantiation
-- A_Function_Instantiation
-- A_Procedure_Body_Declaration
-- A_Function_Body_Declaration
-- A_Null_Procedure_Declaration
-- A_Procedure_Renaming_Declaration
-- A_Function_Renaming_Declaration
function Corresponding_Overridden_Operations
(Declaration : Asis.Declaration)
return Asis.Element_List;
-- The difference with the previous Corresponding_Overridden_Operation
-- in case of multiple inheritance this query returns all the operations
-- of the parent type and all the interface types from which the owner
-- of the argument primitive is derived. Returns Nil_Element_List if
-- not Is_Overriding_Operation (Declaration).
--
-- Not implemented yet!!!
--
-- Appropriate Declaration_Kinds:
-- A_Procedure_Declaration
-- A_Function_Declaration
-- A_Procedure_Instantiation
-- A_Function_Instantiation
-- A_Procedure_Body_Declaration
-- A_Function_Body_Declaration
-- A_Procedure_Renaming_Declaration
-- A_Function_Renaming_Declaration
--
-- Returns Declaration_Kinds:
-- A_Procedure_Declaration
-- A_Function_Declaration
-- A_Procedure_Instantiation
-- A_Function_Instantiation
-- A_Procedure_Body_Declaration
-- A_Function_Body_Declaration
-- A_Procedure_Renaming_Declaration
-- A_Function_Renaming_Declaration
function Has_Controlling_Result
(Declaration : Asis.Declaration)
return Boolean;
-- In case if argument function declaration tests True with
-- Is_Dispatching_Operation, checks if the argument function has a
-- dispatching result. Returns true for any unexpected argument and for any
-- declaration that tests False with Is_Dispatching_Operation. Also returns
-- False if an argument declaration is a completion of another declaration.
--
-- Expected Element_Kinds:
-- A_Function_Declaration
-- An_Expression_Function_Declaration
-- A_Function_Renaming_Declaration
-- A_Function_Body_Declaration
-- A_Function_Body_Stub
function Controlling_Parameters
(Declaration : Asis.Declaration)
return Asis.Element_List;
-- In case if argument subprogram declaration tests True with
-- Is_Dispatching_Operation, returns the list of controlling parameter
-- specifications (this list can be empty in case of a function having
-- controlling result). Returns Nil_Element_List if the argument
-- declaration tests False with Is_Dispatching_Operation. Also returns
-- Nil_Element_List if an argument declaration is a completion of another
-- declaration.
--
-- Appropriate Declaration_Kinds:
-- A_Procedure_Declaration
-- A_Function_Declaration
-- An_Expression_Function_Declaration
-- A_Procedure_Renaming_Declaration
-- A_Function_Renaming_Declaration
-- A_Null_Procedure_Declaration
-- A_Procedure_Body_Declaration
-- A_Function_Body_Declaration
-- A_Procedure_Body_Stub
-- A_Function_Body_Stub
--
--
-- Returns Declaration_Kinds:
-- A_Parameter_Specification
------------------------------------
-- Extensions to Asis.Definitions --
------------------------------------
function Inherited_Type_Operators
(Type_Definition : Asis.Type_Definition)
return Asis.Declaration_List;
-- Returns a list of user-defined operator functions inherited by this
-- type. (Each operator function in the result list has parameter (s) or
-- (and) result of the argument type.
-- This function is used in the implementation of
-- Asis.Definitions.Corresponding_Type_Operators, that's why the list of
-- appropriate kinds include type definitions that can not have any
-- inherited declarations associated with them. For these arguments
-- Nil_Element_List is returned. For non-null result each component of the
-- result list Is_Part_Of_Implicit and Is_part_Of_Inherited
--
-- Appropriate Definition_Kinds:
-- A_Type_Definition
-- A_Formal_Type_Declaration
-- A_Private_Type_Definition
-- A_Tagged_Private_Type_Definition
-- A_Private_Extension_Definition
-- A_Task_Definition
-- A_Protected_Definition
--
-- Returns Declaration_Kinds:
-- A_Function_Declaration
function Explicit_Type_Operators
(Type_Definition : Asis.Type_Definition)
return Asis.Declaration_List;
-- If the argument is of A_Formal_Type_Definition kind, returns a list of
-- formal operator function from the same formal part that have a parameter
-- or return the result of this formal type. Otherwise returns a list of
-- explicitly declared operator functions that are primitive operations
-- of the argument type
--
-- Appropriate Definition_Kinds:
-- A_Type_Definition
-- A_Formal_Type_Declaration
-- A_Private_Type_Definition
-- A_Tagged_Private_Type_Definition
-- A_Private_Extension_Definition
-- A_Task_Definition
-- A_Protected_Definition
--
-- Returns Declaration_Kinds:
-- A_Function_Declaration
-- A_Function_Body_Declaration
-- A_Function_Body_Stub
-- A_Function_Renaming_Declaration
-- A_Function_Instantiation
-- A_Formal_Function_Declaration
function Corresponding_Parent_Subtype_Unwind_Base
(Type_Definition : Asis.Type_Definition)
return Asis.Declaration;
-- This query differs from Asis.Definitions,Corresponding_Parent_Subtype
-- in the following. If the argument type definition contains the ('Base)
-- attribute reference as the parent subtype mark, it gets to the prefix
-- of this attribute and applies
-- Asis.Declarations.Corresponding_First_Subtype to it.
------------------------------------
-- Extensions to Asis.Expressions --
------------------------------------
function Full_Name_Image
(Expression : Asis.Expression)
return Program_Text;
-- Similar to Asis.Expressions.Name_Image, but also works on full expanded
-- names
function Denotation
(Reference : Asis.Expression)
return Asis.Defining_Name;
-- Returns the defining name denoted by Reference. Same as
-- Corresponding_Name_Definition, except it works for A_Selected_Component.
function Normalize_Reference (Ref : Asis.Element) return Asis.Element;
-- This function is supposed to be called for the ASIS Elements
-- representing a subtype mark. A subtype mark can be represented by
-- an Element of one of the tree following kinds:
--
-- An_Identifier
-- A_Selected_Component
-- An_Attribute_Reference
--
-- This function "prepares" its argument for applying the ASIS
-- Corresponding_Name_Definition and Corresponding_Name_Declaration
-- queries, that is, returns its argument if it is of An_Identifier kind,
-- returns the selector of the argument if it is of A_Selected_Component
-- kind, and applies itself to the attribute prefix in case of
-- An_Attribute_Reference
function Corresponding_First_Definition
(Defining_Name : Asis.Defining_Name)
return Asis.Defining_Name;
-- In case there is more than 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 and string
-- 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.
--
-- Returns 0 if not Is_Text_Available(Element).
--
-- Raises ASIS_Inappropriate_Line_Number if Is_Text_Available(Element) and
-- Compiled_Line is greater than 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
function Pos_In_List
(E : Asis.Element;
In_List : Asis.Element_List)
return ASIS_Natural;
-- Returns the index of of E in In_List. If In_List contins more than one
-- element that Is_Equal to E, returns the index of the leftmost one.
-- Returns 0 is E is not an element of In_List.
generic
type From is (<>);
type To is (<>);
Default : To;
package Generic_Enum_Conversion is
-- Elaboration of an instance body creates a table, which is efficient
-- only if this is instantiated at library level.
function Convert (X : From) return To;
-- Converts X to a same-named value of type To. If there is no such
-- value, returns Default. This is essentially doing
-- "To'Value (From'Image (X))", except more efficiently.
-- For example if "type From is (Red, Orange, Yellow);"
-- and "type To is (Green, Amber, Red);" then
-- Convert (Red) returns Red, and Convert (Orange) returns Default.
end Generic_Enum_Conversion;
end Asis.Extensions;