------------------------------------------------------------------------------
--                                                                          --
--                           GNATELIM COMPONENTS                            --
--                                                                          --
--                      G N A T E L I M . O U T P U T                       --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                     Copyright (C) 1998-2011, AdaCore                     --
--                                                                          --
-- 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 Ada.Characters.Handling;          use Ada.Characters.Handling;
with Ada.Strings.Fixed;                use Ada.Strings.Fixed;

with ASIS_UL.Common;
with ASIS_UL.Global_State;             use ASIS_UL.Global_State;
with ASIS_UL.Global_State.CG;          use ASIS_UL.Global_State.CG;
with ASIS_UL.Global_State.CG.Gnatelim; use ASIS_UL.Global_State.CG.Gnatelim;
with ASIS_UL.Output;                   use ASIS_UL.Output;
with ASIS_UL.Source_Table;             use ASIS_UL.Source_Table;
with ASIS_UL.Strings;                  use ASIS_UL.Strings;

with Gnatelim.Options;

package body Gnatelim.Output is

   -----------------------
   -- Local_Subprograms --
   -----------------------

   procedure Generate_Eliminate_Pragma (N : GS_Node_Id);
   --  Generates an Eliminate pragma for a subprogram indicated by N

   function Strip_Column (SLOC_Str : String) return String;
   --  Strips the column part(s) of SLOC, we need this to correspond to the
   --  existing format of Eliminate pragmas

   ----------------
   -- Brief_Help --
   ----------------

   procedure Brief_Help is
   begin
      Info ("usage: gnatelim [options] -main=main_unit_name {filename} "    &
            "[-cargs gcc_switches]");

      Info ("");
      Info ("options:");
      Info (" -files=filemane    - name of text file containing a list of " &
            "Ada units");
      Info ("                      to analyse");

      Info (" -l[=log_file_name] - create a log file. log_file_name "       &
            "specifies the log name,");
      Info ("                      if not present 'gnatelim.log' is used");
      Info (" --no-elim-dispatch - do not generate pragmas for dispatching " &
            "operations");
      Info (" --ignore=filename  - do not generate pragmas for units listed " &
            "in filename");
      Info (" -q                 - quiet mode");
      Info (" -v                 - verbose mode");
      Info (" -t                 - output execution time");
      Info (" -wq                - quet warning mode - some warnings are "  &
            "suppressed)");
      Info (" -o=filename        - send output to filename");

      Info ("");

      Info ("filename            - name of the Ada source file "            &
            "to be analyzed.");
      Info ("                      Wildcards are allowed");
      Info ("main_unit_name      - name of main subprogram of the "         &
            "partition to analyse");
      Info ("");
      Info ("gcc_switches        - switches to be passed to gcc called by " &
            ASIS_UL.Common.Tool_Name.all);
      Info ("");

   end Brief_Help;

   -------------------------------
   -- Generate_Eliminate_Pragma --
   -------------------------------

   procedure Generate_Eliminate_Pragma (N : GS_Node_Id) is
   begin
      Report_No_EOL ("pragma Eliminate (");

      if Gnatelim.Options.Long_Pragma_Format then
         Report_No_EOL (GS_Enclosed_CU_Name (N));
         Report_No_EOL (", ");
      end if;

      Report_No_EOL (GS_Node_Name (N));
      Report_No_EOL (", ");
      Report_No_EOL ("Source_Location => """);
      Report_No_EOL (Strip_Column (Get_String (GS_Node_SLOC (N))));
      Report_No_EOL ("""");

      Report (");");

   end Generate_Eliminate_Pragma;

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

   procedure Report_Unused_Subprograms is
      No_Pragma_Reported : Boolean := True;
   begin

      Report ("---------------------------------------------------------");
      Report ("--  List of unused entities to be placed in gnat.adc.  --");
      Report ("---------------------------------------------------------");

      for J in First_GS_Node .. Last_Node loop

         if not (Present (Enclosing_Source (J))
               and then
                 Source_Info (Enclosing_Source (J)) =
                   Gnatelim.Options.Ignore_Unit)
           and then
            Is_Subprogram_Node (J)
--           and then
--            GS_Node_Kind (J) /= A_Null_Procedure
           and then
            Body_Analyzed (J)
           and then
            not Is_Abstract_Subprogram_Node (J)
           and then
            not Is_Implicit_Subprogram_Node (J)
           and then
            not Is_Of_No_Interest (J)
           and then
            not (Is_Dispatching_Operation_Node (J)
                and then
                 GS_Node_Name (J) = """=""")
           and then
            not Is_Used (J)
         then
            Generate_Eliminate_Pragma (J);
            No_Pragma_Reported := False;
         end if;

      end loop;

      if No_Pragma_Reported then
         Report ("--  No unused entities.");
      end if;

   end Report_Unused_Subprograms;

   ------------------
   -- Strip_Column --
   ------------------

   function Strip_Column (SLOC_Str : String) return String is
      Result      : String   := SLOC_Str;
      Result_Last : Natural  := Result'First - 1;

      First_Idx   : Positive := SLOC_Str'First;
      Last_Idx    : Natural;
      --  Indexes that cut the next part of SLOC_Str to copy into Result

      SLOC_Str_Last : constant Positive := SLOC_Str'Last;
   begin
      Main_Loop : loop
         Last_Idx := Index (SLOC_Str (First_Idx .. SLOC_Str_Last), ":");
         --  Fitst colon, indicates the line

         if Last_Idx = 0 then
            --  No colon any more, but we need to add closing ']' for SLOCs in
            --  expanded generics:
            for J in reverse SLOC_Str'Range loop

               if SLOC_Str (J) = ']' then
                  Result_Last          := Result_Last + 1;
                  Result (Result_Last) := ']';
               else
                  exit Main_Loop;
               end if;

            end loop;

            exit Main_Loop;
         end if;

         Last_Idx := Last_Idx + 1;

         while SLOC_Str (Last_Idx + 1) /= ':' loop
            --  Go to the second colon, which is for column number
            Last_Idx := Last_Idx + 1;
         end loop;

         Result (Result_Last + 1 .. Result_Last + (Last_Idx - First_Idx) + 1)
           := SLOC_Str (First_Idx .. Last_Idx);

         Result_Last := Result_Last + (Last_Idx - First_Idx) + 1;

         First_Idx := Last_Idx + 2;

         while Is_Digit (SLOC_Str (First_Idx)) loop
            First_Idx := First_Idx + 1;
            exit Main_Loop when First_Idx > SLOC_Str_Last;
         end loop;

      end loop Main_Loop;

      return Result (Result'First .. Result_Last);
   end Strip_Column;

end Gnatelim.Output;
