------------------------------------------------------------------------------
--                                                                          --
--                            GNATELIM COMPONENTS                           --
--                                                                          --
--                       G N A T E L I M . E N T I T I E S                  --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                            $Revision: 1.22 $
--                                                                          --
--            Copyright (c) 1997-2000, Free Software Foundation, Inc.       --
--                                                                          --
-- Gnatelim 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. Gnatelim is distributed  in the hope  that it will be useful,   --
-- 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 GNAT; see file COPYING. If   --
-- not, write to the Free Software Foundation, 59 Temple Place Suite 330,   --
-- Boston, MA 02111-1307, USA.                                              --
--                                                                          --
-- Gnatelim is distributed as a part of the ASIS implementation for GNAT    --
-- (ASIS-for-GNAT).                                                         --
--                                                                          --
-- Gnatelim was originally developed by Alain Le Guennec                    --
--                                                                          --
-- Gnatelim  is  now  maintained  by  Ada  Core  Technologies  Inc          --
-- (http://www.gnat.com).                                                   --
------------------------------------------------------------------------------

with Ada.Unchecked_Conversion;
with Interfaces;        use Interfaces;

with GNATELIM.Errors;   use GNATELIM.Errors;

with Table;
with GNAT.HTable;

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

with Ada.Characters.Handling; use Ada.Characters.Handling;

package body GNATELIM.Entities is

   type Access_Wide_String is access all Wide_String;

   --  Starting with 3.10, the generic package is Standard.Table.Table.
   package List_Of_Used_Entities is new Standard.Table.Table
     (Table_Component_Type => Entity_Id,
      Table_Index_Type     => Natural,
      Table_Low_Bound      => 1,
      Table_Initial        => 10,
      Table_Increment      => 50,
      Table_Name           => "List of used entities");

   type Boolean_Flags is array (Flag_Range) of Boolean;
   --  For entities properties.

   type Static_Links  is array (Link_Range) of Entity_Id;
   --  To link entities with other entities.

   type Entity is record
      Element            : Asis.Element;
      --  This Element is always explicit (no "artificial constructs".)

      Name               : Access_Wide_String;
      --  Defining name of the entity.

      Used_Entities      : List_Of_Used_Entities.Saved_Table;
      --  List of entities used by transitivity
      --  when Entity is itself Used.
      --  We use the Save and Restore capabilities of the Table package
      --  to obtain a per-entity list of Used_Entities.

      Flags              : Boolean_Flags;
      --  Properties of entities:
      --
      --  Used               : Boolean;
      --  Set to True if Entity can't be eliminated.
      --
      --  Analyzed           : Boolean;
      --  Used to avoid loops in call-graph cycles
      --  when doing transitive analysis.

      Links              : Static_Links;
      --  Static links for various uses:
      --
      --  Instance           : Entity_Id;
      --  Since ASIS can't traverse generic-body expansions,
      --  we need to denote a given instance of an entity
      --  by using the Element in the template wrt to the right Instance.
      --  An Instance is an Entity corresponding to A_Generic_Instantiation.
      --  No_Entity is used for Entities that are not part of instance.
      --
      --  Scope              : Entity_Id;
      --  Scope containing the Entity.
      --
      --  Homonym            : Entity_Id;
      --  To keep track of overloaded subprograms.
      --
      --  Some links are also used for HTables.

   end record;
   --  Keeps information about a given entity.


   --  Starting with 3.10, the generic package is Standard.Table.Table.
   package Entity_Table is new Standard.Table.Table
     (Table_Component_Type => Entity,
      Table_Index_Type     => Entity_Id,
      Table_Low_Bound      => No_Entity,
      Table_Initial        => 100,
      Table_Increment      => 50,
      Table_Name           => "Entity table");


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

   function  Entities_Used_By (Id : Entity_Id) return Entity_Id_List;
   --  Returns all Entities used by Id Entity.


   procedure Perform_Transitive_Closure (Id : Entity_Id);
   --  ??? Documentation!!!

   function  Corresponding_Name_Definition
     (Name : Asis.Element)
      return Asis.Defining_Name;
   --  ??? Documentation!!!

   function  Get_Name
     (Entity : Entity_Id)
      return   Access_Wide_String;
   --  ??? Documentation!!!

   procedure Set_Name  (Id : Entity_Id; Name : Access_Wide_String);
   --  ??? Documentation!!!

   procedure Set_Element  (Id : Entity_Id; Element : Asis.Element);
   --  ??? Documentation!!!

   --------------------
   --  Boolean_Flag  --
   --------------------

   package body Boolean_Flag is

      --  Keep track of the flag-slot that is allocated for this instance.
      Flag_Used : constant Flag_Range := Nb_Allocated_Flags + 1;

      procedure Set_Flag (Id : Entity_Id; Flag : Boolean) is
      begin
         pragma Assert (Id in Entity_Table.First .. Entity_Table.Last);
         Entity_Table.Table (Id).Flags (Flag_Used) := Flag;
      end Set_Flag;

      function  Get_Flag (Id : Entity_Id) return Boolean is
      begin
         pragma Assert (Id in Entity_Table.First .. Entity_Table.Last);
         return Entity_Table.Table (Id).Flags (Flag_Used);
      end Get_Flag;

   begin
      Nb_Allocated_Flags := Nb_Allocated_Flags + 1;
   end Boolean_Flag;


   -------------------
   --  Static_Link  --
   -------------------

   package body Static_Link is

      --  Keep track of the link-slot that is allocated for this instance.
      Link_Used : constant Link_Range := Nb_Allocated_Links + 1;

      procedure Set_Link (Id : Entity_Id; Next : Entity_Id) is
      begin
         pragma Assert (Id in Entity_Table.First .. Entity_Table.Last);
         Entity_Table.Table (Id).Links (Link_Used) := Next;
      end Set_Link;

      function  Get_Link (Id : Entity_Id) return Entity_Id is
      begin
         pragma Assert (Id in Entity_Table.First .. Entity_Table.Last);
         return Entity_Table.Table (Id).Links (Link_Used);
      end Get_Link;

   begin
      Nb_Allocated_Links := Nb_Allocated_Links + 1;
   end Static_Link;


   -------------------
   --  Set_Element  --
   -------------------

   procedure Set_Element  (Id : Entity_Id;    Element : Asis.Element) is
   begin
      Entity_Table.Table (Id).Element := Element;
   end Set_Element;


   -------------------
   --  Get_Element  --
   -------------------

   function  Get_Element (Entity : Entity_Id)
                          return Asis.Element
   is
   begin
      return Entity_Table.Table (Entity).Element;
   end Get_Element;


   ----------------
   --  Set_Name  --
   ----------------

   procedure Set_Name  (Id : Entity_Id; Name : Access_Wide_String) is
   begin
      Entity_Table.Table (Id).Name := Name;
   end Set_Name;


   ----------------
   --  Get_Name  --
   ----------------

   function  Get_Name (Entity : Entity_Id)
                       return Access_Wide_String
   is
   begin
      return Entity_Table.Table (Entity).Name;
   end Get_Name;


   ----------------
   --  Get_Name  --
   ----------------

   function  Get_Name (Entity : Entity_Id)
                       return Wide_String
   is
   begin
      return Get_Name (Entity).all;
   end Get_Name;


   --------------------
   --  Mastery flag  --
   --------------------

   package Mastery_Flag is new Boolean_Flag;

   procedure Note_Mastery (Id : Entity_Id; Used : Boolean := True)
     renames Mastery_Flag.Set_Flag;

   function  Is_A_Master  (Entity : Entity_Id) return Boolean
     renames Mastery_Flag.Get_Flag;


   ---------------------
   --  Instance flag  --
   ---------------------

   package Instance_Flag is new Boolean_Flag;

   procedure Note_Instance  (Id : Entity_Id; Used : Boolean := True)
     renames Instance_Flag.Set_Flag;

   function  Is_An_Instance (Entity : Entity_Id) return Boolean
     renames Instance_Flag.Get_Flag;


   -----------------
   --  Used flag  --
   -----------------

   package Used_Flag is new Boolean_Flag;

   procedure Note_Use (Id : Entity_Id; Used : Boolean := True)
     renames Used_Flag.Set_Flag;

   function  Is_Used  (Entity : Entity_Id) return Boolean
     renames Used_Flag.Get_Flag;


   ---------------------
   --  Analyzed flag  --
   ---------------------

   package Analyzed_Flag is new Boolean_Flag;

   procedure Note_Analysis (Id : Entity_Id; Used : Boolean := True)
     renames Analyzed_Flag.Set_Flag;

   function  Is_Analyzed  (Id : Entity_Id)  return Boolean
     renames Analyzed_Flag.Get_Flag;


   ---------------------
   --  Instance link  --
   ---------------------

   package Instance_Link is new Static_Link;

   procedure Set_Instance (Id : Entity_Id; Instance : Entity_Id)
     renames Instance_Link.Set_Link;

   function  Get_Instance (Entity : Entity_Id)     return Entity_Id
     renames Instance_Link.Get_Link;


   ------------------
   --  Scope link  --
   ------------------

   package Scope_Link is new Static_Link;

   procedure Set_Scope (Id : Entity_Id; Scope : Entity_Id)
     renames Scope_Link.Set_Link;

   function  Get_Scope (Entity : Entity_Id)  return Entity_Id
     renames Scope_Link.Get_Link;


   --------------------
   --  Homonym link  --
   --------------------

   package Homonym_Link is new Static_Link;

   procedure Set_Homonym  (Id : Entity_Id; Homonym : Entity_Id)
     renames Homonym_Link.Set_Link;

   function  Next_Homonym (Entity : Entity_Id)    return Entity_Id
     renames Homonym_Link.Get_Link;

   function  First_Homonym (Name   : Wide_String;
                            Scope  : Entity_Id)
                            return Entity_Id;
   --  Returns the first Entity in Scope named Name.


   --------------------------------
   --  Hash Tables declarations  --
   --------------------------------

   type Hash_Range1 is range 0 .. 2**16 - 1;
   --  Used to index the Entity_Information in hash-tables.

   --  A given Entity is uniquely denoted by an Element + an Instance.
   type Key1 is record
      Element  : Asis.Element;
      Instance : Entity_Id;
   end record;

   function  Get_Key  (Entity : Entity_Id) return Key1;
   function  Is_Equal (K1, K2 : Key1)      return Boolean;
   function  Hash     (K      : Key1)      return Hash_Range1;

   package Link1 is new Static_Link;

   package Entity_HTable1 is new GNAT.HTable.Static_HTable
     (Header_Num => Hash_Range1,
      Element    => Entity,
      Elmt_Ptr   => Entity_Id,
      Null_Ptr   => No_Entity,
      Set_Next   => Link1.Set_Link,
      Next       => Link1.Get_Link,
      Key        => Key1,
      Get_Key    => Get_Key,
      Hash       => Hash,
      Equal      => Is_Equal);


   type Hash_Range2 is range 0 .. 2**8 - 2;
   --  Used to index the Entity_Information in hash-tables.
   --  IMPORTANT: the range must not be wider than 255,
   --  otherwise instances of GNAT.HTable.Hash do not work !
   --  This is clearly an hidden requirement (fixed in 3.11)

   --  A set of homonyms is uniquely denoted by a Name + a Scope.
   type Key2 is record
      Name    : Access_Wide_String;
      Scope   : Entity_Id;
   end record;

   function  Get_Key  (Entity : Entity_Id) return Key2;
   function  Is_Equal (K1, K2 : Key2)      return Boolean;
   function  Hash     (K      : Key2)      return Hash_Range2;

   package Link2 is new Static_Link;

   package Entity_HTable2 is new GNAT.HTable.Static_HTable
     (Header_Num => Hash_Range2,
      Element    => Entity,
      Elmt_Ptr   => Entity_Id,
      Null_Ptr   => No_Entity,
      Set_Next   => Link2.Set_Link,
      Next       => Link2.Get_Link,
      Key        => Key2,
      Get_Key    => Get_Key,
      Hash       => Hash,
      Equal      => Is_Equal);


   ---------------
   --  Get_Key  --
   ---------------

   function  Get_Key (Entity : Entity_Id) return Key1 is
   begin
      return Key1 '(Element  => Get_Element  (Entity),
                    Instance => Get_Instance (Entity));
   end Get_Key;


   ----------------
   --  Is_Equal  --
   ----------------

   function  Is_Equal (K1, K2 : Key1) return Boolean is
   begin
      return     K1.Instance = K2.Instance
        and then Asis.Elements.Is_Identical (K1.Element, K2.Element);
   end Is_Equal;


   ------------
   --  Hash  --
   ------------

   function  Hash (K : Key1) return Hash_Range1 is

      function To_Unsigned_32 is new
         Ada.Unchecked_Conversion
           (Source => Asis.ASIS_Integer,
            Target => Unsigned_32);

      function To_ASIS_Integer is new
         Ada.Unchecked_Conversion
           (Source => Unsigned_32,
            Target => Asis.ASIS_Integer);

      ASIS_Hash        : Asis.ASIS_Integer;
      Unsigned_32_Hash : Unsigned_32;


   begin
      ASIS_Hash        := Asis.Elements.Hash (K.Element);

      Unsigned_32_Hash := To_Unsigned_32 (ASIS_Hash);

      Unsigned_32_Hash := Unsigned_32_Hash xor
                          Rotate_Right (Unsigned_32_Hash, 16);

      ASIS_Hash        := To_ASIS_Integer (Unsigned_32_Hash);

      return Hash_Range1 (ASIS_Hash mod Positive (Hash_Range1'Last
                                        - Hash_Range1'First + 1)
                         + Integer (Hash_Range1'First));
   end Hash;

   ---------------
   --  Get_Key  --
   ---------------

   function  Get_Key (Entity : Entity_Id) return Key2 is
   begin
      return Key2 '(Name  => Get_Name  (Entity),
                    Scope => Get_Scope (Entity));
   end Get_Key;


   ----------------
   --  Is_Equal  --
   ----------------

   function  Is_Equal (K1, K2 : Key2) return Boolean is
      N1 : Wide_String := K1.Name.all;
      N2 : Wide_String := K2.Name.all;
   begin
      return     K1.Scope    = K2.Scope
--        and then K1.Name.all = K2.Name.all;
        and then N1 = N2;
   end Is_Equal;


   ------------
   --  Hash  --
   ------------

   function  Hash is new GNAT.HTable.Hash (Hash_Range2);
   --  A generic hashing function working on String keys.
   --  Hash_Range2 must not be wider than 255 (GNAT.HTable bug) !

   function  Hash (K : Key2) return Hash_Range2 is
   begin
      return Hash (To_String (K.Name.all));
   end Hash;


   ------------------------
   --  Entities_Used_By  --
   ------------------------

   function  Entities_Used_By (Id : Entity_Id) return Entity_Id_List is
   begin
      List_Of_Used_Entities.Restore (Entity_Table.Table (Id).Used_Entities);
      declare
         Results : Entity_Id_List := Entity_Id_List
           (List_Of_Used_Entities.Table
            (List_Of_Used_Entities.First .. List_Of_Used_Entities.Last));
      begin
         Entity_Table.Table (Id).Used_Entities := List_Of_Used_Entities.Save;
         return Results;
      end;
   end Entities_Used_By;


   ----------------------------------
   --  Perform_Transitive_Closure  --
   ----------------------------------

   procedure Perform_Transitive_Closure (Id : Entity_Id) is
   begin
      if not Is_Analyzed (Id) then
         Note_Analysis (Id);

         declare
            Used_Entities : Entity_Id_List := Entities_Used_By (Id);
         begin
            for E in Used_Entities'Range loop
               Note_Use (Used_Entities (E));
               Perform_Transitive_Closure (Used_Entities (E));
            end loop;
         end;

         --  Since we can't yet distinguish between homonyms,
         --  we also mark all its homonyms as used.
         declare
            Homonym : Entity_Id := First_Homonym (Id);
         begin
            while Present (Homonym) loop
               Note_Use (Homonym);
               Perform_Transitive_Closure (Homonym);
               Homonym := Next_Homonym (Homonym);
            end loop;
         end;

      end if;
   end Perform_Transitive_Closure;


   -------------------------------------
   --  Corresponding_Name_Definition  --
   -------------------------------------

   function  Corresponding_Name_Definition (Name : Asis.Element)
                                            return Asis.Defining_Name
   is
      Tmp_Name      : Asis.Expression;
      Defining_Name : Asis.Defining_Name;
   begin
      case Element_Kind (Name) is
         when An_Expression =>
            Tmp_Name := Name;
         Unwind_Selection :
            loop
               case Expression_Kind (Tmp_Name) is
                  when A_Selected_Component =>
                     Tmp_Name := Asis.Expressions.Selector (Tmp_Name);
                  when An_Identifier | An_Operator_Symbol =>
                     exit Unwind_Selection;
                  when others =>
                     return Asis.Nil_Element;
               end case;
            end loop Unwind_Selection;

            begin
               Defining_Name :=
                 Asis.Expressions.Corresponding_Name_Definition (Tmp_Name);
               --  This query may return Nil_Element for reference
               --  to implicit entities (eg. inherited/instance.)
               --  It may also raise Asis_Inappropriate_Element,
               --  if the Tmp_Name does not denote a declaration
               --  as it happens for certain pragma arguments.
            exception
               when ASIS_Inappropriate_Element =>
                  Defining_Name := Nil_Element;
            end;

            if Is_Nil (Defining_Name) then
               Warning ("Corresponding_Name_Definition not found !!!");
               return Asis.Nil_Element;
            elsif Is_Part_Of_Implicit (Defining_Name) then
               return Asis.Nil_Element;
            else
               return Defining_Name;
            end if;

         when A_Defining_Name =>
            return Name;

         when others =>
            return Asis.Nil_Element;
      end case;

   end Corresponding_Name_Definition;


   ----------
   --  No  --
   ----------

   function No (Entity : Entity_Id) return Boolean is
   begin
      return Entity = No_Entity;
   end No;


   ---------------
   --  Present  --
   ---------------

   function Present (Entity : Entity_Id) return Boolean is
   begin
      return Entity /= No_Entity;
   end Present;


   ------------------
   --  New_Entity  --
   ------------------

   function New_Entity (Element  : Asis.Element;
                        Instance : Entity_Id;
                        Name     : Wide_String;
                        Scope    : Entity_Id)
                        return Entity_Id is
      Element_Declaration : Asis.Declaration;
      New_Entity_Id       : Entity_Id;
      Homonym             : Entity_Id;
   begin
      if Present (Entity_HTable1.Get (Key1 '(Element  => Element,
                                             Instance => Instance)))
      then
         raise Already_Registered;
      end if;

      if Element_Kind (Element) = A_Defining_Name then
         Element_Declaration := Enclosing_Element (Element);
      else
         Element_Declaration := Asis.Nil_Element;
      end if;

      --  Register the entity in the entity table.
      Entity_Table.Increment_Last;
      New_Entity_Id := Entity_Table.Last;

      List_Of_Used_Entities.Init;
      Entity_Table.Table (New_Entity_Id).Used_Entities :=
        List_Of_Used_Entities.Save;

      Set_Element    (New_Entity_Id, Element);
      Set_Instance   (New_Entity_Id, Instance);
      Set_Scope      (New_Entity_Id, Scope);
      Link1.Set_Link (New_Entity_Id, No_Entity);
      Link2.Set_Link (New_Entity_Id, No_Entity);

      case Declaration_Kind (Element_Declaration) is
         when A_Procedure_Declaration
           |  A_Procedure_Body_Declaration
           |  A_Procedure_Body_Stub
           |  A_Procedure_Instantiation
           |  A_Function_Declaration
           |  A_Function_Body_Declaration
           |  A_Function_Body_Stub
           |  A_Function_Instantiation
           =>
            Note_Mastery (New_Entity_Id, True);
         when others =>
            Note_Mastery (New_Entity_Id, False);
      end case;

      Note_Instance (New_Entity_Id,
                     Declaration_Kind (Element_Declaration)
                     in A_Generic_Instantiation);

      Note_Use       (New_Entity_Id, False);
      Note_Analysis  (New_Entity_Id, False);

      --  Management of names for overloaded subprograms.
      Homonym := First_Homonym (Name, Scope);

      if No (Homonym) then
         --  We allocate a new Wide_String for this name,
         --  and register it in the homonym-hash-table.
         Set_Name    (New_Entity_Id, new Wide_String '(Name));
         Set_Homonym (New_Entity_Id, No_Entity);
         Entity_HTable2.Set (New_Entity_Id);
      else
         --  We reuse the same access string as for the first homonym,
         --  and then hook the new entity to the homonym list.
         if Name /= Get_Name (Homonym) then
            Error ("gnatelim: pb with homonym management: "
                   & Name & "/=" & Get_Name (Homonym) & " .");
         end if;
         Set_Name    (New_Entity_Id, Get_Name (Homonym));
         Set_Homonym (New_Entity_Id, Next_Homonym (Homonym));
         Set_Homonym (Homonym, New_Entity_Id);
      end if;

      --  Finally, register the new entity in the hash table.
      Entity_HTable1.Set (New_Entity_Id);

      return New_Entity_Id;
   end New_Entity;


   ---------------------------------
   --  Corresponding_Declaration  --
   ---------------------------------

   function  Corresponding_Declaration (Entity  : Entity_Id)
                                        return Asis.Declaration is
      Element : Asis.Element;
   begin
      Element := Get_Element (Entity);
      if Element_Kind (Element) = A_Defining_Name then
         return Enclosing_Element (Element);
      else
         return Asis.Nil_Element;
      end if;
   end Corresponding_Declaration;


   ---------------------
   --  First_Homonym  --
   ---------------------

   function  First_Homonym (Name  : Wide_String;
                            Scope : Entity_Id)
                            return Entity_Id
   is
      New_Name      : aliased Wide_String := Name;
   begin
      return Entity_HTable2.Get (Key2 '(Name  => New_Name'Unchecked_Access,
                                        Scope => Scope));
      --  Unchecked access is safe since no reference is kept by Get.
   end First_Homonym;


   function  First_Homonym (Entity : Entity_Id) return Entity_Id is
   begin
      return Entity_HTable2.Get (Key2 '(Name  => Get_Name  (Entity),
                                        Scope => Get_Scope (Entity)));
   end First_Homonym;


   ----------------------------
   --  Corresponding_Entity  --
   ----------------------------

   function Corresponding_Entity (Element  : Asis.Element;
                                  Instance : Entity_Id)
                                  return Entity_Id
   is
      Entity : Entity_Id;
   begin
      if    Element_Kind (Element)  = An_Expression then
         return Corresponding_Entity
           (Element  =>
              GNATELIM.Entities.Corresponding_Name_Definition (Element),
            Instance => Instance);


      elsif Element_Kind (Element)  = A_Declaration then

         if Is_Part_Of_Inherited (Element) then
            --  We have an implicitly inherited subprogram declaration.
            --  The only thing we can do with the current ASIS-for-GNAT
            --  is to go back to the explicit declaration.
            --  Anyway, getting the explicit is the right thing to do,
            --  since there is no specific body in the object file
            --  for inherited subprograms; they share the explicit body.
            return Corresponding_Entity
              (Element  =>
                 Asis.Declarations.Corresponding_Declaration (Element),
               Instance => Instance);

         elsif Declaration_Kind (Element) in
               A_Procedure_Instantiation .. A_Function_Instantiation
         then
            --  We have an instantiation of a subprogram declaration.
            --  We must go to the instantiated declaration.
            return Corresponding_Entity
              (Element  =>
                 Asis.Declarations.Corresponding_Declaration (Element),
               Instance => Instance);
         else

            --  Asis.Declarations.Names fails on inherited declarations.
            return Corresponding_Entity (
               Element  => Asis.Declarations.Names (Element) (1),
               Instance => Instance);

         end if;

      elsif Element_Kind (Element) /= A_Defining_Name then
         --  There's nothing we can do.
         return No_Entity;

      --  From now on, we can safely assume we have A_Defining_Name.

      elsif Is_Part_Of_Inherited (Element) then
         --  We have an implicitly inherited subprogram defining_name.
         --  Let's go back to the explicit declaration.

         --  Going back to explicit is only possible on _declarations_
         --  not on defining_names. Enclosing_Element must be used.

         return Corresponding_Entity
           (Element => Asis.Declarations.Corresponding_Declaration
            (Enclosing_Element (Element)),
            Instance => Instance);

      else
         --  Here we have an explicit (ie. traversable) defining name,
         --  with the corresponding enclosing instance.
         Entity := Entity_HTable1.Get (Key1 '(Element  => Element,
                                              Instance => Instance));
         if Present (Entity) then
            --  The Entity is in the current scope.
            return Entity;
         elsif No (Instance) then
            --  The Entity was not found in the current Instance,
            --  and the current Instance is not part of instance.
            --  Nothing else can be done.
            return No_Entity;
         else
            --  The Entity is not defined in the current Instance.
            --  Let's look in the instance containing the template.
            declare
               --  Here we rely on the Template being the first
               --  entity used by the instance.
               --  This is dirty: to be encapsulated.
               Used_By_Instance : Entity_Id_List :=
                 Entities_Used_By (Instance);
               Template : Entity_Id;
            begin
               if Used_By_Instance'Length > 0 then
                  Template := Used_By_Instance (Used_By_Instance'First);
                  return Corresponding_Entity
                    (Element  => Element,
                     Instance => Get_Instance (Template));
               else
                  return No_Entity;
               end if;
            end;
         end if;
      end if;
   end Corresponding_Entity;


   ----------------------
   --  Renamed_Entity  --
   ----------------------

   function  Renamed_Entity (Renaming : Entity_Id) return Entity_Id is
   begin
      return Corresponding_Entity
        (Element  => Asis.Declarations.Renamed_Entity
         (Corresponding_Declaration (Renaming)),
         Instance => Get_Instance (Renaming));
   end Renamed_Entity;


   ------------------------
   --  Unwind_Renamings  --
   ------------------------

   function  Unwind_Renamings (Entity : Entity_Id) return Entity_Id is
      Renamed : Entity_Id := Entity;
   begin
      while Declaration_Kind (Corresponding_Declaration (Renamed))
        in A_Renaming_Declaration
      loop
         Renamed := Renamed_Entity (Renamed);
      end loop;
      return Renamed;
   end Unwind_Renamings;


   ----------------
   --  Note_Use  --
   ----------------

   procedure Note_Use (Entity  : Entity_Id;
                       Used_By : Entity_Id) is
   begin
      if No (Entity) then
         --  A No_Entity. Ignored.  (???)
         null;
      elsif No (Used_By) then
         --  Either we could not determine the Master,
         --  or we want to force an inconditional use.
         --  In both case, we mark the Entity as used.
         Note_Use (Entity);
      else
         pragma Assert (Used_By in Entity_Table.First .. Entity_Table.Last);
         List_Of_Used_Entities.Restore
           (Entity_Table.Table (Used_By).Used_Entities);
         List_Of_Used_Entities.Increment_Last;
         List_Of_Used_Entities.Table (List_Of_Used_Entities.Last) := Entity;
         Entity_Table.Table (Used_By).Used_Entities :=
           List_Of_Used_Entities.Save;
      end if;
   end Note_Use;


   ----------------------------------
   --  Perform_Transitive_Closure  --
   ----------------------------------

   procedure Perform_Transitive_Closure is
   begin
      for Id in Entity_Table.First .. Entity_Table.Last loop
         if Is_Used (Id) then
            Perform_Transitive_Closure (Id);
         end if;
      end loop;
   end Perform_Transitive_Closure;


   ---------------
   --  Iterate  --
   ---------------

   procedure Iterate is
      Continue : Boolean := True;
   begin
      for Id in Entity_Id range Entity_Table.First .. Entity_Table.Last loop
         Action (Id, Continue);
         exit when not Continue;
      end loop;
   end Iterate;


begin
   --  Register the No_Entity in the entity table.
   Entity_Table.Increment_Last;

   List_Of_Used_Entities.Init;
   Entity_Table.Table (No_Entity).Used_Entities :=
     List_Of_Used_Entities.Save;

   Set_Element      (No_Entity, Asis.Nil_Element);
   Set_Instance     (No_Entity, No_Entity);
   Set_Scope        (No_Entity, No_Entity);
   Set_Name         (No_Entity, new Wide_String '(""));
   Set_Homonym      (No_Entity, No_Entity);
   Link1.Set_Link   (No_Entity, No_Entity);
   Link2.Set_Link   (No_Entity, No_Entity);
   Note_Mastery     (No_Entity, True);   --  Environment task.
   Note_Instance    (No_Entity, True);
   Note_Use         (No_Entity, False);
   Note_Analysis    (No_Entity, False);

   Entity_HTable1.Reset;
   Entity_HTable2.Reset;
   --  VERY important when actual for Elmt_Ptr is not an access type !
end GNATELIM.Entities;
