------------------------------------------------------------------------------
--                                                                          --
--                 ASIS-for-GNAT IMPLEMENTATION COMPONENTS                  --
--                                                                          --
--                          A 4 G . E X P R _ S E M                         --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--            Copyright (C) 1995-2011, 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,  51 Franklin --
-- Street, Fifth Floor, Boston, MA 02110-1301, USA.                         --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
-- ASIS-for-GNAT was originally developed  by the ASIS-for-GNAT team at the --
-- Software  Engineering  Laboratory  of  the Swiss  Federal  Institute  of --
-- Technology (LGL-EPFL) in Lausanne,  Switzerland, in cooperation with the --
-- Scientific  Research  Computer  Center of  Moscow State University (SRCC --
-- MSU), Russia,  with funding partially provided  by grants from the Swiss --
-- National  Science  Foundation  and  the  Swiss  Academy  of  Engineering --
-- Sciences. ASIS-for-GNAT is now maintained by AdaCore                     --
-- (http://www.adacore.com).                                                --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Wide_Characters.Unicode;

with Asis.Clauses;           use Asis.Clauses;
with Asis.Compilation_Units; use Asis.Compilation_Units;
with Asis.Declarations;      use Asis.Declarations;
with Asis.Elements;          use Asis.Elements;
with Asis.Expressions;       use Asis.Expressions;
with Asis.Extensions;        use Asis.Extensions;
with Asis.Iterator;          use Asis.Iterator;
with Asis.Statements;        use Asis.Statements;

with Asis.Set_Get;           use Asis.Set_Get;

with A4G.A_Debug;            use A4G.A_Debug;
with A4G.A_Output;           use A4G.A_Output;
with A4G.A_Sem;              use A4G.A_Sem;
with A4G.A_Stand;            use A4G.A_Stand;
with A4G.A_Types;            use A4G.A_Types;
with A4G.Asis_Tables;        use A4G.Asis_Tables;
with A4G.Contt.UT;           use A4G.Contt.UT;
with A4G.Int_Knds;           use A4G.Int_Knds;
with A4G.Knd_Conv;           use A4G.Knd_Conv;
with A4G.Mapping;            use A4G.Mapping;

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

package body A4G.Expr_Sem is

   -----------------------
   -- 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;
   pragma Unreferenced (Rewritten_Image);
   --  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
   --
   --  This function is not used now, it is replaced by Search_Record_Comp

   function Search_Record_Comp (Selector_Name : Node_Id) return Entity_Id;
   --  This function looks for the entity node corresponding to a name from a
   --  choices list from a record or extension aggregate. The problem here is
   --  that an aggregate node is rewritten, and in the original tree structure
   --  the nodes corresponding to component names do not have the Entity
   --  field set. This function locates the corresponding entity node by
   --  detecting the aggregate type and searching the component defining
   --  identifier with the same name in the record definition.
   --  It might be the case (because of the absence of some semantic
   --  information in the tree or because of the ASIS bug) that Selector_Name
   --  actually does not represent a name from the aggregate choice list, in
   --  this case this function raises Assert_Failure or (if assertions are off)
   --  returns the Empty node.

   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 corresponding
   --  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

   function Get_Rewritten_Discr_Ref (N : Node_Id) return Node_Id;
   pragma Unreferenced (Get_Rewritten_Discr_Ref);
   --  This function is supposed to be called for a discriminant reference
   --  from the discriminant constraint from derived type, in case if the
   --  parent type is a task or protected type. In this case
   --  N_Subtype_Indication node from the derived type definition is rewritten
   --  in a subtype mark pointing to the internal subtype. The original
   --  structure is not decorated, so we have to go to the corresponding
   --  node in the definition of this internal subtype to get the semantic
   --  information. See F407-011
   --  Do we need this after fixing the regression caused by K120-031

   function Get_Discriminant_From_Type (N : Node_Id) return Entity_Id;
   --  Starting from the reference to discriminant in a discriminant
   --  constraint, tries to compute the corresponding discriminant entity by
   --  getting to the declaration of the corresponding type and traversing
   --  its discriminant part.

   function Is_Limited_Withed
     (E         : Entity_Id;
      Reference : Asis.Element)
      return Boolean;
   --  Assuming that Reference is an_Identifier Element and E is the entity
   --  node for the entity denoted by Reference, checks if this entity is
   --  defined in a compilation unit that is limited withed by the unit
   --  containing Reference

   function To_Upper_Case (S : Wide_String) return Wide_String;
   --  Folds the argument to upper case, may be used for string normalization
   --  before comparing strings if the casing is not important for comparing
   --  (Copied from ASIS_UL.Misc to avoid dependencies on ASIS UL in "pure"
   --  ASIS.

   ---------------------------------------
   -- 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;
      Special_Case     : Special_Cases          := Not_A_Special_Case;
      Result_Element   : Asis.Defining_Name     := Nil_Element;
      Is_Inherited     : Boolean                := False;
      Association_Type : Node_Id                := Empty;
      Set_Char_Code    : Boolean                := False;

      Result_Node : Node_Id;
      Result_Unit : Compilation_Unit;
      Result_Kind : constant Internal_Element_Kinds :=
        A_Defining_Character_Literal;
   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;

   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         : constant 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 traversing 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 := Pragma_Name (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 region
         --  (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 writing 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);

         if Res_Ekind in Subprogram_Kind then

            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));
         end if;

         Next_Entity := Homonym (Next_Entity);
      end loop;

   end Collect_Overloaded_Entities;

   ---------------------------
   -- Correct_Impl_Form_Par --
   ---------------------------

   procedure Correct_Impl_Form_Par
     (Result    : in out Element;
      Reference :        Element)
   is
      Res_Node        : Node_Id := Node (Result);
      Subprogram_Name : Element;
      Subprogram_Node : Node_Id := Node (Result);
      Res_Sloc        : Source_Ptr;
      Top_Node        : Node_Id;
      Result_Unit     : Compilation_Unit;
   begin
      Res_Node := Defining_Identifier (Parent (Res_Node));

      Subprogram_Name := Enclosing_Element (Enclosing_Element (Reference));

      case Int_Kind (Subprogram_Name) is
         when A_Function_Call =>
            Subprogram_Name := Prefix (Subprogram_Name);
         when A_Procedure_Call_Statement |
              An_Entry_Call_Statement    =>
            Subprogram_Name := Called_Name (Subprogram_Name);
         when others =>
            null;
            pragma Assert (False);
      end case;

      Subprogram_Node := Node (Subprogram_Name);
      Subprogram_Node := Associated_Node (Subprogram_Node);

      Top_Node := Parent (Subprogram_Node);

      while Nkind (Top_Node) /= N_Compilation_Unit loop
         Top_Node := Parent (Top_Node);
      end loop;

      Res_Sloc := Sloc (Res_Node) - Sloc (Top_Node);

      Result_Unit :=
        Enclosing_Unit (Encl_Cont_Id (Reference), Subprogram_Node);

      Set_Node           (Result, Res_Node);
      Set_R_Node         (Result, Res_Node);
      Set_From_Implicit  (Result, True);
      Set_From_Inherited (Result, True);
      Set_From_Instance  (Result, Is_From_Instance (Subprogram_Node));
      Set_Node_Field_1   (Result, Subprogram_Node);
      Set_Rel_Sloc       (Result, Res_Sloc);
      Set_Encl_Unit_Id   (Result, Get_Unit_Id (Result_Unit));
   end Correct_Impl_Form_Par;

   --------------------
   -- Correct_Result --
   --------------------

   procedure Correct_Result
     (Result    : in out Element;
      Reference :        Element)
   is
      Enclosing_Generic : Element := Nil_Element;
      Tmp               : Element;
      Tmp_Generic       : Element;
      Is_From_Body      : Boolean := False;
      Instance          : Element := Nil_Element;

      procedure Check_Number_Name
        (Element :        Asis.Element;
         Control : in out Traverse_Control;
         State   : in out No_State);
      --  Check if the argument is the defining name of the named number
      --  defining the same named number as Result, but in the template.
      --  As soon as the check is successful, replace Result with this
      --  defining name and terminates the traversal

      Control : Traverse_Control := Continue;
      State   : No_State := Not_Used;

      procedure Traverse_Instance is new Traverse_Element
        (State_Information => No_State,
         Pre_Operation     => Check_Number_Name,
         Post_Operation    => No_Op);

      procedure Check_Number_Name
        (Element :        Asis.Element;
         Control : in out Traverse_Control;
         State   : in out No_State)
      is
         pragma Unreferenced (State);
         El_Kind : constant Internal_Element_Kinds := Int_Kind (Element);
      begin

         case El_Kind is

            when A_Defining_Identifier =>

               if Int_Kind (Enclosing_Element (Element)) in
                  An_Integer_Number_Declaration .. A_Real_Number_Declaration
                 and then
                  Chars (Node (Result)) = Chars (Node (Element))
               then
                  Result  := Element;
                  Control := Terminate_Immediately;
               end if;

            when An_Integer_Number_Declaration |
                 A_Real_Number_Declaration     |
                 A_Procedure_Body_Declaration  |
                 A_Function_Body_Declaration   |
                 A_Package_Declaration         |
                 A_Package_Body_Declaration    |
                 A_Task_Body_Declaration       |
                 A_Protected_Body_Declaration  |
                 An_Entry_Body_Declaration     |
                 A_Generic_Package_Declaration |
                 A_Block_Statement             =>

               null;
            when others =>
               Control := Abandon_Children;
         end case;

      end Check_Number_Name;

   begin
      --  First, check if Result is declared in a template

      Tmp := Enclosing_Element (Result);

      while not Is_Nil (Tmp) loop

         if Int_Kind (Tmp) in An_Internal_Generic_Declaration
           or else
            (Int_Kind (Tmp) in A_Procedure_Body_Declaration ..
                               A_Package_Body_Declaration
              and then
             Int_Kind (Corresponding_Declaration (Tmp)) in
               An_Internal_Generic_Declaration)
         then

            if Int_Kind (Tmp) in A_Procedure_Body_Declaration ..
                                 A_Package_Body_Declaration
            then
               Enclosing_Generic := Corresponding_Declaration (Tmp);
               Is_From_Body := True;
            else
               Enclosing_Generic := Tmp;
            end if;

            exit;

         end if;

         Tmp := Enclosing_Element (Tmp);
      end loop;

      if Is_Nil (Enclosing_Generic) then
         --  No need to correct anything!
         return;
      end if;

      --  Now, traversing the instantiation chain from the Reference, looking
      --  for the instantiation of Enlosing_Generic:

      Tmp := Enclosing_Element (Reference);

      while not Is_Nil (Tmp) loop

         if Int_Kind (Tmp) in An_Internal_Generic_Instantiation then
            Tmp_Generic := Generic_Unit_Name (Tmp);

            if Int_Kind (Tmp_Generic) = A_Selected_Component then
               Tmp_Generic := Selector (Tmp_Generic);
            end if;

            Tmp_Generic := Corresponding_Name_Declaration (Tmp_Generic);

            if Is_Equal (Enclosing_Generic, Tmp_Generic) then
               Instance := Tmp;
               exit;
            end if;

         end if;

         Tmp := Enclosing_Element (Tmp);
      end loop;

      if Is_Nil (Instance) then
         --  No need to correct anything - we do not have a nested generics!
         return;
      end if;

      --  And now we have to find the "image' of Result in expanded Instance
      if Is_From_Body then
         Instance := Corresponding_Body (Instance);
      else
         Instance := Corresponding_Declaration (Instance);
      end if;

      Traverse_Instance (Instance, Control, State);

   end Correct_Result;

   -------------------------------
   -- 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  : constant 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 not Is_Itype (Entity_Node)
          and then
            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;

            --  ??? Why do not we return Empty in this case???

         elsif Res_Ekind = E_Anonymous_Access_Subprogram_Type then
            --  No explicit type declaration, so
            return Empty;

         elsif Res_Ekind = E_String_Literal_Subtype
            or else
               (Res_Ekind = E_Array_Subtype
               and then
                Present (Parent (Entity_Node)))
         then
            --  The first part of the condition corresponds to a special case
            --  E_String_Literal_Subtype is created for, see Einfo (spec) for
            --  the details. The second part corresponds to the access to
            --  string type, see E626-002

            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        or else
                      Ekind (Entity_Node) = E_Limited_Private_Type)
         then

            if Is_Itype (Entity_Node)
              and then
                Nkind (Associated_Node_For_Itype (Entity_Node)) =
                       N_Subtype_Declaration
            then
               Next_Node :=
                 Defining_Identifier (Associated_Node_For_Itype (Entity_Node));

               if Next_Node = Entity_Node then
                  Next_Node := Etype (Entity_Node);
               end if;

            else
               --  subtypes created for objects when an explicit constraint
               --  presents in the object declaration ???

               Next_Node := Etype (Entity_Node);
            end if;

            Result_Node := Explicit_Type_Declaration (Next_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;

   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;
      Tmp               : 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;

      --  This loop unwinds accessing^

      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);

         if Nkind (Result_Node) = N_Incomplete_Type_Declaration then
            --  To be 100% honest, we have to check that at place of
            --  Reference_Node the full view is visible. But we could hardly
            --  call this routine (for a legal code) if we do not see the full
            --  view from Reference_Node.

            Tmp := Full_View (Defining_Identifier (Result_Node));

            if Present (Tmp) then
               Result_Node :=  Parent (Tmp);
            end if;

         end if;

      end loop;

      --  If we have a type derived from an access type, we have to go through
      --  this derivation and unwind accessing

      if Nkind (Result_Node) = N_Full_Type_Declaration
        and then
         Nkind (Sinfo.Type_Definition (Result_Node)) =
         N_Derived_Type_Definition
      then
         Tmp := Defining_Identifier (Result_Node);

         if Ekind (Tmp) in Access_Kind then
            Result_Node :=
              Explicit_Type_Declaration_Unwound_Unaccess
                (Directly_Designated_Type (Tmp),
                 Reference_Node);
         end if;

      end if;

      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      : constant Internal_Element_Kinds := Int_Kind (Expression);
      Result_Entity : Node_Id;
      Result_Node   : Node_Id;
      Result_Unit   : Compilation_Unit;
      Res_Spec_Case : Special_Cases       := Not_A_Special_Case;
      Encl_Cont     : constant 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                        or else
        (Special_Case (Expression) = Rewritten_Named_Number
         and then Nkind (R_Node (Expression)) = N_Integer_Literal)
      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         or else
           (Special_Case (Expression) = Rewritten_Named_Number
            and then Nkind (R_Node (Expression)) = N_Real_Literal)
      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;

      while Nkind (Arg_Node) = N_String_Literal
        and then
         Nkind (Parent (Arg_Node)) = N_String_Literal
      loop
         --  Trick for F109-A24: for string literals in a static expression,
         --  Etype points to some dummy subtype node (the tree structure is
         --  rewritten for the whole expression, and the original subtree is
         --  not fully decorated), so we take the type information from the
         --  rewritten result of the expression
         Arg_Node := Parent  (Arg_Node);
      end loop;

      --  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;

      if Result_Entity = Any_Composite then
         --  Here we have an aggregate in some original tree structure that has
         --  not been properly decorated. All the semantic decorations are in
         --  the corresponding rewritten structure, so we have to find the
         --  corresponding node there.

         declare
            Tmp          : Node_Id;
            New_Arg_Node : Node_Id := Empty;

            Arg_Kind : constant Node_Kind  := Nkind (Arg_Node);
            Arg_Sloc : constant Source_Ptr := Sloc (Arg_Node);

            function Find (Node : Node_Id) return Traverse_Result;
            --  Check if its argument represents the same construct as
            --  Arg_Node, and if it does, stores Node in New_Arg_Node and
            --  returns Abandon, otherwise returns OK.

            procedure Find_Rewr_Aggr is new  Traverse_Proc (Find);

            function Find (Node : Node_Id)  return Traverse_Result is
            begin

               if Nkind (Node) = Arg_Kind
                 and then
                  Sloc (Node) =  Arg_Sloc
               then
                  New_Arg_Node := Node;
                  return Abandon;
               else
                  return OK;
               end if;

            end Find;

         begin
            Tmp := Parent (Arg_Node);

            while not Is_Rewrite_Substitution (Tmp) loop
               Tmp := Parent (Tmp);
            end loop;

            Find_Rewr_Aggr (Tmp);

            pragma Assert (Present (New_Arg_Node));

            Result_Entity := Etype (New_Arg_Node);
         end;

      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));
         Res_Spec_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 => Res_Spec_Case,
                                  In_Unit   => Result_Unit);
   end Expr_Type;

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

   function Full_View_Visible
     (Priv_Type : Node_Id;
      Ref       : Node_Id)
      return      Boolean
   is
      Type_Scope      : constant 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_Discriminant_From_Type --
   --------------------------------

   function Get_Discriminant_From_Type (N : Node_Id) return Entity_Id is
      Res_Chars : constant Name_Id := Chars (N);
      Result    : Entity_Id        := Parent (N);
   begin
      while Nkind (Result) /= N_Subtype_Declaration loop
         Result := Parent (Result);

         if Nkind (Result) = N_Allocator then
            Result := Etype (Result);

            while Ekind (Result) in Access_Kind loop
               Result := Directly_Designated_Type (Result);
            end loop;

            exit;
         end if;
      end loop;

      if Nkind (Result) = N_Subtype_Declaration then
         Result := Defining_Identifier (Result);
      end if;

      while
        Result /= Etype (Result)
      loop
         exit when Comes_From_Source (Result)
                 and then
                    Comes_From_Source (Parent (Result))
                 and then
                    Nkind (Parent (Result)) /= N_Subtype_Declaration;
         Result := Etype (Result);
      end loop;

      Result := Parent (Result);
      Result := First (Discriminant_Specifications (Result));

      while Present (Result) loop
         if Chars (Defining_Identifier (Result)) = Res_Chars then
            Result := Defining_Identifier (Result);
            exit;
         else
            Result := Next (Result);
         end if;
      end loop;

      pragma Assert (Present (Result));

      return Result;
   end Get_Discriminant_From_Type;

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

   function Get_Entity_From_Long_Name (N : Node_Id) return Entity_Id is
      Result      : Entity_Id        := Empty;
      Arg_Chars   : constant 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_Rewritten_Discr_Ref --
   -----------------------------

   function Get_Rewritten_Discr_Ref (N : Node_Id) return Node_Id is
      Res_Chars : constant Name_Id := Chars (N);
      Result    : Node_Id          := Parent (N);
   begin

      while not (Nkind (Result) = N_Identifier
               and then
                 Is_Rewrite_Substitution (Result)
               and then
                 Nkind (Original_Node (Result)) = N_Subtype_Indication)
      loop
         Result := Parent (Result);
      end loop;

      --  Go to the declaration of this internal subtype
      Result := Parent (Entity (Result));

      --  Now - no the constraint
      Result := Sinfo.Constraint (Sinfo.Subtype_Indication (Result));

      --  And iterating through discriminant names
      Result := First (Constraints (Result));
      Result := First (Selector_Names (Result));

      while Present (Result) loop

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

         --  Get to the next discriminant

         if Present (Next (Result)) then
            Result := Next (Result);
         else
            Result := Next (Parent (Result));

            if Present (Result) then
               Result := First (Selector_Names (Result));
            end if;

         end if;

      end loop;

      pragma Assert (Present (Result));

      return Result;
   end Get_Rewritten_Discr_Ref;

   ------------------------------
   -- 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       : constant Name_Id := Chars (Comp);
      Next_Comp       : Node_Id;

   begin

      if Ekind (Rec_Type) = E_Private_Type or else
         Ekind (Rec_Type) = E_Limited_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    : constant 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) in 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_Node_Kind : Node_Kind;
      Arg_Kind : constant Internal_Element_Kinds := Int_Kind (Reference_I);

      Result_Node      : Node_Id                := Empty;
      Result_Unit      : Compilation_Unit;
      Spec_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;

      Result : Asis.Element;

      function Ekind (N : Node_Id) return Entity_Kind;
      --  This function differs from Atree.Ekind in that it can operate
      --  with N_Defining_Program_Unit_Name (in this case it returns
      --  Atree.Ekind for the corresponding Defining_Identifier node.

      function Ekind (N : Node_Id) return Entity_Kind is
         Arg_Node : Node_Id := N;
      begin

         if Nkind (Arg_Node) = N_Defining_Program_Unit_Name then
            Arg_Node := Defining_Identifier (Arg_Node);
         end if;

         return Atree.Ekind (Arg_Node);

      end Ekind;

   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;

      if Special_Case (Reference_I) = Rewritten_Named_Number then
         Arg_Node := R_Node (Reference_I);
      else
--         Arg_Node := Get_Actual_Type_Name (Node (Reference_I));
         Arg_Node := Node (Reference_I);
      end if;

      --  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 Special_Case (Reference_I) = Rewritten_Named_Number then
         --  See BB10-002
         Result_Node := Original_Entity (Arg_Node);

      elsif No (Entity (Arg_Node)) then

         Arg_Node_Kind := Nkind (Original_Node (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 Entity_Present (Original_Node (Parent (Arg_Node))) or else
               Entity_Present (Parent (Arg_Node))
            then
               Arg_Node := Parent (Arg_Node);

               --  In case of renamings, here we may have the expanded name
               --  rewritten, and the Entity field for the new name pointing
               --  to the renamed entity, but not to the entity defined by
               --  the renamed declaration, see B924-A13

               if Is_Rewrite_Substitution (Arg_Node) and then
                  Entity_Present (Original_Node (Arg_Node))
               then
                  Arg_Node := Original_Node (Arg_Node);
               end if;

            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_Component_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 (Parent (Arg_Node)));
            --  Here we are in N_Full_Type_Declaration node
            Result_Node := Defining_Identifier (Result_Node);
            Result_Node := Component_Type (Result_Node);

            Spec_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 (Original_Node (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 conditions 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 (Parent (Parent (Arg_Node))) = N_Raise_Constraint_Error
         then
            --  A whole aggregate is rewritten into N_Raise_Constraint_Error
            --  node, see G628-026

            Tmp_Node := Parent (Parent (Arg_Node));
            Tmp_Node := Etype (Tmp_Node);
            Tmp_Node := First_Entity (Tmp_Node);

            while Present (Tmp_Node) loop

               if Chars (Tmp_Node) = Chars (Arg_Node) then
                  Result_Node := Tmp_Node;
                  exit;
               end if;

               Tmp_Node := Next_Entity (Tmp_Node);
            end loop;

            pragma Assert (Present (Result_Node));

            if not (Comes_From_Source (Result_Node))
              and then
               Comes_From_Source (Parent (Result_Node))
            then
               Result_Node := Defining_Identifier (Parent (Result_Node));
            end if;

         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      := Parent (Parent (Arg_Node)); --  aggregate
            Association_Type := Etype (Result_Node);

            if Ekind (Association_Type) in Private_Kind then
               Association_Type := Full_View (Association_Type);
            end if;

            Result_Node := First_Entity (Association_Type);

            while Chars (Result_Node) /= Chars (Arg_Node) loop
               Result_Node := Next_Entity (Result_Node);
            end loop;

         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))));

            if Ekind (Association_Type) = E_Record_Subtype then
               --  In case of a subtype it may be the case that some components
               --  depending on discriminant are skipped in case of a static
               --  discriminnat constraint, see also
               --  A4G.Mapping.Set_Inherited_Components
               Association_Type := Etype (Association_Type);
            end if;

            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);

            Result_Node := Search_Record_Comp (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 Internal_Implementation_Error;
      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 /= Original_Node (Sinfo.Expression (Parent (Arg_Node)))
      then
         --  We use Original_Node (Sinfo.Expression (Parent (Arg_Node)))
         --  because of C730-016 (named numbers rewritten into their values)

         if No (Original_Discriminant (Arg_Node)) then
            Result_Node := Get_Discriminant_From_Type (Arg_Node);
         else
            Result_Node := Original_Discriminant (Arg_Node);

            if Present (Corresponding_Discriminant (Result_Node)) then
               Result_Node := Corresponding_Discriminant (Result_Node);
            end if;
         end if;

      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;

      --  Here we have Result_Node set. And now we have a whole bunch of
      --  situations when we have to correct Result_Node because of different
      --  reasons

      --  If Result_Node is the type reference, and the type has both private
      --  and full view, Result_Node will point to the private view. In some
      --  situations we have to replace it with the full view.

      if Ekind (Result_Node) in Einfo.Type_Kind
        and then
          Nkind (Original_Node (Parent (Result_Node))) in
           N_Private_Extension_Declaration .. N_Private_Type_Declaration
        and then
          Full_View_Visible
            (Priv_Type => Parent (Result_Node),
             Ref       => Arg_Node)
      then
         Result_Node := Full_View (Result_Node);
      end if;

      --  FB02-015: Ada 2005 - reference to a record type with self-referencing
      --            components, The front-end creates an incomplete type
      --            declaration, and the Entity field may point to this
      --            incomplete type.

      if Ekind (Result_Node) = E_Incomplete_Type
        and then
         not Comes_From_Source (Result_Node)
        and then
         Nkind (Parent (Result_Node)) = N_Incomplete_Type_Declaration
      then
         Tmp_Node := Full_View (Result_Node);

         if Present (Tmp_Node) then
            Result_Node := Full_View (Result_Node);
         end if;

      end if;

      --  F818-A05: reference to a formal parameter of a child subprogram in
      --            case when the subprogram does not have a separate spec.
      --            The front-end creates some artificial data structures to
      --            represent this separate spec, so the entity field of a
      --            parameter reference points to some artificial node

      if Nkind (Parent (Result_Node)) = N_Parameter_Specification
        and then
         not (Comes_From_Source (Result_Node))
      then

         --  Check if we are in the artificial spec created for child
         --  subprogram body:

         Tmp_Node := Scope (Result_Node);
         Tmp_Node := Parent (Parent (Parent (Tmp_Node)));

         if  Nkind (Tmp_Node) = N_Subprogram_Declaration
            and then
             not Comes_From_Source (Tmp_Node)
            and then
             Present (Parent_Spec (Tmp_Node))
            and then
             Present (Corresponding_Body (Tmp_Node))
         then

            --  Go to the defining identifier of this parameter in subprogram
            --  body:
            Tmp_Node := Corresponding_Body (Tmp_Node);
            Tmp_Node := Parent (Parent (Tmp_Node));
            Tmp_Node := First_Non_Pragma (Parameter_Specifications (Tmp_Node));

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

               Tmp_Node := Next_Non_Pragma (Tmp_Node);
            end loop;

            pragma Assert (Present (Tmp_Node));

         end if;

      end if;

      --  E802-015: for a protected operation items that do not have separate
      --  specs the front-end creates these specs and sets all the Entity
      --  fields pointing to the entities from these artificial specs.

      if Is_Artificial_Protected_Op_Item_Spec (Result_Node) then

         if Ekind (Result_Node) in Formal_Kind then
            Tmp_Node := Parent (Parent (Parent (Result_Node)));
            Tmp_Node := Parent (Corresponding_Body (Tmp_Node));
            Tmp_Node := First_Non_Pragma (Parameter_Specifications (Tmp_Node));

            while Present (Tmp_Node) loop

               if Chars (Defining_Identifier (Tmp_Node)) =
                 Chars (Result_Node)
               then
                  Result_Node := Defining_Identifier (Tmp_Node);
                  exit;
               else
                  Tmp_Node := Next_Non_Pragma (Tmp_Node);
               end if;

            end loop;
         else
            --  The only possibility - the protected operation entity
            Result_Node := Corresponding_Body (Parent (Parent (Result_Node)));
         end if;

      end if;

      --  See E421-006: problem with reference to a formal type in an expanded
      --  code.
      if Present (Result_Node)
        and then
         Is_Itype (Result_Node)
--        and then Present (Cloned_Subtype (Result_Node))
      then

         if Special_Case (Reference_I) = Dummy_Base_Attribute_Prefix then
            Result_Node := Associated_Node_For_Itype (Result_Node);
         else
            Result_Node := Etype (Result_Node);
         end if;

         --  This is for E912-013
         if No (Parent (Result_Node))
          and then
            Present (Associated_Node_For_Itype (Result_Node))
         then
            Result_Node :=
              Defining_Identifier (Associated_Node_For_Itype (Result_Node));
         elsif Special_Case (Reference_I) = Dummy_Base_Attribute_Prefix then
            Result_Node := Defining_Identifier (Result_Node);
         end if;

      end if;

      --  Problem with System redefined with Extend_System pragma (E315-001)

      if Nkind (Arg_Node) in N_Has_Chars
       and then
         Chars (Arg_Node) = Name_System
       and then
         Chars (Result_Node) /= Name_System
       and then
         Nkind (Parent (Result_Node)) = N_Defining_Program_Unit_Name
      then
         Result_Node := Entity (Sinfo.Name (Parent (Result_Node)));
         pragma Assert (Chars (Result_Node) = Name_System);
      end if;

      --  Problem with tasks defined by a single task definition: for such a
      --  definition the front-end creates an artificial variable declaration
      --  node, and for the references to such task, the Entity field points to
      --  the entity node from this artificial variable declaration (E224-024).
      --  The same problem exists for a single protected declaration
      --  (E418-015)

      Tmp_Node := Parent (Result_Node);

      if Comes_From_Source (Result_Node)
        and then
          not Comes_From_Source (Tmp_Node)
        and then
          Nkind (Tmp_Node) = N_Object_Declaration
        and then
          not Constant_Present (Tmp_Node)
        and then
          No (Corresponding_Generic_Association (Tmp_Node))
      then
         Tmp_Node := Etype (Result_Node);

         if Ekind (Tmp_Node) in Concurrent_Kind then
            Result_Node := Parent (Result_Node);

            while not (Nkind (Result_Node) = N_Task_Type_Declaration
                     or else
                       Nkind (Result_Node) = N_Protected_Type_Declaration)
            loop
               Result_Node := Prev (Result_Node);
            end loop;

         end if;

         Result_Node := Defining_Identifier (Original_Node (Result_Node));

      end if;

      --  F703-020: see the comment marked by this TN in the body of
      --  A4G.A_Sem.Get_Corr_Called_Entity

      if not Comes_From_Source (Result_Node)
        and then
         Is_Overloadable (Result_Node)
        and then
          Present (Alias (Result_Node))
        and then
            not (Is_Intrinsic_Subprogram (Result_Node))
        and then
            Pass_Generic_Actual (Parent (Result_Node))
      then
         --  ???
         Result_Node := Alias (Result_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 subprogram 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
          Nkind (Tmp_Node) in Sinfo.N_Entity
        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 := Original_Node (Parent (Parent (Result_Node)));

      while Nkind (Tmp_Node) = N_Subprogram_Renaming_Declaration
         and then
            not (Comes_From_Source (Tmp_Node))
         and then
            not Pass_Generic_Actual (Tmp_Node)
      loop
         --  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.
         --
         --  We have to do this in a loop in case of nested instantiations

         Result_Node := Sinfo.Name   (Tmp_Node);

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

         Result_Node := Entity (Result_Node);

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

--      --  ???

--      if Ekind (Result_Node) = E_Operator then
--         Result_Kind := N_Defining_Identifier_Mapping (Result_Node);
--      end if;

      if Nkind (Parent (Result_Node)) = N_Defining_Program_Unit_Name or else
         Nkind (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 (the first part of the condition).
         --  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;

         if Nkind (Result_Node) /= N_Defining_Program_Unit_Name then
            Result_Node := Parent (Result_Node);
         end if;

         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;

      --  FA13-008: subtype mark in parameter specification in implicit "/="
      --  declaration in case if in the corresponding "=" the parameter is
      --  specified by 'Class attribute:

      if Nkind (Arg_Node) = N_Identifier
       and then
        not Comes_From_Source (Arg_Node)
       and then
        Ekind (Result_Node) = E_Class_Wide_Type
       and then
        Result_Node /= Defining_Identifier (Parent (Result_Node))
      then
         Result_Node := Defining_Identifier (Parent (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_Attribute_Reference
                   and then
                      (Attribute_Name (Association_Type) =
                         Name_Unrestricted_Access
                      or else
                       Attribute_Name (Association_Type) = Name_Access)
                  then
                     --  See G222-012
                     Association_Type := Prefix (Association_Type);
                  end if;

                  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 := Scope (Result_Node);

                  end if;

               when others =>
                  --  We set Association_Type as Empty to indicate the case of
                  --  a definitely explicit result

                  Association_Type := Empty;
            end case;

         end if;

         if Present (Association_Type) then

            if not (Comes_From_Source (Association_Type)
                  and then
                    Nkind (Association_Type) in N_Entity
                  and then
                    Ekind (Association_Type) in Einfo.Type_Kind)
            then
               Association_Type := Etype (Association_Type);
            end if;

            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

               if Ekind (Result_Node) = E_Component
                 and then
                  not Comes_From_Source (Parent (Result_Node))
                 and then
                  Ekind (Association_Type) in Private_Kind
               then
                  Association_Type := Full_View (Association_Type);
               end if;

               Association_Type :=
                  Explicit_Type_Declaration_Unwound_Unaccess
                    (Association_Type, Arg_Node);

               if Nkind (Original_Node (Association_Type)) in
                 N_Protected_Type_Declaration ..
                 N_Private_Extension_Declaration
               then
                  Association_Type :=
                    Parent
                      (Full_View (Defining_Identifier (Original_Node
                        (Association_Type))));
               end if;

            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 Ekind (Tmp_Node) = E_Record_Subtype then
               Tmp_Node := Etype (Tmp_Node);
            end if;

            if (Ekind (Result_Node) = E_Component
               or else
                Ekind (Result_Node) = E_Discriminant)
             and then
               not (Comes_From_Source (Result_Node)
                  and then
                    not Comes_From_Source (Parent (Result_Node)))
            then
               --  This condition leaves unchanged inherited discriminants
               --  of derived record types

               Tmp_Node := First_Entity (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;

            --  Patch for E407-A08

            if Ekind (Result_Node) = E_Component then
               Result_Node := Original_Record_Component (Result_Node);
            end if;

         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
        or else
         Sloc (Result_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 Ekind (Result_Node) = E_Operator then
            return Nil_Element;
         else
            --  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...
            Spec_Case := Explicit_From_Standard;
         end if;

      else

         if Result_Kind in Internal_Defining_Operator_Kinds then

            if Is_Predefined (Result_Node) then
               Spec_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
            elsif Is_Impl_Neq (Result_Node) then
               Spec_Case := Is_From_Imp_Neq_Declaration;
            end if;

         end if;
      end if;

      -------------------
      -- Limited views --
      -------------------

      if Spec_Case = Not_A_Special_Case then

         Tmp_Node := Result_Node;

         if Nkind (Tmp_Node) = N_Defining_Program_Unit_Name then
            Tmp_Node := Defining_Identifier (Tmp_Node);
         end if;

         if Nkind (Tmp_Node) in N_Entity then
            case Ekind (Tmp_Node) is
               when Einfo.Type_Kind =>
                  if not Comes_From_Source (Tmp_Node)
                    and then
                     Ekind (Tmp_Node) in Incomplete_Kind
                    and then
                     Present (Non_Limited_View (Tmp_Node))
                  then
                     Spec_Case   := From_Limited_View;
                     Result_Node := Non_Limited_View (Result_Node);
                  end if;
               when E_Package =>
                  if not Is_Generic_Instance (Tmp_Node) then

                     if not Analyzed (Parent (Result_Node)) then
                        Spec_Case := From_Limited_View;
                     elsif Is_Limited_Withed (Result_Node, Reference_I) then
                        Spec_Case := From_Limited_View;
                     end if;

                  end if;
               when others =>
                  null;
            end case;
         end if;
      end if;

      if Spec_Case not in Predefined
        and then
         Spec_Case /= Is_From_Imp_Neq_Declaration
        and then
         Spec_Case /= From_Limited_View
        and then
         not Comes_From_Source (Result_Node)
        and then
         No (Association_Type)
        and then
         not Part_Of_Pass_Generic_Actual (Result_Node)
      then
         --  Here we may have the following possibilities:
         --  - library-level subprogram instantiation;
         --  - artificial entity created for an inner package from a package
         --    "withed" by a limited with clause;
         --  - defining name from the artificial spec created for subprogram
         --    body which acts as a spec;
         --  - prefix of the artificial 'Class attribute reference (ASIS has
         --    to emulate such an attribute reference in case if a class-wide
         --    type is use as an actual type in the instantiation);
         --  - index (sub)type in case if the corresponding type is declared as
         --    private (F424-A01);
         --  - F619-024;
         --  - F627-001
         --  - inherited subprogram;

         if Nkind (Parent (Result_Node)) in N_Subprogram_Specification then

            if Is_Generic_Instance (Result_Node) then
               --  Library-level subprogram instantiation
               --  Here we have to go from the rewritten to the original
               --  tree structure

               --  This code appeared at some point, but it seems that it is
               --  of no real need. Will be for a while - just in case.
               --  It does not allow to fix G312-006
               --  ???

--             Result_Node := Parent (Parent (Parent (Parent (Result_Node))));
--             Result_Node := Original_Node (Result_Node);
--             Result_Node := Sinfo.Defining_Unit_Name (Result_Node);
               null;
            else
               --  Artificial subprogram spec created for the body acting
               --  as spec
               Result_Node := Parent (Parent (Result_Node));
               Result_Node := Corresponding_Body (Result_Node);
            end if;

         elsif Nkind (Parent (Result_Node)) = N_Package_Specification
             and then
               Comes_From_Source (Parent (Result_Node))
         then
            --  An artificial internal entity created for a local package
            --  from a package that is "withed" by limited with clause
            --  We go to the entity node the package spec points to.
            --  See F310-025 and F311-003.
            Result_Node := Defining_Unit_Name (Parent (Result_Node));

         elsif Special_Case (Reference_I) = Dummy_Class_Attribute_Prefix
            and then
               Ekind (Result_Node) = E_Class_Wide_Type
         then
            Result_Node := Defining_Identifier (Parent (Result_Node));

         elsif Ekind (Result_Node) in Discrete_Kind
            and then
               Nkind (Parent (Result_Node)) = N_Subtype_Declaration
         then
            --  Go to the full view of the corresponding private type:
            Result_Node := Sinfo.Subtype_Indication (Parent (Result_Node));
            Result_Node := Entity (Result_Node);
            pragma Assert (Ekind (Result_Node) in Private_Kind);
            Result_Node := Full_View (Result_Node);

         elsif Ekind (Result_Node) = E_Package
            and then
               Is_Hidden (Result_Node)
            and then
               Is_Rewrite_Substitution (R_Node (Reference_I))
         then
            --  This is the case when we have a reference to the instantiation
            --  of generic parent in the instantiation of generic child,
            --  see F619-024

            Result_Node := Entity (R_Node (Reference_I));

            if Nkind (Parent (Result_Node)) = N_Defining_Program_Unit_Name then
               Result_Node := Parent (Result_Node);
               Result_Kind := A_Defining_Expanded_Name;
            end if;

         elsif Ekind (Result_Node) = E_Package
            and then
               Nkind (Parent (Result_Node)) = N_Package_Renaming_Declaration
            and then
               not Comes_From_Source (Parent (Result_Node))
         then
            --  Reference_I is the reference to the name of the instantiation
            --  inside an expanded template, but the name of the template is
            --  the defining expanded name. In this case we have to use the
            --  entity of the rewritten node (F627-001)

            Result_Node := Entity (R_Node (Reference_I));
         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

               Result_Node := Explicit_Parent_Subprogram (Result_Node);

               --  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

         --  Here we may need to adjust the result node in case if it is an
         --  entity representing an unconstrained base type for a signed
         --  integer type (see Cstand.Create_Unconstrained_Base_Type)

         if No (Parent (Result_Node))
           and then
            Ekind (Result_Node) = E_Signed_Integer_Type
         then
            Result_Node := Parent (Scalar_Range (Result_Node));
         end if;

         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;

      --  A special case of fake Numeric_Error renaming is handled
      --  separately (see B712-0050)

      if Result_Node = Standard_Constraint_Error and then
         Chars (Result_Node) /= Chars (Arg_Node)
      then
         Result := Get_Numeric_Error_Renaming;
         Set_Int_Kind (Result, A_Defining_Identifier);
      else

         Result :=
            Node_To_Element_New (Node          => Result_Node,
                                 Node_Field_1  => Association_Type,
                                 Node_Field_2  => Componnet_Name,
                                 Internal_Kind => Result_Kind,
                                 Spec_Case     => Spec_Case,
                                 Inherited     => Is_Inherited,
                                 In_Unit       => Result_Unit);
      end if;

      --  See the comment in the body of A4G.A_Sem.Get_Corr_Called_Entity

      if Present (Association_Type) then

         if Is_From_Instance (Association_Type) then
            Set_From_Instance (Result, True);
         else
            Set_From_Instance (Result, False);
         end if;

      end if;

      if Spec_Case = From_Limited_View then
         Set_From_Implicit (Result, True);
      end if;

      return Result;
   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_From_Dispatching_Call --
   ------------------------------

   function Is_From_Dispatching_Call (Reference : Element) return Boolean is
      Can_Be_Dynamically_Identified : Boolean := False;

      Ref_Node    : Node_Id;
      Parent_Ref_Node : Node_Id;

      Ref_Entity  : Entity_Id;
      Parent_Call : Node_Id := Empty;
      Result      : Boolean := False;
   begin

      Ref_Node := R_Node (Reference);

      if not (Nkind (Ref_Node) = N_Identifier
            or else
             Nkind (Ref_Node) = N_Operator_Symbol)
      then
         return False;
      end if;

      Parent_Ref_Node := Parent (Ref_Node);

      if Nkind (Parent_Ref_Node) = N_Expanded_Name
        and then
         Ref_Node = Selector_Name (Parent_Ref_Node)
      then
         Ref_Node        := Parent (Ref_Node);
         Parent_Ref_Node := Parent (Ref_Node);
      end if;

      --  First, detect if Reference indeed can be dynamically identified, that
      --  is, it is either a subprogram name in a call or a formal parameter
      --  name in a parameter association. Because of the performance reasons,
      --  we do this on the tree structures, but not using ASIS queries

      case Nkind (Parent_Ref_Node) is
         when N_Parameter_Association =>

            if Selector_Name (Parent_Ref_Node) = Ref_Node then
               Can_Be_Dynamically_Identified := True;
            end if;

         when N_Procedure_Call_Statement |
              N_Function_Call            =>

            if Sinfo.Name (Parent_Ref_Node) = Ref_Node then
               Can_Be_Dynamically_Identified := True;
            end if;

         when others =>
            null;
      end case;

      if Can_Be_Dynamically_Identified then
         Ref_Entity := Entity (Ref_Node);

         if No (Ref_Entity)
           and then
            Nkind (Parent (Ref_Node)) = N_Expanded_Name
           and then
            Ref_Node = Selector_Name (Parent (Ref_Node))
         then
            Ref_Node := Parent (Ref_Node);
            Ref_Entity := Entity (Ref_Node);
         end if;

         if Present (Ref_Entity) then

            case Ekind (Ref_Entity) is
               when Formal_Kind =>
                  Parent_Call := Parent (Parent (Ref_Node));

               when Subprogram_Kind =>
                  Parent_Call := Parent (Ref_Node);
               when others =>
                  null;
            end case;

         end if;

         if Present (Parent_Call)
          and then
            (Nkind (Parent_Call) = N_Procedure_Call_Statement
            or else
             Nkind (Parent_Call) = N_Function_Call)
          and then
            Present (Controlling_Argument (Parent_Call))
         then
            Result := True;
         end if;

      end if;

      return Result;

   end Is_From_Dispatching_Call;

   ----------------------------
   -- Is_Implicit_Formal_Par --
   ----------------------------

   function Is_Implicit_Formal_Par (Result_El : Element) return Boolean is
      Result      :          Boolean := False;
      Res_Node    : constant Node_Id := Node (Result_El);
      Parent_Node :          Node_Id;
   begin

      if Nkind (Res_Node) in N_Entity
       and then
         Ekind (Res_Node) in Formal_Kind
      then
         Parent_Node := Parent (Res_Node);

         if Present (Parent_Node)
           and then
            Nkind (Parent_Node) = N_Parameter_Specification
           and then
            Res_Node /= Defining_Identifier (Parent_Node)
         then
            --  The condition is no more then just a clue...
            Result := True;
         end if;

      end if;

      return Result;
   end Is_Implicit_Formal_Par;

   -----------------------
   -- Is_Limited_Withed --
   -----------------------

   function Is_Limited_Withed
     (E         : Entity_Id;
      Reference : Asis.Element)
      return Boolean
   is
      Result : Boolean := False;
      CU_E   : Asis.Compilation_Unit;
      CU_R   : Asis.Compilation_Unit;
   begin
      CU_E :=  Enclosing_Unit (Encl_Cont_Id (Reference), E);

      if Unit_Kind (CU_E) = A_Package then
         CU_R := Enclosing_Compilation_Unit (Reference);

         if not Is_Equal (CU_R, CU_E) then
            declare
               CU_E_Name : constant Program_Text :=
                 To_Upper_Case (Unit_Full_Name (CU_E));

               Comp_Clauses : constant Asis.Element_List :=
                 Context_Clause_Elements (CU_R);

               Name_List : Element_List_Access;
            begin
               for C in Comp_Clauses'Range loop
                  if Trait_Kind (Comp_Clauses (C)) in
                       A_Limited_Trait .. A_Limited_Private_Trait
                  then
                     Name_List :=
                       new Asis.Element_List'(Clause_Names (Comp_Clauses (C)));

                     for N in Name_List'Range loop
                        if To_Upper_Case (Full_Name_Image (Name_List (N))) =
                                CU_E_Name
                        then
                           Free (Name_List);
                           Result := True;
                           exit;
                        end if;
                     end loop;

                     Free (Name_List);
                  end if;
               end loop;
            end;
         end if;
      end if;

      return Result;
   end Is_Limited_Withed;

   -----------------------------------
   -- 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 : constant 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
            --  cannot 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     : constant 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_Id : Name_Id;
   begin

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

         if Pragma_Name_Id = Name_Asynchronous or else
            Pragma_Name_Id = Name_Convention   or else
            Pragma_Name_Id = Name_Export       or else
            Pragma_Name_Id = Name_Import       or else
            Pragma_Name_Id = 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 Present (N)
                 and then
                  (not (Sloc (N) <= Standard_Location
                  --  !!! Note, that this check filters out the predefined
                  --  implicitly declared operations!!!
                     or else
                        Part_Of_Pass_Generic_Actual (N)
                     or else
                       (Ekind (N) in Subprogram_Kind and then
                        Is_Formal_Subprogram (N))))
               then
                  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 : constant 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 : constant 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       : constant 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;

   ------------------------
   -- Search_Record_Comp --
   ------------------------

   function Search_Record_Comp (Selector_Name : Node_Id) return Entity_Id is
      Result    :           Entity_Id := Empty;
      Res_Chars : constant Name_Id   := Chars (Selector_Name);
      Aggr_Type :           Entity_Id;
   begin
      Aggr_Type := Parent (Selector_Name);

      while not (Nkind (Aggr_Type) = N_Extension_Aggregate
                or else
                 Nkind (Aggr_Type) = N_Aggregate
                or else
                 No (Aggr_Type))
      loop
         Aggr_Type := Parent (Aggr_Type);
      end loop;

      if No (Aggr_Type) then
         --  This definitely means that something went wrong...
         pragma Assert (False);
         return Empty;
      end if;

      Aggr_Type := Etype (Aggr_Type);

      while Ekind (Aggr_Type) /= E_Record_Type loop

         if Ekind (Aggr_Type) = E_Private_Type
           or else
            Ekind (Aggr_Type) = E_Limited_Private_Type
           or else
            Ekind (Aggr_Type) = E_Record_Type_With_Private
         then
            Aggr_Type := Full_View (Aggr_Type);
         else
            Aggr_Type := Etype (Aggr_Type);
         end if;
      end loop;

      Result := First_Entity (Aggr_Type);

      while Chars (Result) /= Res_Chars loop
         Result := Next_Entity (Result);
      end loop;

      pragma Assert (Present (Result));
      return Result;
   end Search_Record_Comp;

   -------------------
   -- To_Upper_Case --
   -------------------

   function To_Upper_Case (S : Wide_String) return Wide_String is
      Result : Wide_String (S'Range);
   begin
      for J in Result'Range loop
         Result (J) := Ada.Wide_Characters.Unicode.To_Upper_Case (S (J));
      end loop;

      return Result;
   end To_Upper_Case;

end A4G.Expr_Sem;
