------------------------------------------------------------------------------
--                                                                          --
--                            GNATELIM COMPONENTS                           --
--                                                                          --
--                       G N A T E L I M . O U T P U T                      --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--            Copyright (c) 1997-2002, 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 GNATELIM.Entities;      use GNATELIM.Entities;

with Asis;                   use Asis;
with Asis.Implementation;
with Asis.Compilation_Units;
with Asis.Elements;          use Asis.Elements;
with Asis.Text;

with Ada.Strings;            use Ada.Strings;
with Ada.Strings.Wide_Fixed; use Ada.Strings.Wide_Fixed;
with Ada.Wide_Text_IO;       use Ada.Wide_Text_IO;

package body GNATELIM.Output is

   Nb_Unused_Subprograms : Natural;
   --  Counts unused subprograms during the iteration
   --  through registered subprogram declarations.


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

   function  Corresponding_Scopes (Entity  : Entity_Id)
                                   return Entity_Id_List;
   --  Returns the Scopes in which Entity is declared.
   --  The first element of the list is the compilation unit,
   --  the last element is the Entity itself.
   --  Corresponding_Scopes (No_Entity) returns a list
   --  with No_Entity as single element.

   function  Should_Be_Reported (Entity : Entity_Id) return Boolean;
   --  Returns True if Entity should be reported.


   function  No_Homonym_Is_Used (Entity : Entity_Id) return Boolean;


   procedure Output_Pragma (Entity : Entity_Id);
   --


   procedure Output_Text_Reference (Entity : Entity_Id);
   --


   procedure Check_If_Used (Entity   : in     Entity_Id;
                            Continue : in out Boolean);
   --  Subprogram acting as the Action actual
   --  for the generic procedure Iterate_For_Unused on Entities.


   procedure Iterate_For_Unused is new Iterate
     (Action => Check_If_Used);

   --------------------------
   -- Put_Gnatelim_Version --
   --------------------------

   procedure Put_Gnatelim_Version is
   begin
      Put ("--  GNATELIM (built with ");
      Put (Asis.Implementation.ASIS_Implementor_Version);
      Put (")");
   end Put_Gnatelim_Version;

   --------------------------
   --  Should_Be_Reported  --
   --------------------------

   function  Should_Be_Reported (Entity : Entity_Id) return Boolean is
      use Asis, Asis.Elements;

      Element : Asis.Element := Corresponding_Declaration (Entity);
   begin
      case Declaration_Kind (Element) is
         when A_Procedure_Declaration
           |  A_Function_Declaration
           |  A_Procedure_Body_Declaration
           |  A_Function_Body_Declaration
           |  A_Procedure_Body_Stub
           |  A_Function_Body_Stub
           |  A_Procedure_Renaming_Declaration
           |  A_Function_Renaming_Declaration
           |  A_Procedure_Instantiation
           |  A_Function_Instantiation
           => return True;

         when others
           => return False;
      end case;
   end Should_Be_Reported;


   ----------------------------
   --  No_Homonym_Is_Used  --
   ----------------------------

   function  No_Homonym_Is_Used (Entity : Entity_Id) return Boolean is
      Homonym : Entity_Id := First_Homonym (Entity);
   begin
      while Present (Homonym) loop
         if Is_Used (Homonym) then
            return False;
         end if;
         Homonym := Next_Homonym (Homonym);
      end loop;
      return True;
   end No_Homonym_Is_Used;


   ----------------------------
   --  Corresponding_Scopes  --
   ----------------------------

   function  Corresponding_Scopes (Entity  : Entity_Id)
                                   return Entity_Id_List is
      Scope : Entity_Id;
   begin
      if No (Entity) then
         return Entity_Id_List '(1 => No_Entity);
      else
         Scope := Get_Scope (Entity);
         if No (Scope) then
            return Entity_Id_List '(1 => Entity);
         else
            return Corresponding_Scopes (Scope) & Entity;
         end if;
      end if;
   end Corresponding_Scopes;


   ---------------------
   --  Output_Pragma  --
   ---------------------

   procedure Output_Pragma (Entity : Entity_Id) is
      Scopes           : Entity_Id_List := Corresponding_Scopes (Entity);
      First            : Entity_Id      := First_Homonym (Entity);
      No_Used_Homonyms : Boolean        := No_Homonym_Is_Used (Entity);

   begin
      pragma Assert (Scopes'Length > 0);

      --  Case when there is nothing to output:
      if (No_Used_Homonyms and then First /= Entity)
         --  All overloads are unused, and the first has already been reported.
        or else not No_Used_Homonyms
         --  Only some overloads are used, but we can't yet output the profile,
         --  so we consider this entity as also used for the moment.
      then
         return;
      end if;

      --  Now output the unit name, always present.

      Put ("pragma Eliminate (" & Get_Name (Scopes (Scopes'First)));

      if Scopes'Length > 1 then

         --  This is not a library unit.
         --  We have to output the entity name.

         Put (", ");
--          if Quote_Case then
--             Put ('"');
--          end if;


         for S in Scopes'First + 1 .. Scopes'Last loop
            declare
               Name : Wide_String := Get_Name (Scopes (S));
            begin
               for I in Name'Range loop
--                   if Name (I) = '"' then
--                      Put ('"');
--                   end if;
                  Put (Name (I));
               end loop;
            end;
            if S < Scopes'Last then
               Put ('.');
            end if;
         end loop;
--          if Quote_Case then
--             Put ('"');
--          end if;

         if not No_Used_Homonyms then
            --  There are some used homonyms in the same scope.
            --  We have to output the profile to make a difference.

            --  Not reachable at the moment anyway.
            pragma Assert (False);

            --  Output the parameter types here if any.
            Put (',');
            New_Line;
            Put ("                  Parameter_Types => (");
            --  To be completed later.
            Put (')');


            --  Output the result type if a function.
            Put (',');
            New_Line;
            Put ("                  Result_Type     => """);
            --  To be completed later.
            Put ('"');
         end if;
      end if;

      --  Let's close the pragma.
      Put_Line (");");
   end Output_Pragma;


   -----------------------------
   --  Output_Text_Reference  --
   -----------------------------

   procedure Output_Text_Reference (Entity : Entity_Id) is
      Span    : Asis.Text.Span;
      Element : Asis.Element;
      Name    : Wide_String := Get_Name (Entity);
   begin
      Element := Get_Element (Entity);

      Put (Asis.Compilation_Units.Text_Name
           (Asis.Elements.Enclosing_Compilation_Unit (Element)) & ":");
      Span := Asis.Text.Element_Span (Element);

      Put_Line (Ada.Strings.Wide_Fixed.Trim
                (Integer'Wide_Image (Span.First_Line),
                 Ada.Strings.Left) &
                ":" &
                Ada.Strings.Wide_Fixed.Trim
                (Integer'Wide_Image (Span.First_Column),
                 Ada.Strings.Left) &
                ":" &
                Name);
   end Output_Text_Reference;


   -----------------------
   --  Check if unused  --
   -----------------------

   procedure Check_If_Used (Entity   : in     Entity_Id;
                            Continue : in out Boolean) is
   begin
      if         not Is_Used (Entity)
        and then Should_Be_Reported (Entity)
--      and then Is_Library_Level (Entity)
      then
         Nb_Unused_Subprograms := Nb_Unused_Subprograms + 1;
         if Format = Text_References then
            --  Source reference form.
            Output_Text_Reference (Entity);
         else
            --  Pragma Form.
            Output_Pragma (Entity);
         end if;
      end if;
      Continue := True;
   end Check_If_Used;


   ---------------------------------
   --  Report_Unused_Subprograms  --
   ---------------------------------

   procedure Report_Unused_Subprograms is
   begin
      Put_Line ("---------------------------------------------------------");
      Put_Line ("--  List of unused entities to be placed in gnat.adc.  --");
      Put_Line ("---------------------------------------------------------");
      Nb_Unused_Subprograms := 0;
      Iterate_For_Unused;
      if Nb_Unused_Subprograms = 0 then
         Put_Line ("--  No unused entities.");
      end if;
   end Report_Unused_Subprograms;

end GNATELIM.Output;
