-------------------------------------------------------------------------------
-- (C) Altran Praxis Limited
-------------------------------------------------------------------------------
--
-- The SPARK toolset 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 3, or (at your option) any later
-- version. The SPARK toolset is distributed in the hope that it will be
-- useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY 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 the SPARK toolset; see file
-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy of
-- the license.
--
--=============================================================================

------------------------------------------------------------------------------
-- SPARKSimp                                                                --
--                                                                          --
-- This program traverses a directory and all of its subdirectories trying  --
-- to find any files (typically VCG or DPC files) that need to be processed
-- by the specified analysis tool(s) (for instance Simplifier, ZombieScope,
-- Victor).
--                                                                          --
-- This program can only be compiled with GNAT 5.04 or later, since it      --
-- relies on several of the GNAT.* predefined library units.                --
------------------------------------------------------------------------------

with Ada.Real_Time;
with Ada.Exceptions;
with Ada.Text_IO;

with GNAT.Regpat;
with GNAT.Directory_Operations;
with GNAT.IO_Aux;
with GNAT.OS_Lib;
with GNAT.Traceback.Symbolic;

with Version;

with CMD;
with Work_Manager;
with Utility;
with Workers;

use type Ada.Real_Time.Time;

use type GNAT.OS_Lib.String_Access;
use type GNAT.OS_Lib.Argument_List;
use type GNAT.Regpat.Match_Location;

use type Work_Manager.AnalysisType;

procedure SPARKSimp
is
   ---------------------------------------------------------------------------
   --  Utility subprogams                                                   --
   ---------------------------------------------------------------------------

   --  Print tool banner to Standard_Output
   procedure Banner
   is
   begin
      Ada.Text_IO.Put_Line ("SPARKSimp " &
                              Version.Toolset_Banner_Line);
      Ada.Text_IO.Put_Line (Version.Toolset_Copyright);

      --  Report location of simplifier, ZombieScope and Victor binaries -
      --  this should prevent "running the wrong simplifier by accident"
      --  problems
      if Workers.Spadesimp_Exe /= null then
         Ada.Text_IO.Put_Line ("Simplifier  binary located at: " &
                                 Workers.Spadesimp_Exe.all);
      end if;

      if Workers.ZombieScope_Exe /= null then
         Ada.Text_IO.Put_Line ("ZombieScope binary located at: " &
                                 Workers.ZombieScope_Exe.all);
      end if;

      if CMD.Run_Victor then
         if Workers.Victor_Exe /= null then
            Ada.Text_IO.Put_Line ("Victor binary located at: " &
                                    Workers.Victor_Exe.all);
         end if;
      end if;

      if CMD.Run_Riposte then
         if Workers.Riposte_Exe /= null then
            Ada.Text_IO.Put_Line ("Riposte located at: " &
                                    Workers.Riposte_Exe.all);
         end if;
         if Workers.Python_Exe /= null then
            Ada.Text_IO.Put_Line ("Python located at: " &
                                    Workers.Python_Exe.all);
         end if;
      end if;

      Ada.Text_IO.New_Line;
   end Banner;


   --  returns True if Left is older than (i.e. preceeds) Right
   function Is_Older (Left, Right : in GNAT.OS_Lib.OS_Time) return Boolean
   is
      Result : Boolean;
      use GNAT.OS_Lib;
   begin
      if GM_Year (Left) = GM_Year (Right) then
         if GM_Month (Left) = GM_Month (Right) then
            if GM_Day (Left) = GM_Day (Right) then
               if GM_Hour (Left) = GM_Hour (Right) then
                  if GM_Minute (Left) = GM_Minute (Right) then
                     Result := GM_Second (Left) <
                       GM_Second (Right);
                  else
                     Result := GM_Minute (Left) <
                       GM_Minute (Right);
                  end if;
               else
                  Result := GM_Hour (Left) <
                    GM_Hour (Right);
               end if;
            else
               Result := GM_Day (Left) <
                 GM_Day (Right);
            end if;
         else
            Result := GM_Month (Left) <
              GM_Month (Right);
         end if;
      else
         Result := GM_Year (Left) <
           GM_Year (Right);
      end if;
      return Result;
   end Is_Older;


   --  Traverses all files and directories rooted at current-working
   --  directory, find VCG and DPC files that need analysis, and put
   --  them into Work_Manager.
   --
   --  A VCG or DPC file need analysis (simplification) if either:
   --   1) The CMD.All_Files flag is True, or
   --   2) The VCG (DPC) file has no corresponding SIV (SDP) file, or
   --   3) The VCG (DPC) file has a corresponding SIV (SDP) file, but the
   --      SIV (SDP) file's time stamp os older than that of the
   --      VCG (DPC) file.
   --  A VCG file also needs analysis (victor) if CMD.Run_Victor is
   --  true and if either:
   --   1) The VCT file does not exist yet, or
   --   2) The VCT file is older than the VCG file, or
   --   3) The VCT file is older than the SIV file.
   --  Finally, if Cmd.Run_Riposte is true and:
   --   1) The RSM file does not exist yet, or
   --   2) The RSM file is older than the VCG file, or
   --   3) The RSM file is older than the SIV file.
   procedure Find_Files_To_Analyse
   is
      use GNAT.Directory_Operations;

      procedure Scan_Directory (Dir : in Dir_Name_Str);

      function File_Needs_Analysis (File : in String) return Boolean
      is
         Result : Boolean;
      begin
         if Utility.Is_A_VCG_File (File) or Utility.Is_A_DPC_File (File) then

            if CMD.All_Files then
               Result := True;
            else
               declare
                  Simplified_File      : String (1 .. File'Length);
                  Victored_File        : String (1 .. File'Length);
                  Riposte_Summary_File : String (1 .. File'Length);
                  File_Time            : GNAT.OS_Lib.OS_Time;
                  Simplified_File_Time : GNAT.OS_Lib.OS_Time;
                  Victored_File_Time   : GNAT.OS_Lib.OS_Time;
                  Riposte_File_Time    : GNAT.OS_Lib.OS_Time;
               begin
                  Simplified_File := File;
                  Victored_File := File;
                  Riposte_Summary_File := File;

                  --  Simplified VCG files end in ".siv", while
                  --  simplified DPC files end in ".sdp", so...
                  Simplified_File (Simplified_File'Last - 2) := 's';
                  if Utility.Is_A_VCG_File (File) then
                     Simplified_File (Simplified_File'Last - 1) := 'i';
                     Simplified_File (Simplified_File'Last)     := 'v';

                     --  Victored files end in ".vct"
                     Victored_File (Victored_File'Last) := 't';

                     --  And riposte files end with ".rsm"
                     Riposte_Summary_File (Riposte_Summary_File'Last - 2) := 'r';
                     Riposte_Summary_File (Riposte_Summary_File'Last - 1) := 's';
                     Riposte_Summary_File (Riposte_Summary_File'Last)     := 'm';
                  else
                     Simplified_File (Simplified_File'Last - 1) := 'd';
                     Simplified_File (Simplified_File'Last)     := 'p';
                  end if;



                  if GNAT.IO_Aux.File_Exists (Simplified_File) then
                     File_Time := GNAT.OS_Lib.File_Time_Stamp (File);
                     Simplified_File_Time := GNAT.OS_Lib.File_Time_Stamp
                       (Simplified_File);

                     Result := Is_Older (Simplified_File_Time, File_Time);
                  else
                     --  Simplified file does not exist, so we definitely need
                     --  to simplify the VCG or DPC file
                     Result := True;
                  end if;

                  --  Check if we need to run victor. We only do this
                  --  for VCG files.
                  if not Result and then Utility.Is_A_VCG_File (File) and then CMD.Run_Victor then
                     if GNAT.IO_Aux.File_Exists (Victored_File) then
                        Victored_File_Time := GNAT.OS_Lib.File_Time_Stamp (Victored_File);
                        Result := Is_Older (Victored_File_Time, File_Time);
                        --  If we run both victor AND the simplifier,
                        --  then a simplified file older than the
                        --  victored file is also reason to re-run
                        --  victor.
                        if CMD.Run_Simplifier then
                           Result := Result or Is_Older (Victored_File_Time, Simplified_File_Time);
                        end if;
                     else
                        --  If the vct file does not exist, we need to
                        --  run victor anyway.
                        Result := True;
                     end if;
                  end if;

                  --  Similar, for Riposte...
                  if not Result and then Utility.Is_A_VCG_File (File) and then CMD.Run_Riposte then
                     if GNAT.IO_Aux.File_Exists (Riposte_Summary_File) then
                        Riposte_File_Time := GNAT.OS_Lib.File_Time_Stamp (Riposte_Summary_File);
                        Result := Is_Older (Riposte_File_Time, File_Time);
                        --  If we run both riposte AND the simplifier,
                        --  then a simplified file older than the
                        --  riposte summary file is also reason to
                        --  re-run victor.
                        if CMD.Run_Simplifier then
                           Result := Result or Is_Older (Riposte_File_Time, Simplified_File_Time);
                        end if;
                     else
                        --  If the rsm file does not exist, we need to
                        --  run Riposte anyway.
                        Result := True;
                     end if;
                  end if;
               end;
            end if;
         else
            Result := False;
         end if;
         return Result;
      end File_Needs_Analysis;

      procedure Scan_Directory (Dir : in Dir_Name_Str)
      is
         D    : Dir_Type;
         Str  : String (1 .. 1024);
         Last : Natural;
      begin
         Open (D, Dir);
         loop
            Read (D, Str, Last);
            exit when Last = 0;

            declare
               F : constant String := Dir & Str (1 .. Last);
            begin
               if GNAT.OS_Lib.Is_Directory (F) then
                  Utility.Debug ("Found a directory : " & F);
                  --  Ignore "." and ".."
                  if ((Last = 1) and then (Str (1) = '.')) or
                    ((Last = 2) and then (Str (1) = '.' and
                                            Str (2) = '.')) then
                     null;
                  else
                     --  Recurse here
                     Scan_Directory (F & GNAT.OS_Lib.Directory_Separator);
                  end if;
               elsif File_Needs_Analysis (F) then
                  if Utility.Is_A_VCG_File (F) then
                     Utility.Debug ("Found a VCG file : " & F);
                     if CMD.Run_Simplifier then
                        Work_Manager.Jobs.Add_Work_Package (F, Work_Manager.Simplify);
                     end if;
                     --  Only add victor and riposte jobs directly if
                     --  we don't run the simplifier. Otherwise each
                     --  simplifier job will also kick off a victor
                     --  and/or riposte job.
                     if not CMD.Run_Simplifier and CMD.Run_Victor then
                        Work_Manager.Jobs.Add_Work_Package (F, Work_Manager.Victor);
                     end if;
                     if not CMD.Run_Simplifier and CMD.Run_Riposte then
                        Work_Manager.Jobs.Add_Work_Package (F, Work_Manager.Riposte);
                     end if;
                  elsif Utility.Is_A_DPC_File (F) then
                     Utility.Debug ("Found a DPC file : " & F);
                     if CMD.Run_Zombiescope then
                        Work_Manager.Jobs.Add_Work_Package (F, Work_Manager.Zombiescope);
                     end if;
                  end if;
               end if;
            end;
         end loop;
         Close (D);
      exception
         when others =>
            Close (D);
            raise;
      end Scan_Directory;

      CWD  : constant Dir_Name_Str := Get_Current_Dir;
   begin
      Scan_Directory (CWD);
   exception
      when others =>
         Ada.Text_IO.Put_Line ("Error scanning directories.");
         Work_Manager.Jobs.Clear;
   end Find_Files_To_Analyse;


   --  Run the desired analyses of all files in Work_Manager
   procedure Analyse_Files
   is

      Start_Time   : Ada.Real_Time.Time;
      End_Time     : Ada.Real_Time.Time;
      Elapsed_Time : Duration;

      Working_Set : Workers.Worker_Set (CMD.Processes);

      Job_ID : Work_Manager.Job_Index;
      TF, PF, IPF, CF, FF : Work_Manager.Job_Index;
      WA : Natural;
   begin
      --  Do we have any work?
      if Work_Manager.Jobs.Total_Number_Of_Files /= 0 then

         Start_Time := Ada.Real_Time.Clock;

         Workers.Initialize (Working_Set,
                             CMD.SArgs,
                             CMD.ZArgs,
                             CMD.VArgs,
                             CMD.RArgs);

         loop
            while Workers.Workers_Available (Working_Set) > 0 and
              Work_Manager.Jobs.Number_Of_Files
              (Of_Status => Work_Manager.Pending) /= 0
            loop
               Work_Manager.Jobs.GetNextJob (Job_ID);
               Utility.Debug ("Starting Job with JobID =" & Integer'Image (Job_ID));
               Workers.Start_Analysis (Job_ID,
                                       Working_Set);
            end loop;

            Workers.Run_Analysis (Working_Set);

            TF   := Work_Manager.Jobs.Total_Number_Of_Files;
            PF   := Work_Manager.Jobs.Number_Of_Files
              (Work_Manager.Pending);
            IPF  := Work_Manager.Jobs.Number_Of_Files
              (Work_Manager.InProgress);
            CF   := Work_Manager.Jobs.Number_Of_Files
              (Work_Manager.Finished);
            FF   := Work_Manager.Jobs.Number_Of_Files
              (Work_Manager.Failed);
            WA  := Workers.Workers_Available (Working_Set);

            Utility.Debug ("Job finished...");
            Utility.Debug ("Total      " & Integer'Image (TF));
            Utility.Debug ("Pending    " & Integer'Image (PF));
            Utility.Debug ("InProgress " & Integer'Image (IPF));
            Utility.Debug ("Finished   " & Integer'Image (CF));
            Utility.Debug ("Failed     " & Integer'Image (FF));
            Utility.Debug ("WA      is " & Integer'Image (WA));

            exit when (CF + FF = TF) and (PF = 0) and (IPF = 0);

         end loop;

         End_Time := Ada.Real_Time.Clock;
         Elapsed_Time := Ada.Real_Time.To_Duration (End_Time - Start_Time);
         Utility.Put_Message_With_Duration (Message => "Total elapsed time: ",
                                            D       => Elapsed_Time);

      end if;

   end Analyse_Files;


   --  put any errors found onto the screen
   procedure Report_Errors
   is
      Last_Job : Work_Manager.Job_Index;
   begin
      Last_Job := Work_Manager.Jobs.Total_Number_Of_Files;
      if Work_Manager.AnyFailed then
         Ada.Text_IO.New_Line;
         Ada.Text_IO.Put_Line
           ("The following files reported an error during simplification:");
         Ada.Text_IO.New_Line;
         --  number of files is always > 0 when report_errors is called
         for Job_Id in Natural range 1 .. Last_Job loop
            if Work_Manager.Jobs.Get_HasFailed (Job_Id) then
               Ada.Text_IO.Put_Line (Work_Manager.Jobs.Get_File_Name (Job_Id));
               Ada.Text_IO.Put_Line
                 ("   " & Work_Manager.Jobs.Get_WhyFailed (Job_Id));
            end if;
         end loop;
      end if;
   end Report_Errors;

begin  --  Code of SPARKSimp

   -- SPARKSimp now always uses '-' for all switches since release 8.1.5
   CMD.Process_Command_Line ('-');

   if CMD.Version_Requested then
      Banner;
   elsif CMD.Valid then
      Workers.Locate_Binaries;
      Banner;

      declare
         Found_Required_Binaries : Boolean := True;
      begin
         -- If we need the Simplifier, but can't find it, then complain
         if CMD.Run_Simplifier and Workers.Spadesimp_Exe = null then
            Found_Required_Binaries := False;
            Ada.Text_IO.Put ("Error: Can't locate ");
            if CMD.Simplifier_Exe_Switch = null then
               Ada.Text_IO.Put_Line
                 (Workers.Spadesimp_Command & " binary on PATH");
            else
               Ada.Text_IO.Put ("simplifier executable specified by ");
               Ada.Text_IO.Put_Line ("-x=" & CMD.Simplifier_Exe_Switch.all);
            end if;
         end if;

         -- If we need ZombieScope, but can't find it, then complain
         if CMD.Run_Zombiescope and Workers.ZombieScope_Exe = null then
            Found_Required_Binaries := False;
            Ada.Text_IO.Put ("Error: Can't locate ");
            if CMD.ZombieScope_Exe_Switch = null then
               Ada.Text_IO.Put_Line
                 (Workers.ZombieScope_Command & " binary on PATH");
            else
               Ada.Text_IO.Put ("ZombieScope executable specified by ");
               Ada.Text_IO.Put_Line ("-z=" & CMD.ZombieScope_Exe_Switch.all);
            end if;
         end if;

         -- If we need Victor (and Alt-Ergo), but can't find it, then complain
         if CMD.Run_Victor then
            if Workers.Victor_Exe = null then
               Found_Required_Binaries := False;
               Ada.Text_IO.Put ("Error: Can't locate ");
               Ada.Text_IO.Put_Line
                 (Workers.Victor_Command & " binary on PATH");
            end if;
         end if;

         -- If we need Riposte (and python), but can't find it, then complain
         if CMD.Run_Riposte then
            if Workers.Riposte_Exe = null then
               Found_Required_Binaries := False;
               Ada.Text_IO.Put ("Error: Can't locate ");
               Ada.Text_IO.Put_Line
                 (Workers.Riposte_Command & " binary on PATH");
            end if;
            if Workers.Python_Exe = null then
               Found_Required_Binaries := False;
               Ada.Text_IO.Put ("Error: Can't locate ");
               Ada.Text_IO.Put_Line
                 (Workers.Python_Command & " binary on PATH");
            end if;
         end if;

         if Found_Required_Binaries then
            Find_Files_To_Analyse;
            Work_Manager.Jobs.List_Jobs;
            if Work_Manager.Jobs.Total_Number_Of_Files > 0 then
               if CMD.Dry_Run then
                  Ada.Text_IO.Put_Line
                    ("Dry run mode - no simplifications performed");
               else
                  Work_Manager.Jobs.Sort_Files_By_Size;
                  Work_Manager.Jobs.Display_Status_Banner;
                  Analyse_Files;
                  Report_Errors;
               end if;
            end if;
         end if;
      end;

   else
      Banner;
      CMD.Usage;
   end if;

exception
   when E : others =>
      Ada.Text_IO.New_Line;
      Ada.Text_IO.Put_Line ("Unhandled Exception in SPARKSimp.");
      Ada.Text_IO.New_Line;
      Ada.Text_IO.Put_Line (Version.Toolset_Support_Line1);
      Ada.Text_IO.Put_Line (Version.Toolset_Support_Line2);
      Ada.Text_IO.Put_Line (Version.Toolset_Support_Line3);
      Ada.Text_IO.Put_Line (Version.Toolset_Support_Line4);
      Ada.Text_IO.New_Line;
      Ada.Text_IO.Put_Line ("Exception information:");
      Ada.Text_IO.Put_Line (Ada.Exceptions.Exception_Information (E));
      Ada.Text_IO.Put_Line ("Traceback:");
      Ada.Text_IO.Put_Line (GNAT.Traceback.Symbolic.Symbolic_Traceback (E));

end SPARKSimp;
