blob: 3adaee416b26fb0d30309a80a91fa84991bb4c9c [file] [log] [blame]
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S E M _ A U X --
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2021, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING3. If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- Package containing utility procedures used throughout the compiler.
-- Historical note. Many of the routines here were originally in Einfo, but
-- Einfo is supposed to be a relatively low level package dealing with the
-- content of entities in the tree, so this package is used for routines that
-- require more than minimal semantic knowledge.
with Alloc;
with Namet; use Namet;
with Table;
with Types; use Types;
package Sem_Aux is
--------------------------------
-- Obsolescent Warnings Table --
--------------------------------
-- This table records entities for which a pragma Obsolescent with a
-- message argument has been processed.
type OWT_Record is record
Ent : Entity_Id;
-- The entity to which the pragma applies
Msg : String_Id;
-- The string containing the message
end record;
package Obsolescent_Warnings is new Table.Table (
Table_Component_Type => OWT_Record,
Table_Index_Type => Int,
Table_Low_Bound => 0,
Table_Initial => Alloc.Obsolescent_Warnings_Initial,
Table_Increment => Alloc.Obsolescent_Warnings_Increment,
Table_Name => "Obsolescent_Warnings");
procedure Initialize;
-- Called at the start of compilation of each new main source file to
-- initialize the allocation of the Obsolescent_Warnings table.
-----------------
-- Subprograms --
-----------------
function Ancestor_Subtype (Typ : Entity_Id) return Entity_Id;
-- The argument Typ is a type or subtype entity. If the argument is a
-- subtype then it returns the subtype or type from which the subtype was
-- obtained, otherwise it returns Empty.
-- WARNING: There is a matching C declaration of this subprogram in fe.h
function Available_View (Ent : Entity_Id) return Entity_Id;
-- Ent denotes an abstract state or a type that may come from a limited
-- with clause. Return the non-limited view of Ent if there is one or Ent
-- if this is not the case.
function Constant_Value (Ent : Entity_Id) return Node_Id;
-- Ent is a variable, constant, named integer, or named real entity. This
-- call obtains the initialization expression for the entity. Will return
-- Empty for a deferred constant whose full view is not available or
-- in some other cases of internal entities, which cannot be treated as
-- constants from the point of view of constant folding. Empty is also
-- returned for variables with no initialization expression.
-- WARNING: There is a matching C declaration of this subprogram in fe.h
function Corresponding_Unsigned_Type (Typ : Entity_Id) return Entity_Id;
-- Typ is a signed integer subtype. This routine returns the standard
-- unsigned type with the same Esize as the implementation base type of
-- Typ, e.g. Long_Integer => Long_Unsigned.
function Enclosing_Dynamic_Scope (Ent : Entity_Id) return Entity_Id;
-- For any entity, Ent, returns the closest dynamic scope in which the
-- entity is declared or Standard_Standard for library-level entities.
function First_Discriminant (Typ : Entity_Id) return Entity_Id;
-- Typ is a type with discriminants. The discriminants are the first
-- entities declared in the type, so normally this is equivalent to
-- First_Entity. The exception arises for tagged types, where the tag
-- itself is prepended to the front of the entity chain, so the
-- First_Discriminant function steps past the tag if it is present.
-- The caller is responsible for checking that the type has discriminants.
-- When called on a private type with unknown discriminants, the function
-- always returns Empty.
-- WARNING: There is a matching C declaration of this subprogram in fe.h
function First_Stored_Discriminant (Typ : Entity_Id) return Entity_Id;
-- Typ is a type with discriminants. Gives the first discriminant stored
-- in an object of this type. In many cases, these are the same as the
-- normal visible discriminants for the type, but in the case of renamed
-- discriminants, this is not always the case.
--
-- For tagged types, and untagged types which are root types or derived
-- types but which do not rename discriminants in their root type, the
-- stored discriminants are the same as the actual discriminants of the
-- type, and hence this function is the same as First_Discriminant.
--
-- For derived untagged types that rename discriminants in the root type
-- this is the first of the discriminants that occur in the root type. To
-- be precise, in this case stored discriminants are entities attached to
-- the entity chain of the derived type which are a copy of the
-- discriminants of the root type. Furthermore their Is_Completely_Hidden
-- flag is set since although they are actually stored in the object, they
-- are not in the set of discriminants that is visible in the type.
--
-- For derived untagged types, the set of stored discriminants are the real
-- discriminants from Gigi's standpoint, i.e. those that will be stored in
-- actual objects of the type.
-- WARNING: There is a matching C declaration of this subprogram in fe.h
function First_Subtype (Typ : Entity_Id) return Entity_Id;
-- Applies to all types and subtypes. For types, yields the first subtype
-- of the type. For subtypes, yields the first subtype of the base type of
-- the subtype.
-- WARNING: There is a matching C declaration of this subprogram in fe.h
function First_Tag_Component (Typ : Entity_Id) return Entity_Id;
-- Typ must be a tagged record type. This function returns the Entity for
-- the first _Tag field in the record type.
function Get_Called_Entity (Call : Node_Id) return Entity_Id;
-- Obtain the entity of the entry, operator, or subprogram being invoked
-- by call Call.
function Get_Rep_Item
(E : Entity_Id;
Nam : Name_Id;
Check_Parents : Boolean := True) return Node_Id;
-- Searches the Rep_Item chain for a given entity E, for an instance of a
-- rep item (pragma, attribute definition clause, or aspect specification)
-- whose name matches the given name Nam. If Check_Parents is False then it
-- only returns rep item that has been directly specified for E (and not
-- inherited from its parents, if any). If one is found, it is returned,
-- otherwise Empty is returned. A special case is that when Nam is
-- Name_Priority, the call will also find Interrupt_Priority.
function Get_Rep_Item
(E : Entity_Id;
Nam1 : Name_Id;
Nam2 : Name_Id;
Check_Parents : Boolean := True) return Node_Id;
-- Searches the Rep_Item chain for a given entity E, for an instance of a
-- rep item (pragma, attribute definition clause, or aspect specification)
-- whose name matches one of the given names Nam1 or Nam2. If Check_Parents
-- is False then it only returns rep item that has been directly specified
-- for E (and not inherited from its parents, if any). If one is found, it
-- is returned, otherwise Empty is returned. A special case is that when
-- one of the given names is Name_Priority, the call will also find
-- Interrupt_Priority.
function Get_Rep_Pragma
(E : Entity_Id;
Nam : Name_Id;
Check_Parents : Boolean := True) return Node_Id;
-- Searches the Rep_Item chain for a given entity E, for an instance of a
-- representation pragma whose name matches the given name Nam. If
-- Check_Parents is False then it only returns representation pragma that
-- has been directly specified for E (and not inherited from its parents,
-- if any). If one is found and if it is the first rep item in the list
-- that matches Nam, it is returned, otherwise Empty is returned. A special
-- case is that when Nam is Name_Priority, the call will also find
-- Interrupt_Priority.
function Get_Rep_Pragma
(E : Entity_Id;
Nam1 : Name_Id;
Nam2 : Name_Id;
Check_Parents : Boolean := True) return Node_Id;
-- Searches the Rep_Item chain for a given entity E, for an instance of a
-- representation pragma whose name matches one of the given names Nam1 or
-- Nam2. If Check_Parents is False then it only returns representation
-- pragma that has been directly specified for E (and not inherited from
-- its parents, if any). If one is found and if it is the first rep item in
-- the list that matches one of the given names, it is returned, otherwise
-- Empty is returned. A special case is that when one of the given names is
-- Name_Priority, the call will also find Interrupt_Priority.
function Has_Rep_Item
(E : Entity_Id;
Nam : Name_Id;
Check_Parents : Boolean := True) return Boolean;
-- Searches the Rep_Item chain for the given entity E, for an instance of a
-- rep item (pragma, attribute definition clause, or aspect specification)
-- with the given name Nam. If Check_Parents is False then it only checks
-- for a rep item that has been directly specified for E (and not inherited
-- from its parents, if any). If found then True is returned, otherwise
-- False indicates that no matching entry was found.
function Has_Rep_Item
(E : Entity_Id;
Nam1 : Name_Id;
Nam2 : Name_Id;
Check_Parents : Boolean := True) return Boolean;
-- Searches the Rep_Item chain for the given entity E, for an instance of a
-- rep item (pragma, attribute definition clause, or aspect specification)
-- with the given names Nam1 or Nam2. If Check_Parents is False then it
-- only checks for a rep item that has been directly specified for E (and
-- not inherited from its parents, if any). If found then True is returned,
-- otherwise False indicates that no matching entry was found.
function Has_Rep_Pragma
(E : Entity_Id;
Nam : Name_Id;
Check_Parents : Boolean := True) return Boolean;
-- Searches the Rep_Item chain for the given entity E, for an instance of a
-- representation pragma with the given name Nam. If Check_Parents is False
-- then it only checks for a representation pragma that has been directly
-- specified for E (and not inherited from its parents, if any). If found
-- and if it is the first rep item in the list that matches Nam then True
-- is returned, otherwise False indicates that no matching entry was found.
function Has_Rep_Pragma
(E : Entity_Id;
Nam1 : Name_Id;
Nam2 : Name_Id;
Check_Parents : Boolean := True) return Boolean;
-- Searches the Rep_Item chain for the given entity E, for an instance of a
-- representation pragma with the given names Nam1 or Nam2. If
-- Check_Parents is False then it only checks for a rep item that has been
-- directly specified for E (and not inherited from its parents, if any).
-- If found and if it is the first rep item in the list that matches one of
-- the given names then True is returned, otherwise False indicates that no
-- matching entry was found.
function Has_External_Tag_Rep_Clause (T : Entity_Id) return Boolean;
-- Defined in tagged types. Set if an External_Tag rep. clause has been
-- given for this type. Use to avoid the generation of the default
-- External_Tag.
--
-- Note: we used to use an entity flag for this purpose, but that was wrong
-- because it was not propagated from the private view to the full view. We
-- could have added that propagation, but it would have been an annoying
-- irregularity compared to other representation aspects, and the cost of
-- looking up the aspect when needed is small.
function Has_Unconstrained_Elements (T : Entity_Id) return Boolean;
-- True if T has discriminants and is unconstrained, or is an array type
-- whose element type Has_Unconstrained_Elements.
function Has_Variant_Part (Typ : Entity_Id) return Boolean;
-- Return True if the first subtype of Typ is a discriminated record type
-- which has a variant part. False otherwise.
function In_Generic_Body (Id : Entity_Id) return Boolean;
-- Determine whether entity Id appears inside a generic body
function Initialization_Suppressed (Typ : Entity_Id) return Boolean;
pragma Inline (Initialization_Suppressed);
-- Returns True if initialization should be suppressed for the given type
-- or subtype. This is true if Suppress_Initialization is set either for
-- the subtype itself, or for the corresponding base type.
function Is_Body (N : Node_Id) return Boolean;
-- Determine whether an arbitrary node denotes a body
function Is_By_Copy_Type (Ent : Entity_Id) return Boolean;
-- Ent is any entity. Returns True if Ent is a type entity where the type
-- is required to be passed by copy, as defined in (RM 6.2(3)).
function Is_By_Reference_Type (Ent : Entity_Id) return Boolean;
-- Ent is any entity. Returns True if Ent is a type entity where the type
-- is required to be passed by reference, as defined in (RM 6.2(4-9)).
-- WARNING: There is a matching C declaration of this subprogram in fe.h
function Is_Definite_Subtype (T : Entity_Id) return Boolean;
-- T is a type entity. Returns True if T is a definite subtype.
-- Indefinite subtypes are unconstrained arrays, unconstrained
-- discriminated types without defaulted discriminants, class-wide types,
-- and types with unknown discriminants. Definite subtypes are all others
-- (elementary, constrained composites (including the case of records
-- without discriminants), and types with defaulted discriminants).
function Is_Derived_Type (Ent : Entity_Id) return Boolean;
-- Determines if the given entity Ent is a derived type. Result is always
-- false if argument is not a type.
-- WARNING: There is a matching C declaration of this subprogram in fe.h
function Is_Generic_Formal (E : Entity_Id) return Boolean;
-- Determine whether E is a generic formal parameter. In particular this is
-- used to set the visibility of generic formals of a generic package
-- declared with a box or with partial parameterization.
function Is_Immutably_Limited_Type (Ent : Entity_Id) return Boolean;
-- Implements definition in Ada 2012 RM-7.5 (8.1/3). This differs from the
-- following predicate in that an untagged record with immutably limited
-- components is NOT by itself immutably limited. This matters, e.g. when
-- checking the legality of an access to the current instance.
function Is_Limited_View (Ent : Entity_Id) return Boolean;
-- Ent is any entity. True for a type that is "inherently" limited (i.e.
-- cannot become nonlimited). From the Ada 2005 RM-7.5(8.1/2), "a type with
-- a part that is of a task, protected, or explicitly limited record type".
-- These are the types that are defined as return-by-reference types in Ada
-- 95 (see RM95-6.5(11-16)). In Ada 2005, these are the types that require
-- build-in-place for function calls. Note that build-in-place is allowed
-- for other types, too. This is also used for identifying pure procedures
-- whose calls should not be eliminated (RM 10.2.1(18/2)).
function Is_Limited_Type (Ent : Entity_Id) return Boolean;
-- Ent is any entity. Returns true if Ent is a limited type (limited
-- private type, limited interface type, task type, protected type,
-- composite containing a limited component, or a subtype of any of
-- these types). This older routine overlaps with the previous one, this
-- should be cleaned up???
function Is_Record_Or_Limited_Type (Typ : Entity_Id) return Boolean;
-- Return True if Typ requires is a record or limited type.
function Nearest_Ancestor (Typ : Entity_Id) return Entity_Id;
-- Given a subtype Typ, this function finds out the nearest ancestor from
-- which constraints and predicates are inherited. There is no simple link
-- for doing this, consider:
--
-- subtype R is Integer range 1 .. 10;
-- type T is new R;
--
-- In this case the nearest ancestor is R, but the Etype of T'Base will
-- point to R'Base, so we have to go rummaging in the declarations to get
-- this information. It is used for making sure we freeze this before we
-- freeze Typ, and also for retrieving inherited predicate information.
-- For the case of base types or first subtypes, there is no useful entity
-- to return, so Empty is returned.
--
-- Note: this is similar to Ancestor_Subtype except that it also deals
-- with the case of derived types.
function Nearest_Dynamic_Scope (Ent : Entity_Id) return Entity_Id;
-- This is similar to Enclosing_Dynamic_Scope except that if Ent is itself
-- a dynamic scope, then it is returned. Otherwise the result is the same
-- as that returned by Enclosing_Dynamic_Scope.
function Next_Tag_Component (Tag : Entity_Id) return Entity_Id;
-- Tag must be an entity representing a _Tag field of a tagged record.
-- The result returned is the next _Tag field in this record, or Empty
-- if this is the last such field.
function Number_Discriminants (Typ : Entity_Id) return Pos;
-- Typ is a type with discriminants, yields number of discriminants in type
function Object_Type_Has_Constrained_Partial_View
(Typ : Entity_Id;
Scop : Entity_Id) return Boolean;
-- Return True if type of object has attribute Has_Constrained_Partial_View
-- set to True; in addition, within a generic body, return True if subtype
-- of the object is a descendant of an untagged generic formal private or
-- derived type, and the subtype is not an unconstrained array subtype
-- (RM 3.3(23.10/3)).
function Package_Body (E : Entity_Id) return Node_Id;
-- Given an entity for a package, return the corresponding package body, if
-- any, or else Empty.
function Package_Spec (E : Entity_Id) return Node_Id;
-- Given an entity for a package spec, return the corresponding package
-- spec if any, or else Empty.
function Package_Specification (E : Entity_Id) return Node_Id;
-- Given an entity for a package, return the corresponding package
-- specification.
function Subprogram_Body (E : Entity_Id) return Node_Id;
-- Given an entity for a subprogram (spec or body), return the
-- corresponding subprogram body if any, or else Empty.
function Subprogram_Body_Entity (E : Entity_Id) return Entity_Id;
-- Given an entity for a subprogram (spec or body), return the entity
-- corresponding to the subprogram body, which may be the same as E or
-- Empty if no body is available.
function Subprogram_Spec (E : Entity_Id) return Node_Id;
-- Given an entity for a subprogram spec, return the corresponding
-- subprogram spec if any, or else Empty.
function Subprogram_Specification (E : Entity_Id) return Node_Id;
-- Given an entity for a subprogram, return the corresponding subprogram
-- specification. If the entity is an inherited subprogram without
-- specification itself, return the specification of the inherited
-- subprogram.
function Ultimate_Alias (Prim : Entity_Id) return Entity_Id;
pragma Inline (Ultimate_Alias);
-- Return the last entity in the chain of aliased entities of Prim. If Prim
-- has no alias return Prim.
function Unit_Declaration_Node (Unit_Id : Entity_Id) return Node_Id;
-- Unit_Id is the simple name of a program unit, this function returns the
-- corresponding xxx_Declaration node for the entity. Also applies to the
-- body entities for subprograms, tasks and protected units, in which case
-- it returns the subprogram, task or protected body node for it. The unit
-- may be a child unit with any number of ancestors.
end Sem_Aux;