------------------------------------------------------------------------------
--                                                                          --
--                           GNATELIM COMPONENTS                            --
--                                                                          --
--                G N A T E L I M . A N A L Y Z E _ U N I T                 --
--                                                                          --
--                       P r o c e d u r e   B o d y                        --
--                                                                          --
--            Copyright (C) 1998-2006 Ada Core Technologies, Inc.           --
--                                                                          --
-- GNATELIM  is  free software;  you can  redistribute it and/or  modify it --
-- under the 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  MERCHANTABI- --
-- LITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public Li- --
-- cense 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, 51 Franklin Street, Fifth Floor, --
-- Boston, MA 02110-1301, USA.                                              --
--                                                                          --
-- The original version  of  Gnatelim  was developed by  Alain  Le  Guennec --
-- It is now maintained by AdaCore (http://www.adacore.com)                 --
--                                                                          --
------------------------------------------------------------------------------

with Gnatelim.Errors;         use Gnatelim.Errors;
with Gnatelim.Nodes;          use Gnatelim.Nodes;
with Gnatelim.Strings;        use Gnatelim.Strings;
with Gnatelim.Asis_Utilities; use Gnatelim.Asis_Utilities;
use Gnatelim;

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

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

procedure Gnatelim.Analyze_Unit
  (Unit : Compilation_Unit; Mode : Analysis_Mode)
is

   type State_Information is record
      Depth : Natural;
      Scope : Node_Key;
      TOCs  : Natural;
   end record;
   --  State during tree-traversal.
   --  Depth represents the nesting level wrt. to the top-level element.

   Force_Used : Boolean := False;
   --  ??? Force_Used, when set to True, will mark all entities called in
   --  current scope as used

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

   procedure Pre_Operation  (Element :        Asis.Element;
                             Control : in out Asis.Traverse_Control;
                             State   : in out State_Information);

   procedure Post_Operation (Element :        Asis.Element;
                             Control : in out Asis.Traverse_Control;
                             State   : in out State_Information);

   function Is_A_Scope (Element : Asis.Element) return Boolean;
   --  Returns True if Element represents an interesting Entity,
   --  ie. one that can be registered and that makes for a new scope.

   function Defining_Names (Element : Asis.Element)
                           return Asis.Defining_Name_List;
   --  Returns the list of defining names declared by the Element.
   --  If Element is A_Declaration, returns all defining names enclosed.
   --  If Element is A_Statement, returns the Statement_Identifier, if any,
   --  and the statement Element unchanged otherwise.
   --  Returns a list of 'Length zero in all other cases.

   function Corresponding_Name (Element : Asis.Element) return Wide_String;
   --  Returns the name that should be given to the Entity
   --  based on its Element and Scope components.
   --  The name of A_Defining_name Element is the defining_name.
   --  The name of A_Statement is the Statement_Identifier, if any.
   --  Other internal entities will have "appropriate" names.

   procedure New_Scope (Element : Asis.Element; Parent : Node_Key);
   --  Called when an Is_A_Scope (Element) is found.
   --  A Node corresponding to this Element is built and registered.
   --  Then the sub-tree is scanned for nested elements of interest.

   function Formal_Parameter_Name
     (Association : Asis.Association)
      return        Asis.Element;
   --  A modification of Asis.Expressions.Formal_Parameter for generic
   --  associations. It defines the name representing the formal parameter for
   --  both named and positional non-normalized associations. The result
   --  may be either of An_Expression kind if obtained from the named
   --  association, or of A_Defining_Name kind if obtained either from
   --  the positional association. Note, that here we have a limited version
   --  of this function that returns non-null result only for formal
   --  functions

   ---------------------------
   -- Formal_Parameter_Name --
   ---------------------------

   function Formal_Parameter_Name
     (Association : Asis.Association)
      return        Asis.Element
   is
      Result : Asis.Element;

      function Corresponding_Parameter_Name
        (Association : Asis.Association)
         return        Asis.Element;
      --  Gets a A_Generic_Association Element representing a positional
      --  association and computes the defining name of the corresponding
      --  formal parameter

      function Corresponding_Parameter_Name
        (Association : Asis.Association)
         return        Asis.Element
      is
         Result          : Asis.Element := Nil_Element;
         Tmp             : Asis.Element;
         Association_Num : Natural := 0;
         Formal_Num      : Natural := 0;

      begin
         Tmp := Enclosing_Element (Association);

         --  First, define the number of the corresponding parameter
         declare
            All_Associations : constant Element_List
              := Generic_Actual_Part (Tmp);
         begin
            for J in All_Associations'Range loop

               if Is_Equal (All_Associations (J), Association) then
                  Association_Num := J;
               end if;

               exit;

            end loop;

         end;

         --  Now, counting the corresponding formal parameter
         Tmp := Generic_Unit_Name (Tmp);

         if Expression_Kind (Tmp) = A_Selected_Component then
            Tmp := Selector (Tmp);
         end if;

         Tmp := Corresponding_Name_Declaration (Tmp);

         while Declaration_Kind (Tmp) in
              A_Generic_Package_Renaming_Declaration ..
              A_Generic_Function_Renaming_Declaration
         loop
            Tmp := Corresponding_Base_Entity (Tmp);

            if Expression_Kind (Tmp) = A_Selected_Component then
               Tmp := Selector (Tmp);
            end if;

            Tmp := Corresponding_Name_Declaration (Tmp);
         end loop;

         declare
            All_Gen_Pars : constant Element_List := Generic_Formal_Part (Tmp);
         begin
            for J in All_Gen_Pars'Range loop
               Formal_Num := Formal_Num + Names (All_Gen_Pars (J))'Length;

               if Formal_Num > Association_Num then
                  exit;
               end if;

               if Formal_Num = Association_Num then

                  if Declaration_Kind (All_Gen_Pars (J)) =
                     A_Formal_Function_Declaration
                  then
                     Result := Names (All_Gen_Pars (J)) (1);
                  end if;

                  exit;
               end if;

            end loop;
         end;

         return Result;

      end Corresponding_Parameter_Name;

   begin

      Result := Formal_Parameter (Association);

      if Is_Nil (Result) then
         --  Here we have a positional association...
         Result := Corresponding_Parameter_Name (Association);
      end if;

      return Result;

   end Formal_Parameter_Name;

   ---------------------
   --  Pre_Operation  --
   ---------------------

   procedure Pre_Operation (Element :        Asis.Element;
                            Control : in out Asis.Traverse_Control;
                            State   : in out State_Information) is

      Scope : Node_Key renames State.Scope;
      TOC   : TOC_Node;
      Tmp   : Asis.Element;
   begin

      if Definition_Kind (Element) = A_Protected_Definition then
         --  Declarations of protected types and objects need a special
         --  processing. The problem here is that both
         --  A_Protected_Type_Declaration and A_Single_Protected_Declaration
         --  are classified as scopes, but they do not contain any other scopes
         --  inside - all the declarations of protected operations (which are
         --  also scopes) are nested into an intermediate
         --  A_Protected_Definition Element. So, for the purposes of gnatelim
         --  processing and scope traversing, we have to skip this intermediate
         --  A_Protected_Definition Element without doing anything to use
         --  the general processing and traversing algorithm for scopes. In
         --  Post_Operation we also skip A_Protected_Definition without doing
         --  anything.
         return;
      end if;

      State.Depth := State.Depth + 1;
      Warning_Indent_Level := Warning_Indent_Level + 1;

      --  We analyze only elements _nested_ inside the top-level element.
      if State.Depth = 1 then
         return;
      end if;

      if Mode /= Instance_Bodies_Only
        or else Is_Part_Of_Instance (Element)
        or else Declaration_Kind (Element) in A_Generic_Instantiation
      then
         --  Let's check whether the current element corresponds
         --  to either a declaration of interest or a use of such an entity
         --  (via a call, an attribute reference, and so on)

         --------------------------------------------------------
         --  Check if found a nested declaration of interest,  --
         --  to be inserted in the table.                      --
         --------------------------------------------------------
         if Is_A_Scope (Element) then
            Control := Asis.Abandon_Children;

            New_Scope (Element, Scope);

            if Node_Kind (Element) in A_Package .. A_Task then
               --  We need to add this node to the list of TOCs of current
               --  scope so that "used" condition propagates by closure
               TOC.Node := Corresponding_Node (Element).Key;
               if TOC.Node /= Empty_Key then
                  TOC.Next := State.TOCs;
                  State.TOCs := Enter_TOC (TOC);
               end if;
            end if;

            if Declaration_Kind (Element) in A_Generic_Instantiation then
               --  Workaround for D527-022: We mark as used all the actuals for
               --  the formal "=" operation

               declare
                  All_Associations : constant Element_List
                     := Generic_Actual_Part (Element);
               begin
                  for J in All_Associations'Range loop

                     Tmp := Formal_Parameter_Name (All_Associations (J));

                     if Operator_Kind (Tmp) = An_Equal_Operator then
                        Tmp := Actual_Parameter (All_Associations (J));

                        if Expression_Kind (Tmp) = A_Selected_Component then
                           Tmp := Selector (Tmp);
                        end if;

                        Tmp := Corresponding_Name_Declaration (Tmp);

                        TOC.Node := Corresponding_Node (Tmp).Key;

                        if TOC.Node /= Empty_Key then
                           TOC.Next := State.TOCs;
                           State.TOCs := Enter_TOC (TOC);
                        end if;

                     end if;

                  end loop;
               end;
            end if;

         elsif Declaration_Kind (Element) in A_Generic_Declaration then
            --  We do not process generic declarations at all,
            --  as only instantiations produce eliminateable code
            Control := Asis.Abandon_Children;

         elsif      Expression_Kind (Element) = A_Function_Call
            or else Statement_Kind  (Element) = A_Procedure_Call_Statement
         then
            -------------------------------------
            --  A subprogram call to analyze.  --
            -------------------------------------
            declare
               Call_Point     : Asis.Element renames Element;
               Called_Element : Asis.Element;
            begin
               --  Optimally, we would have to check if default values
               --  for parameters are overriden for this call, and if not,
               --  we should analyze the default expression in the profile.
               --  Currently, we always analyze default expression when we
               --  encounter the spec, which is a lot more pessimistic.

               if Statement_Kind (Call_Point) = A_Procedure_Call_Statement then
                  Called_Element := Corresponding_Called_Entity (Call_Point);
               elsif Expression_Kind (Call_Point) = A_Function_Call then
                  Called_Element := Corresponding_Called_Function (Call_Point);
               end if;

               TOC.Node := Corresponding_Node (Called_Element).Key;
               --  It is not always possible to statically determine
               --  which subprogram is called, because either:
               --  ------------------------------------------
               --  -the call is a dispatching call to a dispatching operation
               --  -the prefix is an attribute_reference ('Image, 'Succ ...)
               --  (what about stream-attributes redefined by the user ?)
               --  -the prefix is an access_to_subprogram dereference

               --  Dispatching calls are not handled at this level.
               --  Instead, we mark all dispatching operations as used
               --  when their declaration is encountered.
               --  This is a bit pessimistic, but safe.

               --  We eventually have a subprogram declaration to analyze.

               if TOC.Node /= Empty_Key then
                  --  Can be empty if this entity is not intended for
                  --  elimination (part of RTL, etc.)
                  TOC.Next := State.TOCs;
                  State.TOCs := Enter_TOC (TOC);
               end if;
            end;

         elsif Attribute_Kind (Element) = An_Access_Attribute
           or else Attribute_Kind (Element) = An_Unchecked_Access_Attribute
           or else Attribute_Kind (Element) = An_Address_Attribute
           or else
           (Attribute_Kind (Element) = An_Implementation_Defined_Attribute
            and then
            To_Lower (To_String
              (Name_Image (Attribute_Designator_Identifier (Element))))
              = "unrestricted_access")
         then
            --  A possible 'Accessed element to analyze?
            TOC.Node := Corresponding_Node (Prefix (Element)).Key;
            if TOC.Node /= Empty_Key then
               --  Can be empty if this entity is not intended for
               --  elimination (part of RTL, a variable, etc.)
               TOC.Next := State.TOCs;
               State.TOCs := Enter_TOC (TOC);
            end if;

         elsif Attribute_Kind (Element) = A_Read_Attribute  or else
               Attribute_Kind (Element) = A_Write_Attribute
         then
            --  Here we may have the construct like
            --
            --   for My_Type'Read use My_Read;
            --
            --  At the moment we use over-pessimistic approach and marks
            --  My_Read as used regardless on whether or not the 'Read
            --  attribute for My_Type is ever used. More precise analysis will
            --  be possible when we have Corresponding_Pragmas implemented.
            --  From the other side, the compiler may require the body for
            --  My_Read even if the 'read attribute is never used.

            Tmp := Enclosing_Element (Element);

            if Representation_Clause_Kind (Tmp) =
               An_Attribute_Definition_Clause
            then
               Tmp := Representation_Clause_Expression (Tmp);

               --  Here we may have either a procedure name or some expression
               --  returning a subprogram as a result of de-referencing of
               --  some access_to_subprogram value. Only the first situation
               --  should be processed here

               if Expression_Kind (Tmp) = A_Selected_Component then
                  Tmp := Selector (Tmp);
               end if;

               if Expression_Kind (Tmp) = An_Identifier then
                  Tmp := Corresponding_Name_Declaration (Tmp);

                  if Declaration_Kind (Tmp) = A_Procedure_Declaration
                   or else
                     Declaration_Kind (Tmp) = A_Procedure_Body_Declaration
                   or else
                     Declaration_Kind (Tmp) =
                     A_Procedure_Renaming_Declaration
                   or else
                     Declaration_Kind (Tmp) = A_Procedure_Body_Stub
                   or else
                     Declaration_Kind (Tmp) = A_Procedure_Instantiation
                  then
                     --  And here we do exactly the same as in case of a
                     --  procedure call.

                     TOC.Node := Corresponding_Node (Tmp).Key;

                     if TOC.Node /= Empty_Key then
                        TOC.Next := State.TOCs;
                        State.TOCs := Enter_TOC (TOC);
                     end if;

                  end if;

               end if;

            end if;

         elsif Element_Kind (Element) = A_Pragma then
            --  There are basically three types of pragmas as far as gnatelim
            --  is concerned: 1) pragmas containing an ordinary expression,
            --  like Assert - this needs to be traversed; 2) pragmas
            --  containing a subprogram reference, like Export - this we
            --  explicitly mark as used; 3) all other pragmas, which we ignore

            declare
               Pragma_Name : constant String :=
                 To_Lower (To_String (Pragma_Name_Image (Element)));
            begin
               if    Pragma_Name = "assert"                  or else
                     Pragma_Name = "debug"                   or else
                     Pragma_Name = "task_info"
               then
                  --  Do nothing; this will result in a subtree rooted
                  --  at the pragma argument being traversed
                  null;

               elsif Pragma_Name = "export"                  or else
                     Pragma_Name = "export_function"         or else
                     Pragma_Name = "export_procedure"        or else
                     Pragma_Name = "export_valued_procedure" or else
                     Pragma_Name = "export_object"
               then
                  --  A possible exported subprogram to mark?
                  declare
                     Arguments : constant Asis.Association_List :=
                       Pragma_Argument_Associations (Element);

                     Referenced_Node : Node;
                  begin
                     for A in Arguments'Range loop
                        Referenced_Node :=
                          Corresponding_Node
                          (Actual_Parameter (Arguments (A)));
                        if Referenced_Node /= Empty_Node then
                           Referenced_Node.Flags (FLAG_USED) := True;
                           Register_Node (Referenced_Node);
                        end if;
                     end loop;
                  end;

               else
                  --  Not an interesting pragma. Giving up.
                  Control := Abandon_Children;

               end if;
            end;

         elsif Expression_Kind (Element) = A_Selected_Component then
            --  There is a limitation in ASIS-for-GNAT
            --  related to selected components and
            --  optimization of static expressions.
            --  We have to handle a possible failure.
            --  ??? Do we still have such a problem? It seems to be fixed
            --  completely.
            declare
               Child1, Child2 : Asis.Element;
               pragma Warnings (Off, Child1);
               pragma Warnings (Off, Child2);
            begin
               begin
                  Child1 := Asis.Expressions.Prefix   (Element);
                  Child2 := Asis.Expressions.Selector (Element);
               exception
                  when others =>
                     Warning ("Could not process a selected component");
                     Control := Abandon_Children;
               end;
            end;

         end if;

      end if;

      --  Depending on the new value of Control,
      --  the call to Post_Operation may be skipped.
      --  In that case, the Depth must be adjusted here.
      if        Control = Abandon_Children
        or else Control = Abandon_Siblings
      then
         State.Depth := State.Depth - 1;
         Warning_Indent_Level := Warning_Indent_Level - 1;
      elsif     Control = Terminate_Immediately then
         State.Depth := 0;
         Warning_Indent_Level := 0;
      end if;
   end Pre_Operation;

   ----------------------
   --  Post_Operation  --
   ----------------------

   procedure Post_Operation (Element :        Asis.Element;
                             Control : in out Asis.Traverse_Control;
                             State   : in out State_Information) is
      pragma Unreferenced (Control);
   begin
      if Definition_Kind (Element) = A_Protected_Definition then
         return;
      end if;

      State.Depth := State.Depth - 1;
      Warning_Indent_Level := Warning_Indent_Level - 1;
   end Post_Operation;

   ------------------
   --  Is_A_Scope  --
   ------------------

   function Is_A_Scope (Element : Asis.Element) return Boolean is
   begin
      case Element_Kind (Element) is

         when A_Declaration =>
            case Declaration_Kind (Element) is
               when A_Procedure_Declaration
                 |  A_Function_Declaration
                 |  A_Procedure_Body_Declaration
                 |  A_Function_Body_Declaration
                 |  A_Package_Declaration
                 |  A_Package_Body_Declaration

                 |  A_Task_Type_Declaration
                 |  A_Protected_Type_Declaration
                 |  A_Single_Task_Declaration
                 |  A_Single_Protected_Declaration
                 |  A_Task_Body_Declaration
                 |  A_Protected_Body_Declaration

                 |  A_Procedure_Body_Stub
                 |  A_Function_Body_Stub
                 |  A_Package_Body_Stub
                 |  A_Task_Body_Stub
                 |  A_Protected_Body_Stub

                 |  A_Formal_Procedure_Declaration
                 |  A_Formal_Function_Declaration
                 |  A_Formal_Package_Declaration

                 |  A_Package_Renaming_Declaration
                 |  A_Procedure_Renaming_Declaration
                 |  A_Function_Renaming_Declaration

                 |  A_Package_Instantiation
                 |  A_Function_Instantiation
                 |  A_Procedure_Instantiation

               --  ??? For the time being, we'll have to process genetics
               --  as well
                 |  A_Generic_Procedure_Declaration
                 |  A_Generic_Function_Declaration
                 |  A_Generic_Package_Declaration

                 => return True;
               when others => null;
            end case;

--           when A_Statement =>
--              if Statement_Kind (Element) = A_Block_Statement then
--                 return True;
--              end if;

         when others => null;
      end case;

      return False;
   end Is_A_Scope;

   ----------------------
   --  Defining_Names  --
   ----------------------

   function Defining_Names (Element : Asis.Element)
                           return Asis.Defining_Name_List is
   begin
      case Element_Kind (Element) is

         when A_Declaration =>
            return Asis.Declarations.Names (Element);

         when A_Statement =>
            case Statement_Kind (Element) is
               when A_Loop_Statement
                 |  A_While_Loop_Statement
                 |  A_For_Loop_Statement
                 |  A_Block_Statement =>
                  declare
                     Name : constant Asis.Defining_Name :=
                       Statement_Identifier (Element);
                  begin
                     if not Is_Nil (Name) then
                        return Defining_Name_List '(1 => Name);
                     else
                        return Defining_Name_List '(1 => Element);
                     end if;
                  end;

               when others => null;
            end case;

         when others => null;
      end case;

      return Nil_Element_List;
   end Defining_Names;

   --------------------------
   --  Corresponding_Name  --
   --------------------------

   function Corresponding_Name (Element : Asis.Element) return Wide_String is
   begin
      case Element_Kind (Element) is

         when A_Defining_Name =>
            return Defining_Name_Image (Element);

         when A_Statement =>
            case Statement_Kind (Element) is

               when A_Block_Statement =>
                  --  ??? incorrect and will result in a pragma that
                  --  compiler will ignore; corresponds to the case of scope
                  --  definition inside the 'declare' block
                  return "INTERNAL";

               when others => null;
            end case;

         when others => null;

      end case;

      return "";
   end Corresponding_Name;

   -----------------
   --  New_Scope  --
   -----------------

   procedure New_Scope (Element : Asis.Element; Parent : Node_Key)
   is

      Control     : Asis.Traverse_Control;
      Declaration : Asis.Declaration;
      State       : State_Information := (0, Empty_Key, 0);
      N           : Node;
      TOC         : TOC_Node;

      procedure Traverse_Scope (Scope : Asis.Element);
      --  Traverses the subtree rooted at new scope

      --------------------
      -- Traverse_Scope --
      --------------------

      procedure Traverse_Scope (Scope : Asis.Element) is
         procedure Traverse is new Asis.Iterator.Traverse_Element
           (State_Information, Pre_Operation, Post_Operation);
         N : Node;
      begin
         if Is_Nil (Scope) then
            return;
         end if;
         Control := Asis.Continue;
         State.Depth := 0;

         Traverse (Scope, Control, State);
         pragma Assert (State.Depth = 0);

         --  Store the detected Tacos within the scope
         N := Retrieve_Node (State.Scope);
         N.TOC_Head := State.TOCs;
         Register_Node (N);
      end Traverse_Scope;

   begin
      if not Is_A_Scope (Element) then
         return;
      end if;

      --  We do not register entity completion, only the first declaration.
      --  In addition, if Mode is Instance_Bodies_Only, we do not register the
      --  nodes that aren't part of instance as they've already been ref'd.
      if not Is_A_Completion (Element)
        and then (Mode /= Instance_Bodies_Only
                    or else Is_Part_Of_Instance (Element))
      then
         --  This is not a declaration of a previous declaration.
         --  It is its own completion.
         Declaration := Element;

         declare
            Names : constant Asis.Defining_Name_List
              := Defining_Names (Element);
         begin
            for DN in Names'Range loop
               declare
                  E    : constant Asis.Element := Names (DN);
                  Name : constant Wide_String  := Text_Name_Unwinded (E);
               begin
                  N := Node'
                    (Kind        => Node_Kind (Element),
                     --  We are not interested in its defining name!
                     Parent_Link => Parent,
                     TOC_Head    => 0,
                     Name        => Enter_String (Corresponding_Name (E)),
                     Homonym_Id  => Empty_String,
                     Flags       => Empty_Flags,
                     Key         => (Parent.File, SLOC (E), 0));

                  N.Flags (FLAG_USED) := Force_Used;

                  if Get_String (N.Key.File) /= Name then
                     N.Key.File   := Enter_String (Name);
                  end if;
                  --  We don't want to store each filename more than once, so
                  --  all nested scopes shall use the filename stored with
                  --  the root scope unless unit boundary is crossed

                  --  Obtain the instantiation point if it Is_Part_Of_Instance
                  --  or an instantiation of an instantiation
                  N.Key.Scope :=
                    Corresponding_Node (Corresponding_Instance (Element));

                  pragma Assert (Parent.Scope = 0 or else N.Key.Scope /= 0);
                  --  "if parent is part of instance, child can't not be"

                  if Operator_Kind (E) = An_Equal_Operator then
                     --  Since ASIS-for-GNAT doesn't have implementation for
                     --  Corresponding_Equality_Operator as of 11/29/99, all
                     --  "=" operators are marked as used so that there aren't
                     --  any problems with "/=" operators
                     N.Flags (FLAG_USED) := True;
                     Warning ("Equality operator, can't be eliminated yet.");
                  end if;

                  --  Since tracking calls to dispatching operations
                  --  is too complex, we mark them as used, always.
                  if Asis.Declarations.Is_Dispatching_Operation (Element) then
                     N.Flags (FLAG_USED) := True;
                     Warning
                       ("Dispatching operation found, can't be eliminated.");
                  end if;

                  if Asis.Extensions.Is_Exported (E) then
                     N.Flags (FLAG_USED) := True;
                     Warning
                       ("Exported operation found, can't be eliminated.");
                  end if;

                  if Declaration_Kind (Element) in A_Renaming_Declaration then
                     --  There is no reason to eliminate ransoming - they do
                     --  not have any code of their own
                     N.Flags (FLAG_NEVER_ELIMINATE) := True;
                  end if;

                  --  Use different mechanism to identify homonyms depending on
                  --  the user switches
                  --
                  --  ??? We do this for every scope, not only for subprograms

                  --  Even if there are no homonyms, we still can't use
                  --  the short form of Eliminate pragma because of the
                  --  situations such as this:
                  --    package P is procedure Proc; end P;
                  --    package body P is
                  --       procedure Proc is ...
                  --       procedure Proc (B : Boolean) is ...
                  --    begin
                  --       Proc (True);
                  --    end P;
                  --  For Proc defined in the spec, Has_Homonym=False, but
                  --  generating pragma Eliminate (P, Proc) is wrong.

                  if Eliminate_Homonyms_By_Profile then
                     N.Homonym_Id := Build_Profile (E);
                  else
                     N.Homonym_Id := Build_Sloc_Trace (E);
                  end if;

                  if Declaration_Kind (Element) in
                     A_Procedure_Declaration .. A_Function_Declaration
                   and then
                     Is_Part_Of_Instance (Element)
                  then

                     declare
                        E : Asis.Element := Enclosing_Element (Element);
                     begin

                        if Declaration_Kind (E) in A_Generic_Instantiation then
                           --  This means that Element is an expanded body, and
                           --  E - the corresponding subprogram instantiation

                           E := Generic_Unit_Name (E);

                           if Expression_Kind (E) = A_Selected_Component then
                              E := Selector (E);
                           end if;

                           E := Corresponding_Name_Declaration (E);

                           --  Now E - the declaration of the corresponding
                           --  generic subprogram

                           TOC.Node := Corresponding_Node (E).Key;
                           TOC.Next := 0;
                           N.TOC_Head := Enter_TOC (TOC);
                        end if;

                     end;

                  end if;

                  Register_Node (N, Create => True);
                  --  The only location where new node might get registered!

                  Warning (Get_String (N.Name) & " registered.");
               end;

            end loop;
         end;

      else
         --  A completion: let's get the completed declaration.
         Declaration := Corresponding_Declaration (Element);
         N           := Corresponding_Node (Declaration);

         if Asis.Extensions.Is_Renaming_As_Body (Element) then
            --  If a subprogram has renaming-as-body as its completion,
            --  there is no reason to generate the Eliminate pragma for
            --  it.
            N.Flags (FLAG_NEVER_ELIMINATE) := True;
         end if;

         if N = Empty_Node then
            return;
         end if;
      end if;

      State.Scope := N.Key;
      State.TOCs  := N.TOC_Head;

      case Declaration_Kind (Element) is
         when A_Body_Stub =>
            --  The proper body is processed in the same scope
            --  as its corresponding stub.
            declare
               Proper_Body : Asis.Declaration;
            begin
               Warning ("Going from stub to proper body.");
               Proper_Body := Corresponding_Subunit (Element);

               if Is_Nil (Proper_Body) then
                  Error
                    ("gnatelim: couldn't find the proper body of a subunit.");
               else
                  Traverse_Scope (Proper_Body);
                  return;
               end if;
            end;

         when A_Renaming_Declaration =>
            --  The renamed entity is treated like it is being 'called'

            if Corresponding_Node (Element) /= Empty_Node then
               --  This IF statement is the workaround for C312-025. The
               --  problem is that the renamed entity may be somewhere in RLTY,
               --  and if RLTY units are not processed by gnatelim,
               --  Corresponding_Node returns Empty_Node as for non-registered
               --  Element. As a result, this Empty_Node will be placed
               --  in the transfers chain for the node corresponding to the
               --  renaming, and if the renaming is used, we will have to
               --  make (in Gnatelim.Nodes.Transitive_Closure) the transitive
               --  closure for Empty_Node, which is definitely wrong

               TOC.Node   := Corresponding_Node (Element).Key;
               TOC.Next   := State.TOCs;
               State.TOCs := Enter_TOC (TOC);
               Traverse_Scope (Corresponding_Element (Element));
            end if;

            return;

         when A_Generic_Instantiation =>
            --  We traverse the new scope that results from this
            --  instantiation
            declare
               E : constant Asis.Element
                 := Corresponding_Declaration (Element);
            begin

               if Mode /= Instance_Bodies_Only
                 or else Is_Part_Of_Instance (Element)
               then
                  Warning ("Going to instance declaration.");
                  New_Scope (E, N.Key);
               elsif Mode = Instance_Bodies_Only then
                  Warning ("Scanning instance declaration for instances.");
                  Traverse_Scope (E);
               end if;

               if Mode /= No_Instance_Bodies then
                  Warning ("Going to instance body.");
                  New_Scope (Corresponding_Body (Element), N.Key);
               end if;

               --  We need to link this node to the instantiation
               --  so that "used" condition propagates by closure
               if N.Kind = A_Package_Instance
                 or else N.Kind = A_Subprogram_Instance then
                  TOC.Node := Corresponding_Node (E).Key;
                  if TOC.Node /= Empty_Key then
                     TOC.Next := 0;
                     N.TOC_Head := Enter_TOC (TOC);
                     Register_Node (N);
                  end if;
               end if;
            end;

            return;

         when others =>
            null;
      end case;

      if not (Declaration_Kind (Declaration) in A_Generic_Declaration) then
         --  Then we traverse the ASIS-Tree rooted at this element.
         --  Content of generic unit is not traversed.
         State.Scope := N.Key;
         Traverse_Scope (Element);
      elsif Mode /= Instance_Bodies_Only then
         --  ??? For the time being, we have to process generic units as well,
         --  and furthermore mark all transfers of control there as used, since
         --  we have problems tracking instantiations
         State.Scope := N.Key;
         declare
            Old_Force_Used : constant Boolean := Force_Used;
         begin
            Force_Used := True;
            Traverse_Scope (Element);
            Force_Used := Old_Force_Used;
         end;
      end if;

   end New_Scope;

begin

   declare
      Unit_Element : Asis.Declaration;
      N : Node;
   begin

      if Is_Nil (Unit) then
         Unit_Element := Nil_Element;
      else
         Unit_Element := Unit_Declaration (Unit);
      end if;

      if not Is_Nil (Unit_Element) then
         New_Scope (Element  => Unit_Element,
                    Parent =>   Empty_Key);

         --  We mark this scope as used so that all elaboration calls are
         --  marked used during the closure phase
         N := Corresponding_Node (Unit_Element);
         if N /= Empty_Node then
            N.Flags (FLAG_USED) := True;
            Register_Node (N);
         end if;
      end if;

   end;

end Gnatelim.Analyze_Unit;
