------------------------------------------------------------------------------
--                                                                          --
--                 ASIS-for-GNAT IMPLEMENTATION COMPONENTS                  --
--                                                                          --
--                          A 4 G . E X P R _ S E M                         --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                            $Revision: 1.57.2.1 $
--                                                                          --
--            Copyright (c) 1995-2002, Free Software Foundation, Inc.       --
--                                                                          --
-- ASIS-for-GNAT is free software; you can redistribute it and/or modify it --
-- under terms of the  GNU General Public License  as published by the Free --
-- Software Foundation;  either version 2,  or  (at your option)  any later --
-- version. ASIS-for-GNAT is distributed  in the hope  that it will be use- --
-- ful, but WITHOUT ANY WARRANTY; without even the implied warranty of MER- --
-- CHANTABILITY or  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General  --
-- Public License for more details. You should have received a copy of the  --
-- GNU General Public License  distributed with ASIS-for-GNAT; see file     --
-- COPYING. If not, write to the Free Software Foundation,  59 Temple Place --
-- - Suite 330,  Boston, MA 02111-1307, USA.                                --
--                                                                          --
-- As a special exception,  if other files  instantiate  generics from this --
-- unit, or you link  this unit with other files  to produce an executable, --
-- this  unit  does not  by itself cause  the resulting  executable  to  be --
-- covered  by the  GNU  General  Public  License.  This exception does not --
-- however invalidate  any other reasons why  the executable file  might be --
-- covered by the  GNU Public License.                                      --
--                                                                          --
-- ASIS-for-GNAT was originally developed  by the ASIS-for-GNAT team at the --
-- Software  Engineering  Laboratory  of  the Swiss  Federal  Institute  of --
-- Technology (LGL-EPFL) in Lausanne,  Switzerland, in cooperation with the --
-- Scientific  Research  Computer  Center of  Moscow State University (SRCC --
-- MSU), Russia,  with funding partially provided  by grants from the Swiss --
-- National  Science  Foundation  and  the  Swiss  Academy  of  Engineering --
-- Sciences.  ASIS-for-GNAT is now maintained by  Ada Core Technologies Inc --
-- (http://www.gnat.com).                                                   --
--                                                                          --
------------------------------------------------------------------------------

with System.Assertions;
with Ada.Exceptions;

with Asis.Exceptions;   use Asis.Exceptions;
with Asis.Declarations; use Asis.Declarations;
with Asis.Elements;     use Asis.Elements;
with Asis.Expressions;  use Asis.Expressions;

with Asis.Set_Get;      use  Asis.Set_Get;
with A4G.A_Sem;         use A4G.A_Sem;
with A4G.A_Debug;       use A4G.A_Debug;
with A4G.A_Types;       use A4G.A_Types;
with A4G.Int_Knds;      use A4G.Int_Knds;
with A4G.Vcheck;        use A4G.Vcheck;
with A4G.Mapping;       use A4G.Mapping;
with A4G.Contt.UT;      use A4G.Contt.UT;
with A4G.A_Output;      use A4G.A_Output;
with A4G.Knd_Conv;      use A4G.Knd_Conv;
with A4G.Asis_Tables;   use A4G.Asis_Tables;

with Types;             use Types;
with Atree;             use Atree;
with Sinfo;             use Sinfo;
with Output;            use Output;
with Einfo;             use Einfo;
with Stand;             use Stand;
with Nlists;            use Nlists;
with Snames;            use Snames;

package body A4G.Expr_Sem is

   LT : String renames ASIS_Line_Terminator;

   -----------------------
   -- Local subprograms --
   -----------------------

   function Explicit_Type_Declaration (Entity_Node : Node_Id) return Node_Id;
   --  Taking the Entity node obtained as a result of some call to Etype
   --  function, this function yields the node for corresponding explicit
   --  type or subtype declaration. This means that this function traverses all
   --  the internal types generated by the compiler.
   --
   --  In case of an anonymous access type, this function returns the entity
   --  node which is created by the compiler for this type (there is no tree
   --  type structure for the type declaration in this case), and a caller is
   --  responsible for further analysis
   --
   --  SHOULD WE MOVE THIS FUNCTION IN THE SPEC???

   function Explicit_Type_Declaration_Unwound
     (Entity_Node    : Node_Id;
      Reference_Node : Node_Id := Empty)
      return Node_Id;
   --  Does the same as Explicit_Type_Declaration and unwinds all the
   --  subtypings (if any), resulting in a root type declaration.
   --  Reference_Node is a node representing a "place" from which this function
   --  is called. If the result type is private, but from the "place" of the
   --  call the full view is visible, the full view is returned. If
   --  Reference_Node is Empty, no private/full view check is made

   function Explicit_Type_Declaration_Unwound_Unaccess
     (Entity_Node    : Node_Id;
      Reference_Node : Node_Id := Empty)
      return Node_Id;
   --  Does the same as Explicit_Type_Declaration_Unwound and in case of access
   --  types goes from the access to the designated type. --???
   --
   --  In case of an anonymous access type returns directly designated type.

   function Rewritten_Image (Selector_Name : Node_Id) return Node_Id;
   --  this is an example of the tricky programming needed because of the
   --  tree rewriting. The problem is, that in the original tree structure
   --  for a record aggregate a N_Identifier node for a component selector
   --  name does not have an Entity field set. So we have to go to the
   --  corresponding (that is, to representing the same component selector
   --  name) node in the rewritten structure.
   --
   --  It is an error to use this function for a node which is does not
   --  represent a component selector name in the original tree structure
   --  for a record aggregate

   function Get_Statement_Identifier (Def_Id : Node_Id) return Node_Id;
   --  For Int_Node which should represent the defining identifier from an
   --  implicit declaration of a label (or a statement name?) (otherwise it
   --  is an error to use this function), this function returns the "defining"
   --  name representing the definition of this statement identifier in the
   --  ASIS sense.

   function GFP_Declaration (Par_Id : Node_Id) return Node_Id;
   --  this is (I hope, temporary) fix for the problem 14: the Entity
   --  field is not set for N_Identifier node representing the parameter
   --  name in a named generic association, so we need this function to
   --  compute the Entity for such an N_Identifier node.
   --  ???   what about formal parameters in associations like
   --  ???           "*" => Some_Function
   --
   --  This function is supposed to be called for an actual representing
   --  the name of a generic formal parameter in a named formal parameter
   --  association (it's an error to call it for any other actual)

   function Is_Explicit_Type_Component
     (Comp_Def_Name : Node_Id;
      Type_Decl     : Node_Id)
      return Boolean;
   --  Expects Comp_Def_Name to be a defining identifier of a record component
   --  and Type_Decl to be a type declaration. Checks if Comp_Def_Name denotes
   --  a component explicitly declared by this type declaration. (This function
   --  is useful for discriminants and components explicitly declared in
   --  derived type declarations.

   function Is_Type_Discriminant
     (Discr_Node : Node_Id;
      Type_Node  : Node_Id)
      return Boolean;
   --  Assuming that Discr_Node is N_Defining_Identifier node and Type_Node
   --  represents a type declaration, this function checks if Discr_Node is
   --  a discriminant of this type (we cannot just use Parent to check this
   --  because of tree rewriting for discriminant types.

   function Full_View_Visible
     (Priv_Type : Node_Id;
      Ref : Node_Id)
      return Boolean;
   --  Assuming that  Priv_Type is a node representing a private type
   --  declaration, checks, that in place of Ref the full view of the type is
   --  visible

   function Reset_To_Full_View
     (Full_View : Node_Id;
      Discr : Node_Id)
      return Node_Id;
   --  Assuming that Full_View is the full type declaration for some private
   --  type and Discr is a defining name of a discriminant of the type
   --  (probably, from its private view), this function returns the defining
   --  name of this discriminant in the full view

   function Is_Part_Of_Defining_Unit_Name (Name_Node : Node_Id) return Boolean;
   --  Assuming that Name_Node is of N_Identifier kind, this function checks,
   --  if it is a part of a defining program unit name

   function Reset_To_Spec (Name_Node : Node_Id) return Node_Id;
   --  Assuming that Name_Node is a part of a defining unit name which in turn
   --  is a part of a compilation unit body (for such nodes Entity field is not
   --  set), this function resets it to the node pointing to the same part of
   --  the defining unit name, but in the spec of the corresponding library
   --  unit

   function Reference_Kind
     (Name            : Asis.Element)
      return            Internal_Element_Kinds;
   --  If Name is of A_Defining_Name kind then this function returns the kind
   --  of An_Expression elements which may be simple-name-form references to
   --  the given name (that is, A_Defining_Identifier -> An_Identifier,
   --  A_Defining_And_Operator -> An_And_Operator), otherwise returns
   --  Not_An_Element. Note, that the result can never be
   --  A_Selected_Component, because only references which are simple names
   --  are considered.

   function Get_Specificed_Component
     (Comp     : Node_Id;
      Rec_Type : Entity_Id)
      return     Entity_Id;
   --  Provided that Comp is the reference to a record component from the
   --  component clause being a component of a record representation clause
   --  for the record type Rec_Type, this function computes the correcponding
   --  component entity

   function Get_Entity_From_Long_Name (N : Node_Id) return Entity_Id;
   --  Supposing that N denotes some component of a long expanded name
   --  and for N and for its prefix the Entity fields are not set, this
   --  function computes the corresponding entity node by traversing
   --  the "chain" of definitions corresponding to this expanded name

   ---------------------------------------
   -- Character_Literal_Name_Definition --
   ---------------------------------------

   function Character_Literal_Name_Definition (Reference_Ch : Element)
      return Asis.Defining_Name
   is
      --  for now, the code is very similar to the code
      --  for Identifier_Name_Definition. Any aggregation has been
      --  put off till everything will work

      Arg_Node         : Node_Id;
      Result_Node      : Node_Id;
      Result_Unit      : Compilation_Unit;
      Special_Case     : Special_Cases          := Not_A_Special_Case;
      Result_Kind      : Internal_Element_Kinds :=
                            A_Defining_Character_Literal;
      Result_Element   : Asis.Defining_Name     := Nil_Element;
      Is_Inherited     : Boolean                := False;
      Association_Type : Node_Id                := Empty;

      Set_Char_Code    : Boolean                := False;
   begin
      --  We have to distinguish and to treat separately four (???)
      --  different situations:
      --
      --  1. a literal from user-defined character type (fully implemented
      --     for now);
      --
      --  2. a literal from a type derived from some user-defined character
      --     type (not implemented for now as related to Implicit Elements);
      --
      --  3. a literal from a character type defined in Standard (not
      --     implemented for now);
      --
      --  4. a literal from a type derived a character type defined in
      --     Standard  (not implemented for now as related to Implicit
      --     Elements);

      Arg_Node := Node (Reference_Ch);

      --  if Reference_Ch is a Selector_Name in some N_Expanded_Name,
      --  the corresponding Entity field is set not for the Node on which
      --  this Reference_En is based, but for the whole expanded name.
      --  (The same for Etype) So:

      if Nkind (Parent (Arg_Node)) = N_Expanded_Name or else
         Nkind (Parent (Arg_Node)) = N_Character_Literal
      then
         --  the last alternative of the condition corresponds to an expanded
         --  name of a predefined character literal or to an expanded name
         --  of a literal of a type derived from a predefined character type -
         --  such an expanded name is rewritten into (another) "instance"
         --  of the same literal
         Arg_Node := Parent (Arg_Node);
      end if;

      Result_Node := Entity (Arg_Node);
      --  will be Empty for any character literal belonging to
      --  Standard.Character, Standard.Whide_Character or any type
      --  derived (directly or indirectly) from any of these types

      Association_Type := Etype (Arg_Node);

      if No (Result_Node)      and then
         No (Association_Type) and then
         Is_From_Unknown_Pragma (R_Node (Reference_Ch))
      then
         return Nil_Element;
      end if;

      if No (Association_Type) then
         --  this may be the case if some character literals are
         --  rewritten into a string constant
         Association_Type := Arg_Node;

         while Present (Association_Type) loop
            exit when Nkind (Association_Type) = N_String_Literal;
            Association_Type := Parent (Association_Type);
         end loop;

         pragma Assert (Present (Association_Type));

         Association_Type := Etype (Association_Type);
         Association_Type := Component_Type (Association_Type);
      end if;

      Association_Type := Explicit_Type_Declaration_Unwound (Association_Type);

      if No (Result_Node) then
         Set_Char_Code := True;
         Result_Node   := Association_Type;
         Result_Node   := Sinfo.Type_Definition (Result_Node);

         if Char_Defined_In_Standard (Arg_Node) then
            Special_Case := Stand_Char_Literal;
         else
            Is_Inherited := True;
         end if;

      elsif not Comes_From_Source (Result_Node) then
         Is_Inherited := True;
      end if;

      if Char_Defined_In_Standard (Arg_Node) then
         Result_Unit  := Get_Comp_Unit
                           (Standard_Id, Encl_Cont_Id (Reference_Ch));
      else
         Result_Unit := Enclosing_Unit
                          (Encl_Cont_Id (Reference_Ch), Result_Node);
      end if;

      Result_Element := Node_To_Element_New
                          (Node          => Result_Node,
                           Node_Field_1  => Association_Type,
                           Internal_Kind => Result_Kind,
                           Spec_Case     => Special_Case,
                           Inherited     => Is_Inherited,
                           In_Unit       => Result_Unit);

      if Set_Char_Code then
         Set_Character_Code (Result_Element, Character_Code (Reference_Ch));
      end if;

      return Result_Element;

   exception
       when Assert_Error : System.Assertions.Assert_Failure =>
         Raise_ASIS_Failed (
            Argument  => Reference_Ch,
            Diagnosis =>
                "A4G.Expr_Sem.Character_Literal_Name_Definition - "  & LT
              & "Assert_Failure at "
              &  Ada.Exceptions.Exception_Message (Assert_Error));
      when ASIS_Failed =>
         Add_Call_Information (
            Argument   => Reference_Ch,
            Outer_Call => "A4G.Expr_Sem.Character_Literal_Name_Definition");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Reference_Ch,
            Diagnosis => "A4G.Expr_Sem.Character_Literal_Name_Definition");
   end Character_Literal_Name_Definition;

   ---------------------------------
   -- Collect_Overloaded_Entities --
   ---------------------------------

   procedure Collect_Overloaded_Entities (Reference : Asis.Element) is
      Arg_Node               : Node_Id;
      Arg_Pragma_Chars       : Name_Id;

      Next_Entity            : Entity_Id;
      Result_Unit            : Asis.Compilation_Unit;
      Result_Context         : Context_Id := Encl_Cont_Id (Reference);

      Res_Node               : Node_Id;
      Res_NF_1               : Node_Id;
      Res_Ekind              : Entity_Kind;
      Res_Inherited          : Boolean;

      Is_Program_Unit_Pragma : Boolean := False;
      Enclosing_Scope_Entity : Entity_Id;
      Enclosing_List         : List_Id;

      function Should_Be_Collected (Ent : Entity_Id) return Boolean;
      --  When traversinh the chain of homonyms potentially referred by
      --  Reference, it checks if Ent should be used to create the next
      --  Element in the Result list

      function Should_Be_Collected (Ent : Entity_Id) return Boolean is
         Result : Boolean := False;
         N      : Node_Id;
      begin

         if not (Ekind (Ent) = E_Operator and then
                 Is_Predefined (Ent))
         then

            if Is_Program_Unit_Pragma then
               Result := Scope (Ent) = Enclosing_Scope_Entity;
            else
               N := Parent (Ent);

               while Present (N) and then
                     not (Is_List_Member (N))
               loop
                  N := Parent (N);
               end loop;

               if Present (N) and then Is_List_Member (N) then
                  Result := List_Containing (N) = Enclosing_List;
               end if;

            end if;

         end if;

         return Result;
      end Should_Be_Collected;

   begin
      --  First, we decide what kind of pragma we have, because the search
      --  depends on this:
      Arg_Node         := Node (Reference);
      Arg_Pragma_Chars := Chars (Parent (Parent (Arg_Node)));

      if Arg_Pragma_Chars = Name_Inline then
         Is_Program_Unit_Pragma := True;
         --  ??? is it enough? what about GNAT-specific pragmas?
         --  In this case we have to search in the same declarative regiom
         --  (in the same scope):
         Enclosing_Scope_Entity := Scope (Entity (Arg_Node));
         --  This is no more than a trick: actually, we have to compute
         --  the scope node for the declarative region which encloses
         --  Arg_Node, but entry bodies makes a serious problem (at the
         --  moment of writting this code there is no semantic links between
         --  protected entry declarations and bodies). So we just assume
         --  that Arg_Node has the Entity field set, and this field
         --  points to some correct  (from the point of view of
         --  Corresponding_Name_Definition_List query) entity, so we
         --  just take the Scope of this entity...

      else
         Enclosing_List := List_Containing (Parent (Parent (Arg_Node)));
      end if;

      Next_Entity := Entity (Arg_Node);

      while Present (Next_Entity) and then
            Should_Be_Collected (Next_Entity)
      loop

         Result_Unit := Enclosing_Unit (Result_Context, Next_Entity);

         Res_Ekind   := Ekind (Next_Entity);
         pragma Assert (Res_Ekind in Subprogram_Kind);

         if Comes_From_Source (Next_Entity) then
            Res_Node      := Next_Entity;
            Res_NF_1      := Empty;
            Res_Inherited := False;
         else
            Res_Node := Alias (Next_Entity);

            while Present (Alias (Res_Node)) loop
               Res_Node := Alias (Res_Node);
            end loop;

            Res_NF_1      := Next_Entity;
            Res_Inherited := True;
         end if;

         Asis_Element_Table.Append
           (Node_To_Element_New (Node          => Res_Node,
                                 Node_Field_1  => Res_NF_1,
                                 Inherited     => Res_Inherited,
                                 In_Unit       => Result_Unit));

         Next_Entity := Homonym (Next_Entity);
      end loop;

   end Collect_Overloaded_Entities;

   -------------------------------
   -- Explicit_Type_Declaration --
   -------------------------------

   function Explicit_Type_Declaration (Entity_Node : Node_Id) return Node_Id
   is
      Next_Node   : Node_Id;
      Result_Node : Node_Id;
      Res_Ekind   : Entity_Kind;

      function Is_Explicit_Type_Declaration
        (Type_Entity_Node : Node_Id)
         return Boolean;
      --  checks if Type_Entity_Node corresponds to the explicit type
      --  declaration which is looked for (that is, the needed type declaration
      --  node is Parent (Type_Entity_Node) )

      function Is_Explicit_Type_Declaration
        (Type_Entity_Node : Node_Id)
         return Boolean
      is
         Type_Decl_Node  : Node_Id := Parent (Type_Entity_Node);
         Type_Decl_Nkind : Node_Kind;

         Is_Full_Type_Decl    : Boolean := False;
         Is_Derived_Type_Decl : Boolean := False;
         Is_Formal_Type_Decl  : Boolean := False;
      begin

         if Present (Type_Decl_Node) then

            Is_Full_Type_Decl :=
               Comes_From_Source (Type_Decl_Node) and then
               (not Is_Rewrite_Substitution (Type_Decl_Node));

            if not Is_Full_Type_Decl and then
               Is_Rewrite_Substitution (Type_Decl_Node)
            then
               --  The second part of the condition is common for all the cases
               --  which require special analysis

               Type_Decl_Nkind := Nkind (Type_Decl_Node);

               Is_Derived_Type_Decl :=
                 (Type_Decl_Nkind = N_Subtype_Declaration   or else
                  Type_Decl_Nkind = N_Full_Type_Declaration or else
                  Type_Decl_Nkind = N_Formal_Type_Declaration)
                 and then
                (Nkind (Original_Node (Type_Decl_Node)) =
                    N_Full_Type_Declaration and then
                 Nkind (Sinfo.Type_Definition (Original_Node (Type_Decl_Node)))
                    = N_Derived_Type_Definition);

               if not Is_Derived_Type_Decl then

                  Is_Formal_Type_Decl :=
                      (Type_Decl_Nkind = N_Private_Extension_Declaration
                      or else
                       Type_Decl_Nkind = N_Full_Type_Declaration)
                     and then
                  Nkind (Original_Node (Type_Decl_Node)) =
                     N_Formal_Type_Declaration;

               end if;

            end if;

         end if;

         return Is_Full_Type_Decl    or else
                Is_Derived_Type_Decl or else
                Is_Formal_Type_Decl;

      end Is_Explicit_Type_Declaration;

   begin
      --  well, here we have a (sub)type entity node passed as an actual...
      --  the aim is to return the _explicit_ type declaration corresponding
      --  to this (sub)type entity. It should be such a declaration, if this
      --  function is called...
      --
      --  We try to organize the processing in a recursive way - may be,
      --  not the most effective one, but easy-to maintain

      if Is_Explicit_Type_Declaration (Entity_Node) then
         --  the first part of the condition is the protection from
         --  non-accurate settings of Comes_From_Source flag :((
         Result_Node := Parent (Entity_Node);

      elsif Sloc (Entity_Node) <= Standard_Location then
         --  here we have a predefined type declared in Standard.
         --  it may be the type entity or the entity for its 'Base
         --  type. In the latter case we have to go to the type
         --  entity

         if Present (Parent (Entity_Node)) then
            --  type entity, therefore simply
            Result_Node := Parent (Entity_Node);
         else
            --  'Base type, so we have to compute the first named
            --  type. The code which does it looks tricky, but for now we
            --  do not know any better solution:
            Result_Node := Parent (Parent (Scalar_Range (Entity_Node)));
         end if;

      elsif Etype (Entity_Node) = Entity_Node                 and then
            Present (Associated_Node_For_Itype (Entity_Node)) and then
            Nkind (Associated_Node_For_Itype (Entity_Node)) =
               N_Object_Declaration
      then
         --  this corresponds to an anonymous array subtype created by an
         --  object declaration with array_type_definition
         Result_Node := Empty;

      else
         --  Entity_Node corresponds to some internal or implicit type created
         --  by the compiler. Here  we have to traverse the tree till the
         --  explicit type declaration being the cause for generating this
         --  implicit type will be found

         Res_Ekind := Ekind (Entity_Node);

         if Res_Ekind = E_Anonymous_Access_Type then
            --  There is no type declaration node in this case at all,
            --  so we just return this N_Defining_Identifier node for
            --  further analysis in the calling context:
            return Entity_Node;

         elsif Res_Ekind = E_String_Literal_Subtype then
            --  this is a special case, see Einfo (spec), the definition of
            --  E_String_Literal_Subtype
            Result_Node := Parent (Etype (Entity_Node));

            if No (Result_Node) then
               Result_Node := Associated_Node_For_Itype (Etype (Entity_Node));
            end if;


         elsif Ekind (Entity_Node) = E_Enumeration_Type then

            if Present (Associated_Node_For_Itype (Entity_Node)) then
               Result_Node := Associated_Node_For_Itype (Entity_Node);
            else
               --  Entity_Node represents an implicit type created for
               --  a derived enumeration type. we have to go down to this
               --  derived type
               Result_Node := Parent (Entity_Node);

               while Present (Result_Node) loop
                  Result_Node := Next (Result_Node);

                  exit when (Nkind (Result_Node) = N_Subtype_Declaration
                            and then
                             Is_Rewrite_Substitution (Result_Node));
               end loop;

            end if;

            pragma Assert (Present (Result_Node));

         elsif  (No (Parent (Entity_Node)) or else
                 not Comes_From_Source (Parent (Entity_Node)))
               and then
                 Etype (Entity_Node) /= Entity_Node
               and then
                 not (Ekind (Entity_Node) = E_Floating_Point_Type or else
                      Ekind (Entity_Node) = E_Signed_Integer_Type or else
                      Ekind (Entity_Node) = E_Array_Type          or else
                      Ekind (Entity_Node) = E_Private_Type)
         then

            pragma Assert
              (Ekind (Entity_Node) = E_Array_Subtype or else
               Ekind (Entity_Node) = E_Record_Subtype or else
               Ekind (Entity_Node) = E_Record_Subtype_With_Private or else
               Ekind (Entity_Node) = E_Protected_Subtype or else
               Ekind (Entity_Node) = E_Task_Subtype or else
               Ekind (Entity_Node) = E_Record_Type or else
               Ekind (Entity_Node) = E_Signed_Integer_Subtype or else
               Ekind (Entity_Node) = E_Modular_Integer_Subtype or else
               Ekind (Entity_Node) = E_Enumeration_Subtype or else
               Ekind (Entity_Node) = E_Floating_Point_Subtype or else
               Ekind (Entity_Node) = E_Access_Subtype or else
               Ekind (Entity_Node) = E_Access_Type or else  --  ???
               Ekind (Entity_Node) = E_Ordinary_Fixed_Point_Subtype or else
               Ekind (Entity_Node) = E_Limited_Private_Subtype or else
               Ekind (Entity_Node) = E_Private_Subtype); --  ???
            --  subtypes created for objects when an explicit constraint
            --  presents in the object declaration ???
            Result_Node := Explicit_Type_Declaration (Etype (Entity_Node));

         else

            Next_Node := Associated_Node_For_Itype (Entity_Node);

            pragma Assert (Present (Next_Node));

            if Nkind (Original_Node (Next_Node)) = N_Full_Type_Declaration
               or else
               Nkind (Original_Node (Next_Node)) = N_Formal_Type_Declaration
            then
               Result_Node := Next_Node;

            elsif Nkind (Next_Node) = N_Loop_Parameter_Specification then
               --  here we have to traverse the loop parameter specification,
               --  because otherwise we may get the base type instead of
               --  the actually needed named subtype.
               Result_Node := Next_Node;
               Result_Node := Sinfo.Discrete_Subtype_Definition (Result_Node);

               case Nkind (Result_Node) is

                  when N_Subtype_Indication =>
                     Result_Node := Sinfo.Subtype_Mark (Result_Node);
                     Result_Node := Parent (Entity (Result_Node));

                  when N_Identifier | N_Expanded_Name =>
                     Result_Node := Parent (Entity (Result_Node));

                  when N_Range =>
                     --  and here we have to use the Etype field of
                     --  the implicit type itself, because we do not have
                     --  any type mark to start from in the loop parameter
                     --  specification:
                     Result_Node := Explicit_Type_Declaration
                                      (Etype (Entity_Node));
                  when others =>
                     null;
                     pragma Assert (False);
                     --  this is definitely wrong! Should be corrected
                     --  during debugging!!!
               end case;

            else

               if Etype (Entity_Node) /= Entity_Node then
                  --  otherwise we will be in dead circle
                  Result_Node := Etype (Entity_Node);
                  Result_Node := Explicit_Type_Declaration (Result_Node);

               else
                  --  for now, the only guess is that we have an object
                  --  defined by an object declaration with constrained
                  --  array definition, or an initialization expression
                  --  from such a declaration
                  pragma Assert (
                     Nkind (Next_Node) = N_Object_Declaration and then
                     Nkind (Object_Definition (Next_Node)) =
                        N_Constrained_Array_Definition);
                  return Empty;
                  --  what else could we return here?
               end if;

            end if;

         end if;

      end if;

      return Result_Node;

   exception
      when Assert_Error : System.Assertions.Assert_Failure =>
         Raise_ASIS_Failed (
            Argument  => Nil_Element,
            Diagnosis =>
               "A4G.Expr_Sem.Explicit_Type_Declaration - "  & LT
             & "Assert_Failure at "
             &  Ada.Exceptions.Exception_Message (Assert_Error));
      when others =>
         Raise_ASIS_Failed (
            Argument  => Nil_Element,
            Diagnosis => "A4G.Expr_Sem.Explicit_Type_Declaration");
   end Explicit_Type_Declaration;

   ---------------------------------------
   -- Explicit_Type_Declaration_Unwound --
   ---------------------------------------

   function Explicit_Type_Declaration_Unwound
     (Entity_Node    : Node_Id;
      Reference_Node : Node_Id := Empty)
      return Node_Id
   is
      Result_Node       : Node_Id;
      Subtype_Mark_Node : Node_Id;
   begin

      Result_Node := Explicit_Type_Declaration (Entity_Node);

      while Nkind (Original_Node (Result_Node)) = N_Subtype_Declaration loop
         Subtype_Mark_Node :=
            Sinfo.Subtype_Indication (Original_Node (Result_Node));

         if Nkind (Subtype_Mark_Node) = N_Subtype_Indication then
            Subtype_Mark_Node := Sinfo.Subtype_Mark (Subtype_Mark_Node);
         end if;

         Result_Node := Explicit_Type_Declaration (Entity (Subtype_Mark_Node));
      end loop;

      if Present (Reference_Node) and then
         (Nkind (Original_Node (Result_Node)) = N_Private_Type_Declaration
         or else
          Nkind (Original_Node (Result_Node)) =
             N_Private_Extension_Declaration)
        and then
          Full_View_Visible (Result_Node, Reference_Node)
      then
         Result_Node := Parent (Full_View (Defining_Identifier (Result_Node)));
      end if;

      return Result_Node;

   end Explicit_Type_Declaration_Unwound;

   ------------------------------------------------
   -- Explicit_Type_Declaration_Unwound_Unaccess --
   ------------------------------------------------

   function Explicit_Type_Declaration_Unwound_Unaccess
     (Entity_Node    : Node_Id;
      Reference_Node : Node_Id := Empty)
      return Node_Id
   is
      Result_Node       : Node_Id;
      Subtype_Mark_Node : Node_Id;
   begin

      Result_Node := Explicit_Type_Declaration_Unwound (
                        Entity_Node, Reference_Node);

      if Nkind (Result_Node) = N_Defining_Identifier and then
         Ekind (Result_Node) = E_Anonymous_Access_Type
      then

         Result_Node := Explicit_Type_Declaration_Unwound (
            Directly_Designated_Type (Result_Node), Reference_Node);
      end if;

      while (Nkind (Original_Node (Result_Node)) = N_Full_Type_Declaration
             and then
             Nkind (Sinfo.Type_Definition (Original_Node (Result_Node))) =
             N_Access_To_Object_Definition)
          or else
            (Nkind (Original_Node (Result_Node)) = N_Formal_Type_Declaration
             and then
             Nkind (Sinfo.Formal_Type_Definition (Original_Node (
                Result_Node))) = N_Access_To_Object_Definition)
      loop
         Subtype_Mark_Node := Original_Node (Result_Node);

         if Nkind (Subtype_Mark_Node) = N_Full_Type_Declaration then
            Subtype_Mark_Node := Sinfo.Subtype_Indication (
               Sinfo.Type_Definition (Subtype_Mark_Node));
         else
            Subtype_Mark_Node := Sinfo.Subtype_Indication (
               Sinfo.Formal_Type_Definition (Subtype_Mark_Node));
         end if;

         if Nkind (Subtype_Mark_Node) = N_Subtype_Indication then
            Subtype_Mark_Node := Sinfo.Subtype_Mark (Subtype_Mark_Node);
         end if;

         Result_Node := Explicit_Type_Declaration_Unwound (
            Entity (Subtype_Mark_Node), Reference_Node);
      end loop;

      return Result_Node;

   end Explicit_Type_Declaration_Unwound_Unaccess;

   ---------------
   -- Expr_Type --
   ---------------

   function Expr_Type (Expression : Asis.Expression) return Asis.Declaration
   is
      Arg_Node      : Node_Id;
      Arg_Kind      : Internal_Element_Kinds := Int_Kind (Expression);
      Result_Entity : Node_Id;
      Result_Node   : Node_Id;
      Result_Unit   : Compilation_Unit;
      Special_Case  : Special_Cases          := Not_A_Special_Case;
      Encl_Cont     : Context_Id             := Encl_Cont_Id (Expression);
   begin
      --  first, we should check whether Expression has a universal
      --  numeric type and return the corresponding ASIS universal type.
      --  For now, this check includes numeric literals and some of the
      --  attribute references is:
      if Arg_Kind = An_Integer_Literal or else
         Arg_Kind = An_Alignment_Attribute or else
         Arg_Kind = A_Component_Size_Attribute or else
         Arg_Kind = A_Digits_Attribute or else
         Arg_Kind = A_Count_Attribute or else
         Arg_Kind = An_Exponent_Attribute or else
         Arg_Kind = A_First_Bit_Attribute or else
         Arg_Kind = A_Fore_Attribute or else
         Arg_Kind = A_Last_Bit_Attribute or else
         Arg_Kind = A_Length_Attribute or else
         Arg_Kind = A_Machine_Emax_Attribute or else
         Arg_Kind = A_Machine_Emin_Attribute or else
         Arg_Kind = A_Machine_Mantissa_Attribute or else
         Arg_Kind = A_Machine_Radix_Attribute or else
         Arg_Kind = A_Max_Size_In_Storage_Elements_Attribute or else
         Arg_Kind = A_Model_Emin_Attribute or else
         Arg_Kind = A_Model_Mantissa_Attribute or else
         Arg_Kind = A_Modulus_Attribute or else
         Arg_Kind = A_Partition_ID_Attribute or else
         Arg_Kind = A_Pos_Attribute or else
         Arg_Kind = A_Position_Attribute or else
         Arg_Kind = A_Scale_Attribute or else
         Arg_Kind = A_Size_Attribute or else
         Arg_Kind = A_Storage_Size_Attribute or else
         Arg_Kind = A_Wide_Width_Attribute or else
         Arg_Kind = A_Width_Attribute
      then
         return Set_Root_Type_Declaration
                  (A_Universal_Integer_Definition,
                   Encl_Cont);
      elsif Arg_Kind = A_Real_Literal or else
            Arg_Kind = A_Delta_Attribute or else
            Arg_Kind = A_Model_Epsilon_Attribute or else
            Arg_Kind = A_Model_Small_Attribute or else
            Arg_Kind = A_Safe_First_Attribute or else
            Arg_Kind = A_Safe_Last_Attribute or else
            Arg_Kind = A_Small_Attribute
      then
         return Set_Root_Type_Declaration
                  (A_Universal_Real_Definition,
                   Encl_Cont);
      end if;

      Arg_Node      := Node (Expression);

      --  In some cases we have to use the rewritten node
      if Is_Rewrite_Substitution (R_Node (Expression)) and then
         (Nkind (Arg_Node) = N_Aggregate and then
          Nkind (R_Node (Expression)) = N_String_Literal)
      then
         Arg_Node := R_Node (Expression);
      end if;


      --  if the expression node is rewritten, all the semantic
      --  information can be found only through the rewritten node

      if Nkind (Parent (Arg_Node)) = N_Expanded_Name and then
         Arg_Node = Selector_Name (Parent (Arg_Node))
      then
         --  selector in an expanded name - all the semantic fields
         --  are set for the whole name, but not for this selector.
         --  So:
         Arg_Node := Parent (Arg_Node);
      end if;

--  ??? <tree problem 1>
--  this fragment should be revised when the problem is fixed (as it should)
      if Nkind (Arg_Node) = N_Selected_Component then
         if Etype (Arg_Node) = Any_Type then
            --  for now (GNAT 3.05) this means, that Expression is an expanded
            --  name of the character literal of ether a predefined character
            --  type or of the type derived from a predefined character type
            Arg_Node := R_Node (Expression);
            --  resetting Arg_Node pointing to the rewritten node for the
            --  expanded name
            --
            --  ???
            --  This looks strange... Should be revised
         else
            Arg_Node := Selector_Name (Arg_Node);
            --  here the actual type is!
         end if;
      elsif Nkind (Arg_Node) = N_Character_Literal and then
            No (Etype (Arg_Node))
            --  for now (GNAT 3.05) this means, that Expression is the
            --  selector in an expanded name of the character literal of
            --  ether a predefined character type or of the type derived
            --  from a predefined character type
      then
         Arg_Node := Parent (Arg_Node);
         --  resetting Arg_Node pointing to the rewritten node for the whole
         --  expanded name
      end if;
--  ??? <tree problem 1> - end

      --  now the idea is to take the Etype attribute of the expression
      --  and to go to the corresponding type declaration. But
      --  special processing for computing the right Etype is
      --  required for some cases
      if Nkind (Parent (Arg_Node)) = N_Qualified_Expression and then
         Arg_Node = Sinfo.Expression (Parent (Arg_Node))
      then
         Result_Entity := Etype (Sinfo.Subtype_Mark (Parent (Arg_Node)));

         --  we'll keep the commented code below for a while...
--      elsif (Arg_Kind = A_First_Attribute or else
--             Arg_Kind = A_Last_Attribute)
--          and then not Comes_From_Source (Etype (Arg_Node))
--          and then Sloc (Etype (Arg_Node)) > Standard_Location
--          and then Etype (Etype (Arg_Node)) = Etype (Arg_Node)
--      then
--         --  this tricky condition corresponds to the situation, when
--         --  'First or 'Last attribute is applied to a formal discrete
--         --  type @:-(
--         --  In this case we simply use the attribute prefix to define
--         --  the result type
--         Result_Entity := Etype (Prefix (Arg_Node));
      else
         --  how nice it would be if *everything* would be so simple
         Result_Entity := Etype (Arg_Node);
      end if;

      Result_Node := Explicit_Type_Declaration (Result_Entity);

      if No (Result_Node) then
         return Nil_Element;
         --  we cannot represent the type declaration in ASIS;
         --  for example, an object defined by an object declaration
         --  with constrained array definition
      end if;

      if Sloc (Result_Entity) <= Standard_Location then
         Result_Unit :=  Get_Comp_Unit
                           (Standard_Id, Encl_Cont_Id (Expression));
         Special_Case   := Explicit_From_Standard;
      else
         Result_Unit := Enclosing_Unit
                          (Encl_Cont_Id (Expression), Result_Node);
      end if;

      return Node_To_Element_New (Node          => Result_Node,
                                  Spec_Case     => Special_Case,
                                  In_Unit       => Result_Unit);
   exception
      when Assert_Error : System.Assertions.Assert_Failure =>
         Raise_ASIS_Failed (
            Argument  => Expression,
            Diagnosis => "A4G.Expr_Sem.Expr_Type - "  & LT
                       & "Assert_Failure at "
                       &  Ada.Exceptions.Exception_Message (Assert_Error));
      when ASIS_Failed =>
         Add_Call_Information (
            Argument   => Expression,
            Outer_Call => "A4G.Expr_Sem.Expr_Type");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Expression,
            Diagnosis => "A4G.Expr_Sem.Expr_Type");
   end Expr_Type;

   -----------------------
   -- Full_View_Visible --
   -----------------------


   function Full_View_Visible
     (Priv_Type : Node_Id;
      Ref : Node_Id)
      return Boolean
   is
      Type_Scope      : Node_Id := Scope (Defining_Identifier (Priv_Type));
      Type_Scope_Body : Node_Id;
      Type_Full_View  : Node_Id;
      Scope_Node      : Node_Id := Empty;
      Next_Node       : Node_Id := Parent (Ref);
      Next_Node_Inner : Node_Id := Ref;

      Result          : Boolean := False;

   begin
      Type_Scope_Body := Parent (Type_Scope);

      if Nkind (Type_Scope_Body) = N_Defining_Program_Unit_Name then
         Type_Scope_Body := Parent (Type_Scope_Body);
      end if;

      Type_Scope_Body := Corresponding_Body (Parent (Type_Scope_Body));

      if Nkind (Parent (Type_Scope_Body)) = N_Defining_Program_Unit_Name then
         Type_Scope_Body := Parent (Type_Scope_Body);
      end if;


      while Present (Next_Node) loop

         if  (Nkind (Next_Node) = N_Package_Specification and then
              Defining_Unit_Name (Next_Node) = Type_Scope)
            or else
             (Nkind (Next_Node) = N_Package_Body and then
             Defining_Unit_Name (Next_Node) = Type_Scope_Body)
         then
            Scope_Node := Next_Node;
            exit;
         end if;

         Next_Node_Inner := Next_Node;
         Next_Node := Parent (Next_Node);

      end loop;

      if Present (Scope_Node) then

         if Nkind (Scope_Node) = N_Package_Body then
            Result := True;

         elsif List_Containing (Next_Node_Inner) =
               Private_Declarations (Scope_Node)
         then
            --  That is, Ref is in the private part of the package where
            --  Priv_Type is declared, and we have to check what goes first:
            --  Ref (or a construct it is enclosed into - it is pointed by
            --  Next_Node_Inner) or the full view of the private type:

            Type_Full_View := Parent (Full_View
              (Defining_Identifier (Priv_Type)));

            Next_Node := First_Non_Pragma (Private_Declarations (Scope_Node));

            while Present (Next_Node) loop

               if Next_Node = Type_Full_View then
                  Result := True;
                  exit;
               elsif Next_Node = Next_Node_Inner then
                  exit;
               else
                  Next_Node := Next_Non_Pragma (Next_Node);
               end if;

            end loop;

         end if;

      end if;

      return Result;

   end Full_View_Visible;

   -------------------------------
   -- Get_Entity_From_Long_Name --
   -------------------------------

   function Get_Entity_From_Long_Name (N : Node_Id) return Entity_Id is
      Result      : Entity_Id := Empty;
      Arg_Chars   : Name_Id := Chars (N);
      Res_Chars   : Name_Id;

      P           : Node_Id;
      Next_Entity : Entity_Id;
   begin

      P := Parent (N);

      while No (Entity (P)) loop
         P := Parent (P);
      end loop;

      Next_Entity := Entity (P);
      Res_Chars   := Chars (Next_Entity);

      loop

         if Res_Chars = Arg_Chars then
            Result := Next_Entity;
            exit;
         end if;

         if Nkind (Parent (Next_Entity)) = N_Defining_Program_Unit_Name then
            P := Sinfo.Name (Parent (Next_Entity));
            Next_Entity := Entity (P);
            Res_Chars   := Chars (Next_Entity);
         else
            exit;
         end if;

      end loop;

      pragma Assert (Present (Result));

      return Result;
   end Get_Entity_From_Long_Name;

   ------------------------------
   -- Get_Specificed_Component --
   ------------------------------

   function Get_Specificed_Component
     (Comp     : Node_Id;
      Rec_Type : Entity_Id)
      return     Entity_Id
   is
      Rec_Type_Entity : Entity_Id;

      Result          : Entity_Id := Empty;
      Res_Chars       : Name_Id := Chars (Comp);
      Next_Comp       : Node_Id;

   begin

      if Ekind (Rec_Type) = E_Private_Type then
         Rec_Type_Entity := Full_View (Rec_Type);
      else
         Rec_Type_Entity := Rec_Type;
      end if;

      Next_Comp := First_Entity (Rec_Type_Entity);

      while Present (Next_Comp) loop

         if Chars (Next_Comp) = Res_Chars then
            Result := Next_Comp;
            exit;
         end if;

         Next_Comp := Next_Entity (Next_Comp);

      end loop;

      pragma Assert (Present (Result));

      return Result;
   end Get_Specificed_Component;

   ------------------------------
   -- Get_Statement_Identifier --
   ------------------------------

   function Get_Statement_Identifier (Def_Id : Node_Id) return Node_Id is
      Result_Node  : Node_Id := Empty;
      --  List_Elem    : Node_Id;
   begin
      Result_Node := Label_Construct (Parent (Def_Id));

      if not (Nkind (Result_Node) = N_Label) then
         --  this means, that Result_Node is of N_Block_Statement or
         --  of N_Loop_Statement kind, therefore
         Result_Node := Sinfo.Identifier (Result_Node);
      end if;

      return Result_Node;

   end Get_Statement_Identifier;

   ---------------------
   -- GFP_Declaration --
   ---------------------

   function GFP_Declaration (Par_Id : Node_Id) return Node_Id is
      Par_Chars    : Name_Id := Chars (Par_Id);
      Result_Node  : Node_Id;
      Gen_Par_Decl : Node_Id;
   begin
      --  First, going up to the generic instantiation itself:
      Result_Node := Parent (Parent (Par_Id));
      --  then taking the name of the generic unit being instantiated
      --  and going to its definition - and declaration:
      Result_Node := Parent (Parent (Entity (Sinfo.Name (Result_Node))));
      --  and now - searching the declaration of the corresponding
      --  generic parameter:
      Gen_Par_Decl :=
         First_Non_Pragma (Generic_Formal_Declarations (Result_Node));

      while Present (Gen_Par_Decl) loop

         if Nkind (Gen_Par_Decl) = N_Formal_Subprogram_Declaration then
            Result_Node := Defining_Unit_Name (Specification (Gen_Par_Decl));
         else
            Result_Node := Defining_Identifier (Gen_Par_Decl);
         end if;

         if Chars (Result_Node) = Par_Chars then
            exit;
         else
            Gen_Par_Decl := Next_Non_Pragma (Gen_Par_Decl);
         end if;

      end loop;

      return Result_Node;

   end GFP_Declaration;

   --------------------------------
   -- Identifier_Name_Definition --
   --------------------------------

   function Identifier_Name_Definition (Reference_I : Element)
      return Asis.Defining_Name
   is
      Arg_Node         : Node_Id;
      Arg_Kind         : Internal_Element_Kinds := Int_Kind (Reference_I);
      Arg_Node_Kind    : Node_Kind;
      Result_Node      : Node_Id                := Empty;
      Result_Unit      : Compilation_Unit;
      Special_Case     : Special_Cases          := Not_A_Special_Case;
      Result_Kind      : Internal_Element_Kinds := Not_An_Element;
      Is_Inherited     : Boolean                := False;
      Association_Type : Node_Id                := Empty;
      --  ??? Is it a good name for a parameter?
      Componnet_Name   : Node_Id                := Empty;

      Tmp_Node         : Node_Id;
   begin
      --  this function is currently integrated with
      --  Enumeration_Literal_Name_Definition and
      --  Operator_Symbol_Name_Definition

      --  The implementation approach is very similar to that one of
      --  A4G.A_Sem.Get_Corr_Called_Entity. Now the implicit *predefined*
      --  operations are turned off for a while

      ------------------------------------------------------------------
      --  1. Defining Result_Node (and adjusting Arg_Node, if needed) --
      ------------------------------------------------------------------

      if Arg_Kind = An_Identifier then
         Result_Kind := A_Defining_Identifier;
         --  may be changed to A_Defining_Expanded_Name later
      elsif Arg_Kind = An_Enumeration_Literal then
         Result_Kind := A_Defining_Enumeration_Literal;
      elsif Arg_Kind in Internal_Operator_Symbol_Kinds then
         Result_Kind := Def_Operator_Kind (Int_Kind (Reference_I));
      end if;

      Arg_Node := Get_Actual_Type_Name (Node (Reference_I));

      --  the code below is really awful! In some future we'll have
      --  to revise this "patch on patch" approach!!!

      if Is_Part_Of_Defining_Unit_Name (Arg_Node) and then
         Kind (Encl_Unit (Reference_I)) in A_Library_Unit_Body
      then
         --  this means, that we have a part of a prefix of a defining
         --  unit name which is a part of a body. These components do not
         --  have Entity field set, so we have to go to the spec:

         Arg_Node := Reset_To_Spec (Arg_Node);

      end if;

      if Nkind (Arg_Node) in N_Entity then
         --  This is the case of the reference to a formal type inside
         --  the expanded code when the actual type is a derived type
         --  In this case Get_Actual_Type_Name returns the entity node
         --  (see 8924-006)

         Result_Node := Arg_Node;
         Arg_Node    := Node (Reference_I);
         --  For the rest of the processing we need Arg_Node properly set as
         --  the reference, but not as an entity node

      elsif No (Entity (Arg_Node)) then

         Arg_Node_Kind := Nkind (Parent (Arg_Node));

         --  in some cases we can try to "repair" the situation:

         if Arg_Node_Kind = N_Expanded_Name then
            --  the Entity field is set for the whole expanded name:
            if Present (Entity (Parent (Arg_Node))) then
               Arg_Node := Parent (Arg_Node);
            else
               --  Trying to "traverse a "long" defining program unit
               --  name (see 7917-005)
               Result_Node := Get_Entity_From_Long_Name (Arg_Node);
            end if;

         elsif Arg_Node_Kind = N_Unconstrained_Array_Definition and then
               Sloc (Arg_Node) = Standard_Location
         then
            --  Special case of Subtype_Indication for predefined String
            --  and Wide_String types:

            Result_Node := Parent (Parent (Arg_Node));
            --  Here we are in N_Full_Type_Declaration node
            Result_Node := Defining_Identifier (Result_Node);
            Result_Node := Component_Type (Result_Node);

            Special_Case := Explicit_From_Standard;

         elsif Arg_Node_Kind = N_Function_Call then
            --  this is a special case of a parameterless function call
            --  of the form P.F
            Arg_Node := Sinfo.Name (Parent (Arg_Node));

         elsif Arg_Node_Kind = N_Integer_Literal   or else
               Arg_Node_Kind = N_Real_Literal      or else
               Arg_Node_Kind = N_Character_Literal or else
               Arg_Node_Kind = N_String_Literal    or else
               Arg_Node_Kind = N_Identifier
         then
            --  All but last conditios are a result of some compile-time
            --  optimization. The last one is a kind of
            --  semantically-transparent transformation which loses some
            --  semantic information for replaced structures (see the test
            --  for 9429-006).
            --
            --  The last condition may need some more attention in case if new
            --  Corresponding_Name_Definition problems are detected

            Arg_Node := Original_Node (Parent (Arg_Node));

         elsif Arg_Node_Kind = N_Component_Association and then
               Nkind (Sinfo.Expression (Parent (Arg_Node))) =
               N_Raise_Constraint_Error
         then
            --  here we are guessing for the situation when a compiler
            --  optimization take place. We can probably be non-accurate
            --  for inherited record components, but what can we do....
            --
            --  first, defining the corresponding Entity Node, we assume
            --  it to be a record component definition
            Result_Node := Sinfo.Expression (Parent (Arg_Node));
            Result_Node := Etype (Result_Node);
            Result_Node := Associated_Node_For_Itype (Result_Node);
            Result_Node := Sinfo.Defining_Identifier (Result_Node);
            pragma Assert (
               Ekind (Result_Node) = E_Component or else
               Ekind (Result_Node) = E_Discriminant);

            --  Now, computing the type to which this component belongs:
            Association_Type := Parent (Parent (Arg_Node));
            --  Here Association_Type should also be of
            --  N_Raise_Constraint_Error kind
            pragma Assert (Nkind (Association_Type) =
                           N_Raise_Constraint_Error);

            Association_Type := Etype (Association_Type);

         elsif Arg_Node_Kind = N_Parameter_Association and then
               Arg_Node = Selector_Name (Parent (Arg_Node))
         then

            --  Currently we assume, that this corresponds to the case of
            --  formal parameters of predefined operations
            return Nil_Element;

         elsif Arg_Node_Kind = N_Component_Clause then
            --  Component clause in record representation clause - Entity
            --  field is not set, we have to traverse the list of components
            --  of the record type

            Association_Type :=
               Entity (Sinfo.Identifier (Parent (Parent (Arg_Node))));

            Result_Node :=
               Get_Specificed_Component (Arg_Node, Association_Type);

            Association_Type := Empty;
            --  Association_Type is set back to Empty to make it possible
            --  to use the general approach for computing Association_Type
            --  later

         elsif Nkind (Arg_Node) = N_Identifier and then
               Sloc (Parent (Arg_Node)) = Standard_ASCII_Location
         then
            --  reference to Character in a constant definition in the
            --  ASCII package, see 8303-011

            Result_Node := Standard_Character;

         elsif not (Arg_Node_Kind = N_Discriminant_Association or else
                    Arg_Node_Kind = N_Generic_Association)
             and then
               not Is_From_Unknown_Pragma (R_Node (Reference_I))
         then
            --  now we are considering all the other cases as component simple
            --  names in a (rewritten!) record aggregate, and we go from the
            --  original to the rewritten structure (because the original
            --  structure is not decorated). If this is not the case, we should
            --  get the Assert_Failure raised in Rewritten_Image
            Arg_Node := Rewritten_Image (Arg_Node);
         end if;

      end if;

      if No (Result_Node) and then
         No (Entity (Arg_Node)) and then
         not (Nkind (Parent (Arg_Node)) = N_Discriminant_Association or else
              Nkind (Parent (Arg_Node)) = N_Generic_Association or else
              Is_From_Unknown_Pragma (R_Node (Reference_I)))
      then
         if Debug_Flag_S then
            Write_Str ("A4G.Expr_Sem.Identifier_Name_Definition:");
            Write_Eol;
            Write_Str ("no Entity field is set for Node ");
            Write_Int (Int (Arg_Node));
            Write_Eol;
            Write_Str ("   the debug image of the query argument is:");
            Write_Eol;
            Debug_String (Reference_I);
            Write_Str (Debug_Buffer (1 .. Debug_Buffer_Len));
            Write_Eol;
         end if;

         Raise_ASIS_Failed (Diagnosis =>
            "A4G.Expr_Sem.Identifier_Name_Definition: no Entity field set");
      end if;

      if Present (Result_Node) then
         null;

      elsif Is_From_Unknown_Pragma (R_Node (Reference_I)) then
         return Nil_Element;
      elsif Nkind (Parent (Arg_Node)) = N_Discriminant_Association and then
         Arg_Node /= Sinfo.Expression (Parent (Arg_Node))
      then
         Result_Node := Original_Discriminant (Arg_Node);

      elsif No (Entity (Arg_Node)) and then
            Nkind (Parent (Arg_Node)) = N_Generic_Association
      then
         --  this is the problem up to 3.10p. We have to compute
         --  N_Defining_Identifier_Node for this generic formal
         --  parameter "by hands"
         --  ??? should be rechecked for 3.11w!!!
         Result_Node := GFP_Declaration (Arg_Node);

      else
         Result_Node := Entity (Arg_Node);
      end if;

      --  and here we have to solve the problem with generic instances:
      --  for them Result_Node as it has been obtained above points not
      --  to the defining identifier from the corresponding instantiation,
      --  but to an entity defined in a "implicit" package created by the
      --  compiler

      if Is_Generic_Instance (Result_Node) then
         Result_Node := Get_Instance_Name (Result_Node);
      end if;

      --  If the argument is Is_Part_Of_Implicit reference to a type, we
      --  have to check if it is the reference to a type mark in parameter
      --  or parameter and result profile of inherited subprogra and if it
      --  should be substituted by the reference to the corresponding
      --  derived type

      Tmp_Node := Node_Field_1 (Reference_I);

      if Ekind (Result_Node) in Einfo.Type_Kind
        and then
         Is_From_Inherited (Reference_I)
        and then
         (Ekind (Tmp_Node) = E_Procedure or else
          Ekind (Tmp_Node) = E_Function)
      then
         Result_Node := Get_Derived_Type (Type_Entity     => Result_Node,
                                          Inherited_Subpr => Tmp_Node);

      end if;

      --  labels (and, probably, statement names!!) makes another problem:
      --  we have to return not the implicit label (statement identifier??)
      --  declaration, but the label (statement name) attached to the
      --  corresponding statement

      if Nkind (Parent (Result_Node)) = N_Implicit_Label_Declaration then
         Result_Node := Get_Statement_Identifier (Result_Node);
      end if;

      Tmp_Node := Parent (Parent (Result_Node));

      while Nkind (Tmp_Node) = N_Subprogram_Renaming_Declaration and then
            not (Comes_From_Source (Tmp_Node))
      loop
         --  If we are here, there are two (?) possibilities:
         --  (1) Result_Node is a defining name from the artificial renaming
         --      declarations created by the compiler in the for wrapper
         --      package for expanded subprogram instantiation. We
         --      have to go to expanded subprogram spec which is renamed.
         --  (2) Result_Node is a defining name from the artificial renaming
         --      declaration created as a way to pass actiual subprogram
         --      in the expanded code. We have to go to the declaration of
         --      this actual subprogram
         --
         --  We have to do this in a loop in case of nested instantiations

         Result_Node := Sinfo.Name   (Tmp_Node);
         Result_Node := Entity (Result_Node);

         Tmp_Node := Parent (Parent (Result_Node));
      end loop;

      if Nkind (Parent (Result_Node)) = N_Defining_Program_Unit_Name then
         --  if we are processing the reference to a child unit, we have to
         --  go from a defining identifier to the corresponding defining
         --  unit name.
         --  If this is a reference to a child subprogram, for which
         --  the separate subprogram specification does not exist,
         --  GNAT generates the tree structure corresponding to such a
         --  separate subprogram specification, and it set the Entity
         --  field for all references to this subprogram pointing
         --  to the defining identifier in this inserted subprogram
         --  specification. This case may be distinguished by the fact,
         --  that Comes_From_Source field for this defining identifier
         --  is set OFF. And in this case we have to go to the defining
         --  identifier in the subprogram body:

         if not Comes_From_Source (Result_Node) then
            --  we have to go to the defining identifier in the
            --  corresponding body:
            while not (Nkind (Result_Node) = N_Subprogram_Declaration) loop
               Result_Node := Parent (Result_Node);
            end loop;

            Result_Node := Corresponding_Body (Result_Node);
         end if;

         Result_Node := Parent (Result_Node);
         Result_Kind := A_Defining_Expanded_Name;

         if not Comes_From_Source (Result_Node) then
            --  now it means that we have a library level instantiation
            --  of a generic child package
            Result_Node := Parent (Parent (Result_Node));
            Result_Node := Original_Node (Result_Node);

            if Nkind (Result_Node) = N_Package_Declaration then
               Result_Node := Sinfo.Corresponding_Body (Result_Node);

               while Nkind (Result_Node) /= N_Package_Body loop
                  Result_Node := Parent (Result_Node);
               end loop;

               Result_Node := Original_Node (Result_Node);
            end if;

            Result_Node := Defining_Unit_Name (Result_Node);
         end if;

      end if;

      if Nkind (Result_Node) = N_Defining_Identifier and then
         (Ekind (Result_Node) = E_In_Parameter or else
          Ekind (Result_Node) = E_Constant) and then
         Present (Discriminal_Link (Result_Node))
      then
         --  here we have to go to an original discriminant
         Result_Node := Discriminal_Link (Result_Node);
      end if;

      --  Now we have Result_Node pointing to some defining name. There are
      --  some kinds of entities which require special processing. For
      --  implicitly declared  entities we have to set Association_Type
      --  pointing to a type which "generates" the corresponding implicit
      --  declaration (there is no harm to set Association_Type for explicitly
      --  declared entities, but for them it is of no use). For predefined
      --  entities the special case attribute should be set.

      ----------------------------------------
      -- temporary solution for 5522-003 ???--
      ----------------------------------------

      --  The problem for record components:
      --
      --  1. The Entity field for references to record components and
      --     disciminants may point to field of some implicit types created
      --     by the compiler
      --
      --  2. The Entity field for the references to the (implicitly declared!)
      --     components of a derived record type point to the explicit
      --     declarations of the component of the ancestor record type
      --
      --  3. Probably, all this stuff should be incapsulated in a separate
      --     subprogram???

      --  Here we already have Result_Node:

      if Nkind (Result_Node) = N_Defining_Identifier and then
         (Ekind (Result_Node) = E_Component    or else
          Ekind (Result_Node) = E_Discriminant or else
          Ekind (Result_Node) = E_Entry        or else
          Ekind (Result_Node) = E_Procedure    or else
          Ekind (Result_Node) = E_Function)
      then

         --  first, we compute Association_Type as pointed to a type
         --  declaration for which Agr_Node is a component:

         if No (Association_Type) then
            Association_Type := Parent (Arg_Node);

            if Nkind (Association_Type) = N_Function_Call then
               Association_Type := Sinfo.Name (Association_Type);
            end if;

            case Nkind (Association_Type) is

               when N_Component_Clause   =>
                  Association_Type :=
                     Sinfo.Identifier (Parent (Association_Type));

               when N_Selected_Component =>
                  Association_Type := Prefix (Association_Type);

                  if Nkind (Association_Type) = N_Selected_Component then
                     Association_Type := Selector_Name (Association_Type);
                  end if;

               when N_Component_Association =>
                  Association_Type := Parent (Association_Type);

               when N_Discriminant_Association =>

                  if Arg_Node = Sinfo.Expression (Association_Type) then
                     --  using a discriminant in initialization expression
                     Association_Type := Empty;
                  else

                     Association_Type := Sinfo.Subtype_Mark
                       (Parent (Parent (Association_Type)));

                  end if;

               when N_Range                            |
                    N_Index_Or_Discriminant_Constraint |
                    N_Variant_Part                     |
                    N_Component_Declaration            |
                    N_Binary_Op                        |
                    N_Unary_Op                         |
                    N_Qualified_Expression             |
                    N_Return_Statement                 |
                    N_Assignment_Statement             |
                    N_Entry_Body_Formal_Part           |
                    N_Subprogram_Renaming_Declaration  |
                    N_Procedure_Call_Statement         |
                    N_Entry_Call_Statement             |
                    N_Expanded_Name                    |
                    N_Indexed_Component                |
                    N_Slice                            |
                    N_Identifier                       |
                    N_Accept_Statement                 |
                    N_Subprogram_Declaration           |
                    N_With_Clause                      |
                    N_Attribute_Reference              |
                    N_Empty                            |
                    N_Generic_Association              |
                    N_Object_Declaration               |
                    N_If_Statement                     |
                    N_Case_Statement                   |
                    N_Pragma_Argument_Association      |
                    N_Attribute_Definition_Clause      |
                    N_Parameter_Association            |
                    N_Formal_Subprogram_Declaration    |
                    N_Explicit_Dereference             =>

                  --  We set Association_Type as Empty to indicate the case of
                  --  a definitely explicit result

                  Association_Type := Empty;

               when others =>
                  --  ??? this Assert pragma - only for development/debug
                  --  ??? period
                  --  ??? what else except N_Selected_Component could be here
                  null;
                  pragma Assert (False);
            end case;

         end if;

         if Present (Association_Type) then
            Association_Type := Etype (Association_Type);

            if Nkind (Original_Node (Parent (Association_Type))) =
               N_Single_Task_Declaration
              or else
               Nkind (Original_Node (Parent (Association_Type))) =
               N_Single_Protected_Declaration
            then
               Association_Type := Empty;
            else
               Association_Type :=
                  Explicit_Type_Declaration_Unwound_Unaccess
                    (Association_Type, Arg_Node);
            end if;

         end if;

         --  then, we have to adjust result_Node:

         if Ekind (Result_Node) = E_Discriminant and then
            Chars (Discriminal (Result_Node)) /=
            Chars (Original_Record_Component (Result_Node))
         then
            --  This condition is the clue for discriminants explicitly
            --  declared in  declarations of derived types.
            --  These assignments below resets Result_Node to
            --  N_Defining_Identifier node which denotes the same discriminant
            --  but has a properly set bottom-up chain of Parent nodes
            Result_Node := Discriminal (Result_Node);
            Result_Node := Discriminal_Link (Result_Node);

         else
            --  There we have to come from an implicit type to a explicitly
            --  declared type:

            Tmp_Node := Scope (Result_Node);

            if not (Comes_From_Source (Tmp_Node)) then
               Tmp_Node := First_Entity (Etype (Tmp_Node));

               while Present (Tmp_Node) loop
                  if Chars (Tmp_Node) = Chars (Result_Node) then
                     Result_Node := Tmp_Node;
                     exit;
                  end if;

                  Tmp_Node := Next_Entity (Tmp_Node);
               end loop;

            end if;

         end if;

         --  A private type may require some special adjustment in case if
         --  full view is visible: if Result_Node is a discriminant:
         --  it points to a discriminant in a private view, and we have
         --  to reset it to point to the discriminant in the full view
         if Present (Association_Type)
           and then
            Has_Private_Declaration (Defining_Identifier (Association_Type))
           and then
            Ekind (Result_Node) = E_Discriminant
           and then
            Nkind (Association_Type) /= N_Private_Type_Declaration
           and then
            Nkind (Association_Type) /= N_Private_Extension_Declaration
           and then
            Is_Type_Discriminant (Result_Node,
                                  Original_Node (Association_Type))
         then
            Result_Node := Reset_To_Full_View (Association_Type, Result_Node);
         end if;
         --  Now, we have to define if we have an implicit component here.
         --  Result_Context_Node is finally supposed to be set to the
         --  declaration of the type to which the argument component belongs

         if No (Association_Type) then
            --  definitely explicit result:
            Is_Inherited := False;

         elsif Is_Rewrite_Substitution (Association_Type) then
            --  here we have a derived type with no record extension part
            --  but it can have an explicitly declared discriminant

            if Ekind (Result_Node) = E_Discriminant then
               Is_Inherited := not (Is_Type_Discriminant (
                  Result_Node, Original_Node (Association_Type)));
            else
               Is_Inherited := True;
            end if;

         elsif Nkind (Association_Type) = N_Incomplete_Type_Declaration
               or else
               Nkind (Association_Type) = N_Private_Extension_Declaration
               or else
               Nkind (Association_Type) = N_Private_Type_Declaration
               or else
               Nkind (Association_Type) = N_Task_Type_Declaration
               or else
               Nkind (Association_Type) = N_Protected_Type_Declaration
               or else
               (Nkind (Association_Type) = N_Formal_Type_Declaration and then
                Nkind (Sinfo.Formal_Type_Definition (Association_Type)) =
                N_Formal_Private_Type_Definition)
               or else
                Nkind (Sinfo.Type_Definition (Association_Type)) =
                N_Record_Definition
         then
            --  should be an explicit component
            Is_Inherited := False;

         elsif Nkind (Sinfo.Type_Definition (Association_Type)) =
               N_Derived_Type_Definition
         then
            --  it may be an inherited component or an explicitly declared
            --  discriminant or a component from a record extension part

            if Is_Explicit_Type_Component (Result_Node, Association_Type) then
               Is_Inherited := False;
            else
               Is_Inherited := True;
            end if;

         else
            --  ??? this Assert pragma - only for development/debug period
            --  ??? what else except N_Selected_Component could be here
            null;
            pragma Assert (False);
         end if;

      end if;

      -------------------------------------------------
      -- end for the temporary solution for 5522-003 --
      -------------------------------------------------

      --------------------------
      -- Enumeration literals --
      --------------------------

      if not (Defined_In_Standard (Arg_Node))
        and then
         Nkind (Result_Node) = N_Defining_Identifier
         --  or else
         --  Nkind (Result_Node) = N_Defining_Character_Literal)
         and then
          Ekind (Result_Node) = E_Enumeration_Literal
         and then (not Comes_From_Source (Result_Node))
      then
         --  an enumeration literal inherited by a derived type definition
         --  (character literals are still processed by a separate function
         --  Character_Literal_Name_Definition, that's why the corresponding
         --  part of the condition is commented out)

         --  ???Needs revising for the new model of implicit Elements

         Is_Inherited     := True;
         Association_Type := Etype (Arg_Node);
         Association_Type :=
            Explicit_Type_Declaration_Unwound (Association_Type);
      end if;

      ---------------------------------------
      -- The rest of special processing:   --
      -- somewhat messy and needs revising --
      ---------------------------------------

      --  We have to turn off for a while the full processing of the
      --  implicit elements (Hope to fix this soon).

      if Defined_In_Standard (Arg_Node)
         or else Sloc (Arg_Node) <= Standard_Location
      then
         --  We need the second part of the condition for references to
         --  Standard.Characters which are parts of the definitions in
         --  the ASCII package

         if Result_Kind = A_Defining_Identifier or else
            Result_Kind = A_Defining_Enumeration_Literal
         then
            --  I hope, that I'm right, that all the *identifiers* declared
            --  in standard are declared explicitly, and all the rest
            --  (which are defined in Standard) are implicit
            --  Root and universal types can make a problem, but let's
            --  see it before...
            Special_Case := Explicit_From_Standard;
         else
            return Nil_Element;
         end if;

      else

         if Result_Kind in Internal_Defining_Operator_Kinds and then
            Is_Predefined (Result_Node)
         then
            Special_Case := Predefined_Operation;
--            --  note, that Predefined_Operation corresponds to an
--            --  implicitly declared operation of a type, which is defined
--            --  not in the Standard package
--            Association_Type := Enclosed_Type (Result_Node);
--            --  we have to use namely Association_Type, but not Result_Node
--            --  to define Result_Unit, because sometimes Result_Node
--            --  does not have the Parent field set
            return Nil_Element;
            --  ???!!! this turns off all the predefined operations
            --  !!!??? defined not in Standard
         end if;
      end if;

      if Special_Case not in Predefined      and then
         not Comes_From_Source (Result_Node) and then
         No (Association_Type)
      then
         --  Three possibilities:
         --  - libray-level subprogram instantiation
         --  - defining name from the artificial spec created for subprogram
         --    body which acts as a spec
         --  - inherited subprogram

         if Nkind (Parent (Result_Node)) in N_Subprogram_Specification then

            if Is_Generic_Instance (Result_Node) then
               --  Libray-level subprogram instantiation
               --  Here we have to go from the rewritten to the original
               --  tree structure
               Result_Node := Parent (Parent (Parent (Parent (Result_Node))));
               Result_Node := Original_Node (Result_Node);
               Result_Node := Sinfo.Defining_Unit_Name (Result_Node);
            else
               --  Artificial supbrogram spec created for the body acting
               --  as spec
               Result_Node := Parent (Parent (Result_Node));
               Result_Node := Corresponding_Body (Result_Node);
            end if;

         else
            --  It should be inherited!
            --  The last condition is needed to filter out already processed
            --  cases. This case corresponds to inherited user-defined
            --  subprograms

            Is_Inherited     := True;

            if Ekind (Result_Node) = E_Function or else
               Ekind (Result_Node) = E_Procedure
            then
               Association_Type := Result_Node;
               --  Points to the defining identifier of implicit inherited
               --  subprogram

               while Present (Alias (Result_Node)) loop
                  Result_Node := Alias (Result_Node);
               end loop;
               --  Now Result_Node points to the defining identifier of
               --  explicit subprogram which is inherited

            else
               --  ??? Probably will need revising when inherited record
               --  components and enumeration literals are fully
               --  implemented
               Association_Type := Defining_Identifier (Parent (Result_Node));
               Association_Type := First_Subtype (Association_Type);
            end if;

         end if;

      end if;

      if Defined_In_Standard (Arg_Node) then
         Result_Unit  := Get_Comp_Unit
                           (Standard_Id, Encl_Cont_Id (Reference_I));

      else
         if Result_Kind in Internal_Defining_Operator_Kinds and then
            Is_Predefined (Result_Node)
         then
            null;
--            --  note, that Predefined_Operation corresponds to an
--            --  implicitly declared operation of a type, which is defined
--            --  not in the Standard package
--            Association_Type := Enclosed_Type (Result_Node);
--            --  we have to use namely Association_Type, but not Result_Node
--            --  to define Result_Unit, because sometimes Result_Node
--            --  does not have the Parent field set
--            Result_Unit :=
--               Enclosing_Unit (Encl_Cont_Id (Reference_I), Association_Type);
            return Nil_Element;
            --  ???!!! this turns off all the predefined operations
            --  !!!??? defined not in Standard

         elsif Is_Inherited then

            Result_Unit :=
               Enclosing_Unit (Encl_Cont_Id (Reference_I), Association_Type);

         else

            Result_Unit :=
               Enclosing_Unit (Encl_Cont_Id (Reference_I), Result_Node);

         end if;
      end if;

      if Is_Inherited
        and then
         (Ekind (Result_Node) = E_Component or else
          Ekind (Result_Node) = E_Discriminant)
      then
         Componnet_Name := Result_Node;
      end if;


      return Node_To_Element_New (Node          => Result_Node,
                                  Node_Field_1  => Association_Type,
                                  Node_Field_2  => Componnet_Name,
                                  Internal_Kind => Result_Kind,
                                  Spec_Case     => Special_Case,
                                  Inherited     => Is_Inherited,
                                  In_Unit       => Result_Unit);

   exception
      when Assert_Error : System.Assertions.Assert_Failure =>
         Raise_ASIS_Failed (
            Argument  => Reference_I,
            Diagnosis =>
               "A4G.Expr_Sem.Identifier_Name_Definition - "  & LT
             & "Assert_Failure at "
             &  Ada.Exceptions.Exception_Message (Assert_Error));
      when ASIS_Failed =>
--         Add_Call_Information (
--            Argument   => Reference_I,
--            Outer_Call => "A4G.Expr_Sem.Identifier_Name_Definition");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Reference_I,
            Diagnosis => "A4G.Expr_Sem.Identifier_Name_Definition");
   end Identifier_Name_Definition;

   --------------------------------
   -- Is_Explicit_Type_Component --
   --------------------------------

   function Is_Explicit_Type_Component
     (Comp_Def_Name : Node_Id;
      Type_Decl     : Node_Id)
      return Boolean
   is
      Result    : Boolean := False;
      Cont_Node : Node_Id;
   begin
      Cont_Node := Parent (Comp_Def_Name);

      while Present (Cont_Node) loop

         if Cont_Node = Type_Decl then
            Result := True;
            exit;
         end if;

         Cont_Node := Parent (Cont_Node);
      end loop;

      return Result;

   end Is_Explicit_Type_Component;

   -----------------------------------
   -- Is_Part_Of_Defining_Unit_Name --
   -----------------------------------

   function Is_Part_Of_Defining_Unit_Name (Name_Node : Node_Id) return Boolean
   is
      Result    : Boolean := False;
      Next_Node : Node_Id := Parent (Name_Node);
   begin
      while Present (Next_Node) loop

         if Nkind (Next_Node) = N_Defining_Program_Unit_Name then
            Result := True;
            exit;
         elsif not (Nkind (Next_Node) = N_Expanded_Name or else
                    Nkind (Next_Node) = N_Selected_Component)
         then
            --  theoretically, we need only the first part of the condition,
            --  but the unit name in the body is not fully decorated and,
            --  therefore, has the wrong syntax structure, so we need the
            --  second part. We are keeping both in order to have the correct
            --  code if it is changed in the tree.
            exit;
         else
            Next_Node := Parent (Next_Node);
         end if;

      end loop;

      return Result;

   end Is_Part_Of_Defining_Unit_Name;

   ------------------
   -- Is_Reference --
   ------------------

   function Is_Reference
     (Name : Asis.Element;
      Ref  : Asis.Element)
      return Boolean
   is
      Ref_Kind : Internal_Element_Kinds := Reference_Kind (Name);

      Result : Boolean := False;

   begin

      if Int_Kind (Ref) = Ref_Kind then

         begin

            if Is_Equal (Corresponding_Name_Definition (Ref), Name) then
               Result := True;
            end if;

         exception
            --  Corresponding_Name_Definition may raise Asis_Failed with
            --  Value_Error status when applied to identifiers which
            --  can not have definitions (see section 17.6). Here we
            --  have to skip such Elements paying no attention to
            --  exception raising
            when others => null;
         end;

      end if;

      return Result;

   end Is_Reference;

   --------------------------
   -- Is_Type_Discriminant --
   --------------------------

   function Is_Type_Discriminant
     (Discr_Node : Node_Id;
      Type_Node  : Node_Id)
      return Boolean
   is
      Discr_Chars     : Name_Id := Chars (Discr_Node);
      Discr_List      : List_Id;
      Next_Discr_Spec : Node_Id;
      Result : Boolean := False;
   begin
      Discr_List := Discriminant_Specifications (Type_Node);

      if Present (Discr_List) then
         Next_Discr_Spec := First (Discr_List);

         while Present (Next_Discr_Spec) loop

            if Chars (Defining_Identifier (Next_Discr_Spec)) = Discr_Chars then
               Result := True;
               exit;
            end if;

            Next_Discr_Spec := Next (Next_Discr_Spec);
         end loop;

      end if;

      return Result;

   end Is_Type_Discriminant;

   ----------------
   -- Needs_List --
   ----------------

   function Needs_List (Reference : Asis.Element) return Boolean is
      Result      : Boolean := False;
      N           : Node_Id := R_Node (Reference);
      Entity_N    : Entity_Id;
      Pragma_Name : Name_Id;
   begin

      if Nkind (Parent (N)) = N_Pragma_Argument_Association then
         Pragma_Name := Chars (Parent (Parent (N)));

         if (Pragma_Name = Name_Asynchronous or else
             Pragma_Name = Name_Convention   or else
             Pragma_Name = Name_Export       or else
             Pragma_Name = Name_Import       or else
             Pragma_Name = Name_Inline)
         then
            Entity_N := Entity (N);

            if Present (Entity_N) and then
               Is_Overloadable (Entity_N) and then
               Has_Homonym (Entity_N)
            then
               --  ??? Is this the right condition???
               --  ??? At the moment we do not consider any GNAT-specific
               --      pragma

               N := Homonym (Entity (N));

               if not (Sloc (N) <= Standard_Location) then
                  --  !!! Note, that this check filters out the predefined
                  --  implicitly declared operations!!!
                  Result := True;

               end if;

            end if;

         end if;

      end if;

      return Result;
   end Needs_List;

   --------------------
   -- Reference_Kind --
   --------------------

   function Reference_Kind
     (Name            : Asis.Element)
      return            Internal_Element_Kinds
   is
      Arg_Kind : Internal_Element_Kinds := Int_Kind (Name);
      Result   : Internal_Element_Kinds := Not_An_Element;
   begin

      if Arg_Kind in Internal_Defining_Name_Kinds then

         if Arg_Kind = A_Defining_Expanded_Name then
            Arg_Kind := Int_Kind (Defining_Selector (Name));
         end if;

      end if;

         case Arg_Kind is
            when A_Defining_Identifier          =>
               Result := An_Identifier;
            when A_Defining_Character_Literal   =>
               Result := A_Character_Literal;
            when A_Defining_Enumeration_Literal =>
               Result := An_Enumeration_Literal;
            when A_Defining_And_Operator        =>
               Result := An_And_Operator;
            when A_Defining_Or_Operator         =>
               Result := An_Or_Operator;
            when A_Defining_Xor_Operator        =>
               Result := An_Xor_Operator;
            when A_Defining_Equal_Operator      =>
               Result := An_Equal_Operator;
            when A_Defining_Not_Equal_Operator  =>
               Result := A_Not_Equal_Operator;
            when A_Defining_Less_Than_Operator  =>
               Result := A_Less_Than_Operator;
            when A_Defining_Less_Than_Or_Equal_Operator =>
               Result := A_Less_Than_Or_Equal_Operator;
            when A_Defining_Greater_Than_Operator =>
               Result := A_Greater_Than_Operator;
            when A_Defining_Greater_Than_Or_Equal_Operator =>
               Result := A_Greater_Than_Or_Equal_Operator;
            when A_Defining_Plus_Operator =>
               Result := A_Plus_Operator;
            when A_Defining_Minus_Operator =>
               Result := A_Minus_Operator;
            when A_Defining_Concatenate_Operator =>
               Result := A_Concatenate_Operator;
            when A_Defining_Unary_Plus_Operator =>
               Result := A_Unary_Plus_Operator;
            when A_Defining_Unary_Minus_Operator =>
               Result := A_Unary_Minus_Operator;
            when A_Defining_Multiply_Operator =>
               Result := A_Multiply_Operator;
            when A_Defining_Divide_Operator =>
               Result := A_Divide_Operator;
            when A_Defining_Mod_Operator =>
               Result := A_Mod_Operator;
            when A_Defining_Rem_Operator =>
               Result := A_Rem_Operator;
            when A_Defining_Exponentiate_Operator =>
               Result := An_Exponentiate_Operator;
            when A_Defining_Abs_Operator =>
               Result := An_Abs_Operator;
            when A_Defining_Not_Operator =>
               Result := A_Not_Operator;

            when others =>
               null;
         end case;

      return Result;

   end Reference_Kind;

   ------------------------
   -- Reset_To_Full_View --
   ------------------------

   function Reset_To_Full_View
     (Full_View : Node_Id;
      Discr : Node_Id)
      return Node_Id
   is
      Result : Node_Id;
      Discr_Chars : Name_Id := Chars (Discr);
   begin

      Result := First (Discriminant_Specifications (Full_View));

      while Present (Result) loop
         exit when Chars (Defining_Identifier (Result)) = Discr_Chars;
         Result := Next (Result);
      end loop;

      pragma Assert (Present (Result));

      Result := Defining_Identifier (Result);

      return Result;

   end Reset_To_Full_View;

   -------------------
   -- Reset_To_Spec --
   -------------------

   function Reset_To_Spec (Name_Node : Node_Id) return Node_Id is
      Result : Node_Id := Empty;
      Next_Node : Node_Id := Parent (Name_Node);
      Name_Chars : Name_Id := Chars (Name_Node);
   begin

      while Nkind (Next_Node) /= N_Defining_Program_Unit_Name loop
         Next_Node := Parent (Next_Node);
      end loop;

      if Nkind (Parent (Next_Node)) in N_Subprogram_Specification then
         Next_Node := Parent (Next_Node);
      end if;

      Next_Node := Corresponding_Spec (Parent (Next_Node));

      while Nkind (Next_Node) /= N_Defining_Program_Unit_Name loop
         Next_Node := Parent (Next_Node);
      end loop;

      Next_Node := Parent (Next_Node);

      Next_Node := Defining_Unit_Name (Next_Node);
      --  Now Next_Node should point to the defining program unit name in the
      --  spec:

      Next_Node := Sinfo.Name (Next_Node);

      while Present (Next_Node) loop

         if Nkind (Next_Node) = N_Expanded_Name then
            Next_Node := Selector_Name (Next_Node);
         end if;

         if Name_Chars = Chars (Next_Node) then
            Result := Next_Node;
            exit;
         end if;

         Next_Node := Parent (Next_Node);

         if Nkind (Next_Node) = N_Expanded_Name then
            Next_Node := Prefix (Next_Node);
         else
            exit;
         end if;

      end loop;

      pragma Assert (Present (Result));

      return Result;

   end Reset_To_Spec;

   ---------------------
   -- Rewritten_Image --
   ---------------------

   function Rewritten_Image (Selector_Name : Node_Id) return Node_Id is
      Name_Chars  : Name_Id := Chars (Selector_Name);
      Aggr_Node   : Node_Id;
      Result_Node : Node_Id := Empty;
      Association_Node    : Node_Id;
      Choice_Node : Node_Id;
   begin
      --  may be, we have to be more smart for aggregates in aggregates...
      Aggr_Node := Parent (Selector_Name);
      --  we are in N_Component_Association node, and its Parent points not
      --  to the original, but to the rewritten structure for aggregate
      Aggr_Node := Parent (Aggr_Node);
      --  we are in the rewritten node for the aggregate
      pragma Assert (
                (Nkind (Aggr_Node) = N_Aggregate or else
                 Nkind (Aggr_Node) = N_Extension_Aggregate)
                and then
                 Is_Rewrite_Substitution (Aggr_Node));
      --  and now - traversing the rewritten structure

      Association_Node :=
         First_Non_Pragma (Component_Associations (Aggr_Node));

      Associations : while Present (Association_Node) loop
         Choice_Node := First_Non_Pragma (Choices (Association_Node));

         --  in the rewritten aggregate it is exactly one choice in any
         --  component association
         if Chars (Choice_Node) = Name_Chars then
            Result_Node := Choice_Node;
            exit Associations;
         end if;

         Association_Node := Next_Non_Pragma (Association_Node);
      end loop Associations;

      pragma Assert (Present (Result_Node));

      return Result_Node;

   end Rewritten_Image;

end A4G.Expr_Sem;
