197 lines
10 KiB
Ada
Executable File
197 lines
10 KiB
Ada
Executable File
------------------------------------------------------------------------------
|
|
-- --
|
|
-- GNAT COMPILER COMPONENTS --
|
|
-- --
|
|
-- S E M _ A U X --
|
|
-- --
|
|
-- S p e c --
|
|
-- --
|
|
-- Copyright (C) 1992-2009, 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. --
|
|
-- --
|
|
-- 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. --
|
|
-- --
|
|
-- 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,
|
|
-- and also by ASIS so dependencies are limited to ASIS included packages.
|
|
|
|
-- 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; use Alloc;
|
|
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. Note that
|
|
-- Initialize must not be called if Tree_Read is used.
|
|
|
|
procedure Tree_Read;
|
|
-- Initializes Obsolescent_Warnings table from current tree file using the
|
|
-- relevant Table.Tree_Read routine.
|
|
|
|
procedure Tree_Write;
|
|
-- Writes out Obsolescent_Warnings table to current tree file using the
|
|
-- relevant Table.Tree_Write routine.
|
|
|
|
-----------------
|
|
-- Subprograms --
|
|
-----------------
|
|
|
|
function Ancestor_Subtype (Typ : Entity_Id) return Entity_Id;
|
|
-- The argument Id 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.
|
|
|
|
function Available_View (Typ : Entity_Id) return Entity_Id;
|
|
-- Typ is typically a type that has the With_Type flag set. Returns the
|
|
-- non-limited view of the type, if available, otherwise the type itself.
|
|
-- For class-wide types, there is no direct link in the tree, so we have
|
|
-- to retrieve the class-wide type of the non-limited view of the Etype.
|
|
-- Returns the argument unchanged if it is not one of these cases.
|
|
|
|
function Constant_Value (Ent : Entity_Id) return Node_Id;
|
|
-- Id is a variable, constant, named integer, or named real entity. This
|
|
-- call obtains the initialization expression for the entity. Will return
|
|
-- Empty for 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.
|
|
|
|
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.
|
|
|
|
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 non-tagged 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 visble 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.
|
|
|
|
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.
|
|
|
|
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 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)).
|
|
|
|
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.
|
|
|
|
function Is_Indefinite_Subtype (Ent : Entity_Id) return Boolean;
|
|
-- Ent is any entity. Determines if given entity is an unconstrained array
|
|
-- type or subtype, a discriminated record type or subtype with no initial
|
|
-- discriminant values or a class wide type or subtype and returns True if
|
|
-- so. False for other type entities, or any entities that are not types.
|
|
|
|
function Is_Inherently_Limited_Type (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.
|
|
|
|
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).
|
|
|
|
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
|
|
|
|
end Sem_Aux;
|