Subversion Repositories openrisc

------------------------------------------------------------------------------

--                                                                          --

--                         GNAT COMPILER COMPONENTS                         --

--                                                                          --

--                              S E M _ C H 3                               --

--                                                                          --

--                                 B o d y                                  --

--                                                                          --

--          Copyright (C) 1992-2012, 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.      --

--                                                                          --

------------------------------------------------------------------------------

with Atree;    use Atree;

with Checks;   use Checks;

with Debug;    use Debug;

with Elists;   use Elists;

with Einfo;    use Einfo;

with Errout;   use Errout;

with Eval_Fat; use Eval_Fat;

with Exp_Ch3;  use Exp_Ch3;

with Exp_Ch9;  use Exp_Ch9;

with Exp_Disp; use Exp_Disp;

with Exp_Dist; use Exp_Dist;

with Exp_Tss;  use Exp_Tss;

with Exp_Util; use Exp_Util;

with Fname;    use Fname;

with Freeze;   use Freeze;

with Itypes;   use Itypes;

with Layout;   use Layout;

with Lib;      use Lib;

with Lib.Xref; use Lib.Xref;

with Namet;    use Namet;

with Nmake;    use Nmake;

with Opt;      use Opt;

with Restrict; use Restrict;

with Rident;   use Rident;

with Rtsfind;  use Rtsfind;

with Sem;      use Sem;

with Sem_Aux;  use Sem_Aux;

with Sem_Case; use Sem_Case;

with Sem_Cat;  use Sem_Cat;

with Sem_Ch6;  use Sem_Ch6;

with Sem_Ch7;  use Sem_Ch7;

with Sem_Ch8;  use Sem_Ch8;

with Sem_Ch13; use Sem_Ch13;

with Sem_Dim;  use Sem_Dim;

with Sem_Disp; use Sem_Disp;

with Sem_Dist; use Sem_Dist;

with Sem_Elim; use Sem_Elim;

with Sem_Eval; use Sem_Eval;

with Sem_Mech; use Sem_Mech;

with Sem_Prag; use Sem_Prag;

with Sem_Res;  use Sem_Res;

with Sem_Smem; use Sem_Smem;

with Sem_Type; use Sem_Type;

with Sem_Util; use Sem_Util;

with Sem_Warn; use Sem_Warn;

with Stand;    use Stand;

with Sinfo;    use Sinfo;

with Sinput;   use Sinput;

with Snames;   use Snames;

with Targparm; use Targparm;

with Tbuild;   use Tbuild;

with Ttypes;   use Ttypes;

with Uintp;    use Uintp;

with Urealp;   use Urealp;

package body Sem_Ch3 is

   -----------------------

   -- Local Subprograms --

   -----------------------

   procedure Add_Interface_Tag_Components (N : Node_Id; Typ : Entity_Id);

   --  Ada 2005 (AI-251): Add the tag components corresponding to all the

   --  abstract interface types implemented by a record type or a derived

   --  record type.

   procedure Build_Derived_Type

     (N             : Node_Id;

      Parent_Type   : Entity_Id;

      Derived_Type  : Entity_Id;

      Is_Completion : Boolean;

      Derive_Subps  : Boolean := True);

   --  Create and decorate a Derived_Type given the Parent_Type entity. N is

   --  the N_Full_Type_Declaration node containing the derived type definition.

   --  Parent_Type is the entity for the parent type in the derived type

   --  definition and Derived_Type the actual derived type. Is_Completion must

   --  be set to False if Derived_Type is the N_Defining_Identifier node in N

   --  (i.e. Derived_Type = Defining_Identifier (N)). In this case N is not the

   --  completion of a private type declaration. If Is_Completion is set to

   --  True, N is the completion of a private type declaration and Derived_Type

   --  is different from the defining identifier inside N (i.e. Derived_Type /=

   --  Defining_Identifier (N)). Derive_Subps indicates whether the parent

   --  subprograms should be derived. The only case where this parameter is

   --  False is when Build_Derived_Type is recursively called to process an

   --  implicit derived full type for a type derived from a private type (in

   --  that case the subprograms must only be derived for the private view of

   --  the type).

   --

   --  ??? These flags need a bit of re-examination and re-documentation:

   --  ???  are they both necessary (both seem related to the recursion)?

   procedure Build_Derived_Access_Type

     (N            : Node_Id;

      Parent_Type  : Entity_Id;

      Derived_Type : Entity_Id);

   --  Subsidiary procedure to Build_Derived_Type. For a derived access type,

   --  create an implicit base if the parent type is constrained or if the

   --  subtype indication has a constraint.

   procedure Build_Derived_Array_Type

     (N            : Node_Id;

      Parent_Type  : Entity_Id;

      Derived_Type : Entity_Id);

   --  Subsidiary procedure to Build_Derived_Type. For a derived array type,

   --  create an implicit base if the parent type is constrained or if the

   --  subtype indication has a constraint.

   procedure Build_Derived_Concurrent_Type

     (N            : Node_Id;

      Parent_Type  : Entity_Id;

      Derived_Type : Entity_Id);

   --  Subsidiary procedure to Build_Derived_Type. For a derived task or

   --  protected type, inherit entries and protected subprograms, check

   --  legality of discriminant constraints if any.

   procedure Build_Derived_Enumeration_Type

     (N            : Node_Id;

      Parent_Type  : Entity_Id;

      Derived_Type : Entity_Id);

   --  Subsidiary procedure to Build_Derived_Type. For a derived enumeration

   --  type, we must create a new list of literals. Types derived from

   --  Character and [Wide_]Wide_Character are special-cased.

   procedure Build_Derived_Numeric_Type

     (N            : Node_Id;

      Parent_Type  : Entity_Id;

      Derived_Type : Entity_Id);

   --  Subsidiary procedure to Build_Derived_Type. For numeric types, create

   --  an anonymous base type, and propagate constraint to subtype if needed.

   procedure Build_Derived_Private_Type

     (N             : Node_Id;

      Parent_Type   : Entity_Id;

      Derived_Type  : Entity_Id;

      Is_Completion : Boolean;

      Derive_Subps  : Boolean := True);

   --  Subsidiary procedure to Build_Derived_Type. This procedure is complex

   --  because the parent may or may not have a completion, and the derivation

   --  may itself be a completion.

   procedure Build_Derived_Record_Type

     (N            : Node_Id;

      Parent_Type  : Entity_Id;

      Derived_Type : Entity_Id;

      Derive_Subps : Boolean := True);

   --  Subsidiary procedure for Build_Derived_Type and

   --  Analyze_Private_Extension_Declaration used for tagged and untagged

   --  record types. All parameters are as in Build_Derived_Type except that

   --  N, in addition to being an N_Full_Type_Declaration node, can also be an

   --  N_Private_Extension_Declaration node. See the definition of this routine

   --  for much more info. Derive_Subps indicates whether subprograms should

   --  be derived from the parent type. The only case where Derive_Subps is

   --  False is for an implicit derived full type for a type derived from a

   --  private type (see Build_Derived_Type).

   procedure Build_Discriminal (Discrim : Entity_Id);

   --  Create the discriminal corresponding to discriminant Discrim, that is

   --  the parameter corresponding to Discrim to be used in initialization

   --  procedures for the type where Discrim is a discriminant. Discriminals

   --  are not used during semantic analysis, and are not fully defined

   --  entities until expansion. Thus they are not given a scope until

   --  initialization procedures are built.

   function Build_Discriminant_Constraints

     (T           : Entity_Id;

      Def         : Node_Id;

      Derived_Def : Boolean := False) return Elist_Id;

   --  Validate discriminant constraints and return the list of the constraints

   --  in order of discriminant declarations, where T is the discriminated

   --  unconstrained type. Def is the N_Subtype_Indication node where the

   --  discriminants constraints for T are specified. Derived_Def is True

   --  when building the discriminant constraints in a derived type definition

   --  of the form "type D (...) is new T (xxx)". In this case T is the parent

   --  type and Def is the constraint "(xxx)" on T and this routine sets the

   --  Corresponding_Discriminant field of the discriminants in the derived

   --  type D to point to the corresponding discriminants in the parent type T.

   procedure Build_Discriminated_Subtype

     (T           : Entity_Id;

      Def_Id      : Entity_Id;

      Elist       : Elist_Id;

      Related_Nod : Node_Id;

      For_Access  : Boolean := False);

   --  Subsidiary procedure to Constrain_Discriminated_Type and to

   --  Process_Incomplete_Dependents. Given

   --

   --     T (a possibly discriminated base type)

   --     Def_Id (a very partially built subtype for T),

   --

   --  the call completes Def_Id to be the appropriate E_*_Subtype.

   --

   --  The Elist is the list of discriminant constraints if any (it is set

   --  to No_Elist if T is not a discriminated type, and to an empty list if

   --  T has discriminants but there are no discriminant constraints). The

   --  Related_Nod is the same as Decl_Node in Create_Constrained_Components.

   --  The For_Access says whether or not this subtype is really constraining

   --  an access type. That is its sole purpose is the designated type of an

   --  access type -- in which case a Private_Subtype Is_For_Access_Subtype

   --  is built to avoid freezing T when the access subtype is frozen.

   function Build_Scalar_Bound

     (Bound : Node_Id;

      Par_T : Entity_Id;

      Der_T : Entity_Id) return Node_Id;

   --  The bounds of a derived scalar type are conversions of the bounds of

   --  the parent type. Optimize the representation if the bounds are literals.

   --  Needs a more complete spec--what are the parameters exactly, and what

   --  exactly is the returned value, and how is Bound affected???

   procedure Build_Underlying_Full_View

     (N   : Node_Id;

      Typ : Entity_Id;

      Par : Entity_Id);

   --  If the completion of a private type is itself derived from a private

   --  type, or if the full view of a private subtype is itself private, the

   --  back-end has no way to compute the actual size of this type. We build

   --  an internal subtype declaration of the proper parent type to convey

   --  this information. This extra mechanism is needed because a full

   --  view cannot itself have a full view (it would get clobbered during

   --  view exchanges).

   procedure Check_Access_Discriminant_Requires_Limited

     (D   : Node_Id;

      Loc : Node_Id);

   --  Check the restriction that the type to which an access discriminant

   --  belongs must be a concurrent type or a descendant of a type with

   --  the reserved word 'limited' in its declaration.

   procedure Check_Anonymous_Access_Components

      (Typ_Decl  : Node_Id;

       Typ       : Entity_Id;

       Prev      : Entity_Id;

       Comp_List : Node_Id);

   --  Ada 2005 AI-382: an access component in a record definition can refer to

   --  the enclosing record, in which case it denotes the type itself, and not

   --  the current instance of the type. We create an anonymous access type for

   --  the component, and flag it as an access to a component, so accessibility

   --  checks are properly performed on it. The declaration of the access type

   --  is placed ahead of that of the record to prevent order-of-elaboration

   --  circularity issues in Gigi. We create an incomplete type for the record

   --  declaration, which is the designated type of the anonymous access.

   procedure Check_Delta_Expression (E : Node_Id);

   --  Check that the expression represented by E is suitable for use as a

   --  delta expression, i.e. it is of real type and is static.

   procedure Check_Digits_Expression (E : Node_Id);

   --  Check that the expression represented by E is suitable for use as a

   --  digits expression, i.e. it is of integer type, positive and static.

   procedure Check_Initialization (T : Entity_Id; Exp : Node_Id);

   --  Validate the initialization of an object declaration. T is the required

   --  type, and Exp is the initialization expression.

   procedure Check_Interfaces (N : Node_Id; Def : Node_Id);

   --  Check ARM rules 3.9.4 (15/2), 9.1 (9.d/2) and 9.4 (11.d/2)

   procedure Check_Or_Process_Discriminants

     (N    : Node_Id;

      T    : Entity_Id;

      Prev : Entity_Id := Empty);

   --  If N is the full declaration of the completion T of an incomplete or

   --  private type, check its discriminants (which are already known to be

   --  conformant with those of the partial view, see Find_Type_Name),

   --  otherwise process them. Prev is the entity of the partial declaration,

   --  if any.

   procedure Check_Real_Bound (Bound : Node_Id);

   --  Check given bound for being of real type and static. If not, post an

   --  appropriate message, and rewrite the bound with the real literal zero.

   procedure Constant_Redeclaration

     (Id : Entity_Id;

      N  : Node_Id;

      T  : out Entity_Id);

   --  Various checks on legality of full declaration of deferred constant.

   --  Id is the entity for the redeclaration, N is the N_Object_Declaration,

   --  node. The caller has not yet set any attributes of this entity.

   function Contain_Interface

     (Iface  : Entity_Id;

      Ifaces : Elist_Id) return Boolean;

   --  Ada 2005: Determine whether Iface is present in the list Ifaces

   procedure Convert_Scalar_Bounds

     (N            : Node_Id;

      Parent_Type  : Entity_Id;

      Derived_Type : Entity_Id;

      Loc          : Source_Ptr);

   --  For derived scalar types, convert the bounds in the type definition to

   --  the derived type, and complete their analysis. Given a constraint of the

   --  form ".. new T range Lo .. Hi", Lo and Hi are analyzed and resolved with

   --  T'Base, the parent_type. The bounds of the derived type (the anonymous

   --  base) are copies of Lo and Hi. Finally, the bounds of the derived

   --  subtype are conversions of those bounds to the derived_type, so that

   --  their typing is consistent.

   procedure Copy_Array_Base_Type_Attributes (T1, T2 : Entity_Id);

   --  Copies attributes from array base type T2 to array base type T1. Copies

   --  only attributes that apply to base types, but not subtypes.

   procedure Copy_Array_Subtype_Attributes (T1, T2 : Entity_Id);

   --  Copies attributes from array subtype T2 to array subtype T1. Copies

   --  attributes that apply to both subtypes and base types.

   procedure Create_Constrained_Components

     (Subt        : Entity_Id;

      Decl_Node   : Node_Id;

      Typ         : Entity_Id;

      Constraints : Elist_Id);

   --  Build the list of entities for a constrained discriminated record

   --  subtype. If a component depends on a discriminant, replace its subtype

   --  using the discriminant values in the discriminant constraint. Subt

   --  is the defining identifier for the subtype whose list of constrained

   --  entities we will create. Decl_Node is the type declaration node where

   --  we will attach all the itypes created. Typ is the base discriminated

   --  type for the subtype Subt. Constraints is the list of discriminant

   --  constraints for Typ.

   function Constrain_Component_Type

     (Comp            : Entity_Id;

      Constrained_Typ : Entity_Id;

      Related_Node    : Node_Id;

      Typ             : Entity_Id;

      Constraints     : Elist_Id) return Entity_Id;

   --  Given a discriminated base type Typ, a list of discriminant constraint

   --  Constraints for Typ and a component of Typ, with type Compon_Type,

   --  create and return the type corresponding to Compon_type where all

   --  discriminant references are replaced with the corresponding constraint.

   --  If no discriminant references occur in Compon_Typ then return it as is.

   --  Constrained_Typ is the final constrained subtype to which the

   --  constrained Compon_Type belongs. Related_Node is the node where we will

   --  attach all the itypes created.

   --

   --  Above description is confused, what is Compon_Type???

   procedure Constrain_Access

     (Def_Id      : in out Entity_Id;

      S           : Node_Id;

      Related_Nod : Node_Id);

   --  Apply a list of constraints to an access type. If Def_Id is empty, it is

   --  an anonymous type created for a subtype indication. In that case it is

   --  created in the procedure and attached to Related_Nod.

   procedure Constrain_Array

     (Def_Id      : in out Entity_Id;

      SI          : Node_Id;

      Related_Nod : Node_Id;

      Related_Id  : Entity_Id;

      Suffix      : Character);

   --  Apply a list of index constraints to an unconstrained array type. The

   --  first parameter is the entity for the resulting subtype. A value of

   --  Empty for Def_Id indicates that an implicit type must be created, but

   --  creation is delayed (and must be done by this procedure) because other

   --  subsidiary implicit types must be created first (which is why Def_Id

   --  is an in/out parameter). The second parameter is a subtype indication

   --  node for the constrained array to be created (e.g. something of the

   --  form string (1 .. 10)). Related_Nod gives the place where this type

   --  has to be inserted in the tree. The Related_Id and Suffix parameters

   --  are used to build the associated Implicit type name.

   procedure Constrain_Concurrent

     (Def_Id      : in out Entity_Id;

      SI          : Node_Id;

      Related_Nod : Node_Id;

      Related_Id  : Entity_Id;

      Suffix      : Character);

   --  Apply list of discriminant constraints to an unconstrained concurrent

   --  type.

   --

   --    SI is the N_Subtype_Indication node containing the constraint and

   --    the unconstrained type to constrain.

   --

   --    Def_Id is the entity for the resulting constrained subtype. A value

   --    of Empty for Def_Id indicates that an implicit type must be created,

   --    but creation is delayed (and must be done by this procedure) because

   --    other subsidiary implicit types must be created first (which is why

   --    Def_Id is an in/out parameter).

   --

   --    Related_Nod gives the place where this type has to be inserted

   --    in the tree

   --

   --  The last two arguments are used to create its external name if needed.

   function Constrain_Corresponding_Record

     (Prot_Subt   : Entity_Id;

      Corr_Rec    : Entity_Id;

      Related_Nod : Node_Id;

      Related_Id  : Entity_Id) return Entity_Id;

   --  When constraining a protected type or task type with discriminants,

   --  constrain the corresponding record with the same discriminant values.

   procedure Constrain_Decimal (Def_Id : Node_Id; S : Node_Id);

   --  Constrain a decimal fixed point type with a digits constraint and/or a

   --  range constraint, and build E_Decimal_Fixed_Point_Subtype entity.

   procedure Constrain_Discriminated_Type

     (Def_Id      : Entity_Id;

      S           : Node_Id;

      Related_Nod : Node_Id;

      For_Access  : Boolean := False);

   --  Process discriminant constraints of composite type. Verify that values

   --  have been provided for all discriminants, that the original type is

   --  unconstrained, and that the types of the supplied expressions match

   --  the discriminant types. The first three parameters are like in routine

   --  Constrain_Concurrent. See Build_Discriminated_Subtype for an explanation

   --  of For_Access.

   procedure Constrain_Enumeration (Def_Id : Node_Id; S : Node_Id);

   --  Constrain an enumeration type with a range constraint. This is identical

   --  to Constrain_Integer, but for the Ekind of the resulting subtype.

   procedure Constrain_Float (Def_Id : Node_Id; S : Node_Id);

   --  Constrain a floating point type with either a digits constraint

   --  and/or a range constraint, building a E_Floating_Point_Subtype.

   procedure Constrain_Index

     (Index        : Node_Id;

      S            : Node_Id;

      Related_Nod  : Node_Id;

      Related_Id   : Entity_Id;

      Suffix       : Character;

      Suffix_Index : Nat);

   --  Process an index constraint S in a constrained array declaration. The

   --  constraint can be a subtype name, or a range with or without an explicit

   --  subtype mark. The index is the corresponding index of the unconstrained

   --  array. The Related_Id and Suffix parameters are used to build the

   --  associated Implicit type name.

   procedure Constrain_Integer (Def_Id : Node_Id; S : Node_Id);

   --  Build subtype of a signed or modular integer type

   procedure Constrain_Ordinary_Fixed (Def_Id : Node_Id; S : Node_Id);

   --  Constrain an ordinary fixed point type with a range constraint, and

   --  build an E_Ordinary_Fixed_Point_Subtype entity.

   procedure Copy_And_Swap (Priv, Full : Entity_Id);

   --  Copy the Priv entity into the entity of its full declaration then swap

   --  the two entities in such a manner that the former private type is now

   --  seen as a full type.

   procedure Decimal_Fixed_Point_Type_Declaration

     (T   : Entity_Id;

      Def : Node_Id);

   --  Create a new decimal fixed point type, and apply the constraint to

   --  obtain a subtype of this new type.

   procedure Complete_Private_Subtype

     (Priv        : Entity_Id;

      Full        : Entity_Id;

      Full_Base   : Entity_Id;

      Related_Nod : Node_Id);

   --  Complete the implicit full view of a private subtype by setting the

   --  appropriate semantic fields. If the full view of the parent is a record

   --  type, build constrained components of subtype.

   procedure Derive_Progenitor_Subprograms

     (Parent_Type : Entity_Id;

      Tagged_Type : Entity_Id);

   --  Ada 2005 (AI-251): To complete type derivation, collect the primitive

   --  operations of progenitors of Tagged_Type, and replace the subsidiary

   --  subtypes with Tagged_Type, to build the specs of the inherited interface

   --  primitives. The derived primitives are aliased to those of the

   --  interface. This routine takes care also of transferring to the full view

   --  subprograms associated with the partial view of Tagged_Type that cover

   --  interface primitives.

   procedure Derived_Standard_Character

     (N             : Node_Id;

      Parent_Type   : Entity_Id;

      Derived_Type  : Entity_Id);

   --  Subsidiary procedure to Build_Derived_Enumeration_Type which handles

   --  derivations from types Standard.Character and Standard.Wide_Character.

   procedure Derived_Type_Declaration

     (T             : Entity_Id;

      N             : Node_Id;

      Is_Completion : Boolean);

   --  Process a derived type declaration. Build_Derived_Type is invoked

   --  to process the actual derived type definition. Parameters N and

   --  Is_Completion have the same meaning as in Build_Derived_Type.

   --  T is the N_Defining_Identifier for the entity defined in the

   --  N_Full_Type_Declaration node N, that is T is the derived type.

   procedure Enumeration_Type_Declaration (T : Entity_Id; Def : Node_Id);

   --  Insert each literal in symbol table, as an overloadable identifier. Each

   --  enumeration type is mapped into a sequence of integers, and each literal

   --  is defined as a constant with integer value. If any of the literals are

   --  character literals, the type is a character type, which means that

   --  strings are legal aggregates for arrays of components of the type.

   function Expand_To_Stored_Constraint

     (Typ        : Entity_Id;

      Constraint : Elist_Id) return Elist_Id;

   --  Given a constraint (i.e. a list of expressions) on the discriminants of

   --  Typ, expand it into a constraint on the stored discriminants and return

   --  the new list of expressions constraining the stored discriminants.

   function Find_Type_Of_Object

     (Obj_Def     : Node_Id;

      Related_Nod : Node_Id) return Entity_Id;

   --  Get type entity for object referenced by Obj_Def, attaching the

   --  implicit types generated to Related_Nod

   procedure Floating_Point_Type_Declaration (T : Entity_Id; Def : Node_Id);

   --  Create a new float and apply the constraint to obtain subtype of it

   function Has_Range_Constraint (N : Node_Id) return Boolean;

   --  Given an N_Subtype_Indication node N, return True if a range constraint

   --  is present, either directly, or as part of a digits or delta constraint.

   --  In addition, a digits constraint in the decimal case returns True, since

   --  it establishes a default range if no explicit range is present.

   function Inherit_Components

     (N             : Node_Id;

      Parent_Base   : Entity_Id;

      Derived_Base  : Entity_Id;

      Is_Tagged     : Boolean;

      Inherit_Discr : Boolean;

      Discs         : Elist_Id) return Elist_Id;

   --  Called from Build_Derived_Record_Type to inherit the components of

   --  Parent_Base (a base type) into the Derived_Base (the derived base type).

   --  For more information on derived types and component inheritance please

   --  consult the comment above the body of Build_Derived_Record_Type.

   --

   --    N is the original derived type declaration

   --

   --    Is_Tagged is set if we are dealing with tagged types

   --

   --    If Inherit_Discr is set, Derived_Base inherits its discriminants from

   --    Parent_Base, otherwise no discriminants are inherited.

   --

   --    Discs gives the list of constraints that apply to Parent_Base in the

   --    derived type declaration. If Discs is set to No_Elist, then we have

   --    the following situation:

   --

   --      type Parent (D1..Dn : ..) is [tagged] record ...;

   --      type Derived is new Parent [with ...];

   --

   --    which gets treated as

   --

   --      type Derived (D1..Dn : ..) is new Parent (D1,..,Dn) [with ...];

   --

   --  For untagged types the returned value is an association list. The list

   --  starts from the association (Parent_Base => Derived_Base), and then it

   --  contains a sequence of the associations of the form

   --

   --    (Old_Component => New_Component),

   --

   --  where Old_Component is the Entity_Id of a component in Parent_Base and

   --  New_Component is the Entity_Id of the corresponding component in

   --  Derived_Base. For untagged records, this association list is needed when

   --  copying the record declaration for the derived base. In the tagged case

   --  the value returned is irrelevant.

   function Is_Valid_Constraint_Kind

     (T_Kind          : Type_Kind;

      Constraint_Kind : Node_Kind) return Boolean;

   --  Returns True if it is legal to apply the given kind of constraint to the

   --  given kind of type (index constraint to an array type, for example).

   procedure Modular_Type_Declaration (T : Entity_Id; Def : Node_Id);

   --  Create new modular type. Verify that modulus is in bounds

   procedure New_Concatenation_Op (Typ : Entity_Id);

   --  Create an abbreviated declaration for an operator in order to

   --  materialize concatenation on array types.

   procedure Ordinary_Fixed_Point_Type_Declaration

     (T   : Entity_Id;

      Def : Node_Id);

   --  Create a new ordinary fixed point type, and apply the constraint to

   --  obtain subtype of it.

   procedure Prepare_Private_Subtype_Completion

     (Id          : Entity_Id;

      Related_Nod : Node_Id);

   --  Id is a subtype of some private type. Creates the full declaration

   --  associated with Id whenever possible, i.e. when the full declaration

   --  of the base type is already known. Records each subtype into

   --  Private_Dependents of the base type.

   procedure Process_Incomplete_Dependents

     (N      : Node_Id;

      Full_T : Entity_Id;

      Inc_T  : Entity_Id);

   --  Process all entities that depend on an incomplete type. There include

   --  subtypes, subprogram types that mention the incomplete type in their

   --  profiles, and subprogram with access parameters that designate the

   --  incomplete type.

   --  Inc_T is the defining identifier of an incomplete type declaration, its

   --  Ekind is E_Incomplete_Type.

   --

   --    N is the corresponding N_Full_Type_Declaration for Inc_T.

   --

   --    Full_T is N's defining identifier.

   --

   --  Subtypes of incomplete types with discriminants are completed when the

   --  parent type is. This is simpler than private subtypes, because they can

   --  only appear in the same scope, and there is no need to exchange views.

   --  Similarly, access_to_subprogram types may have a parameter or a return

   --  type that is an incomplete type, and that must be replaced with the

   --  full type.

   --

   --  If the full type is tagged, subprogram with access parameters that

   --  designated the incomplete may be primitive operations of the full type,

   --  and have to be processed accordingly.

   procedure Process_Real_Range_Specification (Def : Node_Id);

   --  Given the type definition for a real type, this procedure processes and

   --  checks the real range specification of this type definition if one is

   --  present. If errors are found, error messages are posted, and the

   --  Real_Range_Specification of Def is reset to Empty.

   procedure Record_Type_Declaration

     (T    : Entity_Id;

      N    : Node_Id;

      Prev : Entity_Id);

   --  Process a record type declaration (for both untagged and tagged

   --  records). Parameters T and N are exactly like in procedure

   --  Derived_Type_Declaration, except that no flag Is_Completion is needed

   --  for this routine. If this is the completion of an incomplete type

   --  declaration, Prev is the entity of the incomplete declaration, used for

   --  cross-referencing. Otherwise Prev = T.

   procedure Record_Type_Definition (Def : Node_Id; Prev_T : Entity_Id);

   --  This routine is used to process the actual record type definition (both

   --  for untagged and tagged records). Def is a record type definition node.

   --  This procedure analyzes the components in this record type definition.

   --  Prev_T is the entity for the enclosing record type. It is provided so

   --  that its Has_Task flag can be set if any of the component have Has_Task

   --  set. If the declaration is the completion of an incomplete type

   --  declaration, Prev_T is the original incomplete type, whose full view is

   --  the record type.

   procedure Replace_Components (Typ : Entity_Id; Decl : Node_Id);

   --  Subsidiary to Build_Derived_Record_Type. For untagged records, we

   --  build a copy of the declaration tree of the parent, and we create

   --  independently the list of components for the derived type. Semantic

   --  information uses the component entities, but record representation

   --  clauses are validated on the declaration tree. This procedure replaces

   --  discriminants and components in the declaration with those that have

   --  been created by Inherit_Components.

   procedure Set_Fixed_Range

     (E   : Entity_Id;

      Loc : Source_Ptr;

      Lo  : Ureal;

      Hi  : Ureal);

   --  Build a range node with the given bounds and set it as the Scalar_Range

   --  of the given fixed-point type entity. Loc is the source location used

   --  for the constructed range. See body for further details.

   procedure Set_Scalar_Range_For_Subtype

     (Def_Id : Entity_Id;

      R      : Node_Id;

      Subt   : Entity_Id);

   --  This routine is used to set the scalar range field for a subtype given

   --  Def_Id, the entity for the subtype, and R, the range expression for the

   --  scalar range. Subt provides the parent subtype to be used to analyze,

   --  resolve, and check the given range.

   procedure Signed_Integer_Type_Declaration (T : Entity_Id; Def : Node_Id);

   --  Create a new signed integer entity, and apply the constraint to obtain

   --  the required first named subtype of this type.

   procedure Set_Stored_Constraint_From_Discriminant_Constraint

     (E : Entity_Id);

   --  E is some record type. This routine computes E's Stored_Constraint

   --  from its Discriminant_Constraint.

   procedure Diagnose_Interface (N : Node_Id;  E : Entity_Id);

   --  Check that an entity in a list of progenitors is an interface,

   --  emit error otherwise.

   -----------------------

   -- Access_Definition --

   -----------------------

   function Access_Definition

     (Related_Nod : Node_Id;

      N           : Node_Id) return Entity_Id

   is

      Anon_Type           : Entity_Id;

      Anon_Scope          : Entity_Id;

      Desig_Type          : Entity_Id;

      Enclosing_Prot_Type : Entity_Id := Empty;

   begin

      Check_SPARK_Restriction ("access type is not allowed", N);

      if Is_Entry (Current_Scope)

        and then Is_Task_Type (Etype (Scope (Current_Scope)))

      then

         Error_Msg_N ("task entries cannot have access parameters", N);

         return Empty;

      end if;

      --  Ada 2005: for an object declaration the corresponding anonymous

      --  type is declared in the current scope.

      --  If the access definition is the return type of another access to

      --  function, scope is the current one, because it is the one of the

      --  current type declaration, except for the pathological case below.

      if Nkind_In (Related_Nod, N_Object_Declaration,

                                N_Access_Function_Definition)

      then

         Anon_Scope := Current_Scope;

         --  A pathological case: function returning access functions that

         --  return access functions, etc. Each anonymous access type created

         --  is in the enclosing scope of the outermost function.

         declare

            Par : Node_Id;

         begin

            Par := Related_Nod;

            while Nkind_In (Par, N_Access_Function_Definition,

                                 N_Access_Definition)

            loop

               Par := Parent (Par);

            end loop;

            if Nkind (Par) = N_Function_Specification then

               Anon_Scope := Scope (Defining_Entity (Par));

            end if;

         end;

      --  For the anonymous function result case, retrieve the scope of the

      --  function specification's associated entity rather than using the

      --  current scope. The current scope will be the function itself if the

      --  formal part is currently being analyzed, but will be the parent scope

      --  in the case of a parameterless function, and we always want to use

      --  the function's parent scope. Finally, if the function is a child

      --  unit, we must traverse the tree to retrieve the proper entity.

      elsif Nkind (Related_Nod) = N_Function_Specification

        and then Nkind (Parent (N)) /= N_Parameter_Specification

      then

         --  If the current scope is a protected type, the anonymous access

         --  is associated with one of the protected operations, and must

         --  be available in the scope that encloses the protected declaration.

         --  Otherwise the type is in the scope enclosing the subprogram.

         --  If the function has formals, The return type of a subprogram

         --  declaration is analyzed in the scope of the subprogram (see

         --  Process_Formals) and thus the protected type, if present, is

         --  the scope of the current function scope.

         if Ekind (Current_Scope) = E_Protected_Type then

            Enclosing_Prot_Type := Current_Scope;

         elsif Ekind (Current_Scope) = E_Function

           and then Ekind (Scope (Current_Scope)) = E_Protected_Type

         then

            Enclosing_Prot_Type := Scope (Current_Scope);

         end if;

         if Present (Enclosing_Prot_Type) then

            Anon_Scope := Scope (Enclosing_Prot_Type);

         else

            Anon_Scope := Scope (Defining_Entity (Related_Nod));

         end if;

      --  For an access type definition, if the current scope is a child

      --  unit it is the scope of the type.

      elsif Is_Compilation_Unit (Current_Scope) then

         Anon_Scope := Current_Scope;

      --  For access formals, access components, and access discriminants, the

      --  scope is that of the enclosing declaration,

      else

         Anon_Scope := Scope (Current_Scope);

      end if;

      Anon_Type :=

        Create_Itype

          (E_Anonymous_Access_Type, Related_Nod, Scope_Id => Anon_Scope);

      if All_Present (N)

        and then Ada_Version >= Ada_2005

      then

         Error_Msg_N ("ALL is not permitted for anonymous access types", N);

      end if;

      --  Ada 2005 (AI-254): In case of anonymous access to subprograms call

      --  the corresponding semantic routine