-------------------------------------------------------------------------------
-- (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.
--
--=============================================================================

with SparkLex;
with RegularExpression;
with SPARK_IO;
with Directory_Operations;
with UnitManager.UnitStore;
with SparkMakeErrors;

package body UnitManager
--# own State is UnitManager.UnitStore.State;
is

   procedure Initialise
     (The_Directories : in     StringList.Object;
      Include         : in     StringList.Object;
      Exclude         : in     StringList.Object;
      Root_File       : in     E_Strings.T;
      Duplicates      : in     Boolean;
      Success         :    out Boolean)
   --# global in     CommandLineData.Content;
   --#        in     Dictionary.Dict;
   --#        in out ErrorHandler.Error_Context;
   --#        in out LexTokenManager.State;
   --#        in out SPARK_IO.File_Sys;
   --#        in out UnitStore.State;
   --#           out SparkLex.Curr_Line;
   --# derives ErrorHandler.Error_Context,
   --#         LexTokenManager.State,
   --#         SparkLex.Curr_Line,
   --#         SPARK_IO.File_Sys,
   --#         Success,
   --#         UnitStore.State            from CommandLineData.Content,
   --#                                         Dictionary.Dict,
   --#                                         Duplicates,
   --#                                         ErrorHandler.Error_Context,
   --#                                         Exclude,
   --#                                         Include,
   --#                                         LexTokenManager.State,
   --#                                         Root_File,
   --#                                         SPARK_IO.File_Sys,
   --#                                         The_Directories,
   --#                                         UnitStore.State;
   is
      Directory_It : StringList.Iterator;
      File_It      : StringList.Iterator;
      Include_It   : StringList.Iterator;
      Exclude_It   : StringList.Iterator;

      Current_Dir  : E_Strings.T;
      Current_File : E_Strings.T;

      Add_This_File : Boolean;

      The_Reg_Exp : RegularExpression.Object;

      --------------------------------------------------------------------------
      procedure Add_File (Current_File : in     E_Strings.T;
                          Duplicates   : in     Boolean;
                          Success      : in out Boolean)
      --# global in     CommandLineData.Content;
      --#        in     Dictionary.Dict;
      --#        in out ErrorHandler.Error_Context;
      --#        in out LexTokenManager.State;
      --#        in out SPARK_IO.File_Sys;
      --#        in out UnitStore.State;
      --#           out SparkLex.Curr_Line;
      --# derives ErrorHandler.Error_Context,
      --#         LexTokenManager.State,
      --#         UnitStore.State            from *,
      --#                                         CommandLineData.Content,
      --#                                         Current_File,
      --#                                         Dictionary.Dict,
      --#                                         ErrorHandler.Error_Context,
      --#                                         LexTokenManager.State,
      --#                                         SPARK_IO.File_Sys &
      --#         SparkLex.Curr_Line         from CommandLineData.Content,
      --#                                         Current_File,
      --#                                         Dictionary.Dict,
      --#                                         ErrorHandler.Error_Context,
      --#                                         LexTokenManager.State,
      --#                                         SPARK_IO.File_Sys &
      --#         SPARK_IO.File_Sys,
      --#         Success                    from *,
      --#                                         CommandLineData.Content,
      --#                                         Current_File,
      --#                                         Dictionary.Dict,
      --#                                         Duplicates,
      --#                                         ErrorHandler.Error_Context,
      --#                                         LexTokenManager.State,
      --#                                         SPARK_IO.File_Sys,
      --#                                         UnitStore.State;
      is
         Current_Unit : Unit.Object;
      begin
         -- Extract the unit
         Unit.Get_Unit (In_File  => Current_File,
                        The_Unit => Current_Unit);

         if Current_Unit = Unit.Null_Object then
            -- This will be reported as warning and the unit ignored.
            SparkMakeErrors.Report
              (The_Fault => SparkMakeErrors.Invalid_Unit,
               E_Str1    => Current_File,
               E_Str2    => E_Strings.Empty_String,
               E_Str3    => E_Strings.Empty_String);
         else
            UnitStore.Add (The_Unit => Current_Unit,
                           Added    => Success);
            if not Success then
               -- check to see if the filenames are different.  Okay if unit appears
               -- twice in same file, but fail if filenames are different, i.e.
               -- the same unit appears in more than one file.
               if E_Strings.Eq_String
                 (E_Str1 => Current_File,
                  E_Str2 => UnitStore.Get (The_Unit => Current_Unit.The_Id).The_File) then
                  Success := True;
               else
                  -- check to see whether duplicates are errors switch is set
                  -- report errors/warnings as appropriate
                  if Duplicates then
                     SparkMakeErrors.Report
                       (The_Fault => SparkMakeErrors.Duplicate_Errors,
                        E_Str1    => Current_Unit.The_Id.The_Name,
                        E_Str2    => Current_File,
                        E_Str3    => UnitStore.Get (The_Unit => Current_Unit.The_Id).The_File);
                     Success := False;
                  else
                     SparkMakeErrors.Report
                       (The_Fault => SparkMakeErrors.Duplicate_Okay,
                        E_Str1    => Current_Unit.The_Id.The_Name,
                        E_Str2    => Current_File,
                        E_Str3    => UnitStore.Get (The_Unit => Current_Unit.The_Id).The_File);
                     Success := True;
                  end if;
               end if;
            end if;
         end if;
      end Add_File;

      --------------------------------------------------------------------------
   begin
      Success := True;
      SparkLex.Clear_Line_Context;

      --ensure root file is added, even if not in current directory
      if not E_Strings.Is_Empty (E_Str => Root_File) then
         Add_File (Current_File => Root_File,
                   Duplicates   => Duplicates,
                   Success      => Success);
      end if;

      -- For all the directories
      --
      Directory_It := StringList.Get_First (In_List => The_Directories);
      while Success and not StringList.Is_Null (It => Directory_It) loop

         Current_Dir := StringList.Value (Directory_It);
         SPARK_IO.Put_String (SPARK_IO.Standard_Output, "Processing directory ", 0);
         E_Strings.Put_Line (File  => SPARK_IO.Standard_Output,
                             E_Str => Current_Dir);

         -- For all the include file regular expressions
         --
         Include_It := StringList.Get_First (In_List => Include);
         while Success and not StringList.Is_Null (It => Include_It) loop

            -- For all the files matching this regular expression
            --
            The_Reg_Exp := RegularExpression.Create (StringList.Value (Include_It));

            File_It :=
              StringList.Get_First
              (In_List => Directory_Operations.Find_Files (Matching     => The_Reg_Exp,
                                                           In_Directory => Current_Dir,
                                                           Recursively  => True));

            while Success and not StringList.Is_Null (It => File_It) loop

               Add_This_File := True;
               Current_File  := StringList.Value (File_It);

               -- don't exclude the root file
               if not E_Strings.Eq_String (E_Str1 => Current_File,
                                           E_Str2 => Root_File) then
                  -- For all the exclude file regular expressions
                  --
                  Exclude_It := StringList.Get_First (In_List => Exclude);
                  while not StringList.Is_Null (It => Exclude_It) loop

                     if RegularExpression.Matches
                       (E_Str       => Current_File,
                        The_Reg_Exp => RegularExpression.Create (StringList.Value (Exclude_It))) then

                        Add_This_File := False;
                        exit;
                     end if;
                     Exclude_It := StringList.Next (Exclude_It);
                  end loop;
               end if;

               if Add_This_File then
                  Add_File (Current_File => Current_File,
                            Duplicates   => Duplicates,
                            Success      => Success);
               end if;

               File_It := StringList.Next (File_It);
            end loop;

            Include_It := StringList.Next (Include_It);
         end loop;

         Directory_It := StringList.Next (Directory_It);
      end loop;

   end Initialise;

   -------------------------------------------------------------

   function Get_All_Units return  Units.Stack
   --# global in UnitStore.State;
   is
   begin
      return UnitStore.Get_All_Units;
   end Get_All_Units;

   -------------------------------------------------------------

   procedure Get_File (For_Unit : in     Unit.Id;
                       The_File :    out E_Strings.T;
                       Found    :    out Boolean)
   --# global in UnitStore.State;
   --# derives Found,
   --#         The_File from For_Unit,
   --#                       UnitStore.State;
   is
   begin
      The_File := UnitStore.Get (The_Unit => For_Unit).The_File;
      Found    := not E_Strings.Is_Empty (E_Str => The_File);
   end Get_File;

   -------------------------------------------------------------

   procedure Get_Unit (In_File  : in     E_Strings.T;
                       The_Unit :    out Unit.Id;
                       Found    :    out Boolean)
   --# global in UnitStore.State;
   --# derives Found,
   --#         The_Unit from In_File,
   --#                       UnitStore.State;
   is
      Current_Unit : Unit.Object;
      Id           : Unit.Id;
      All_Units    : Units.Stack;
   begin
      Found     := False;
      The_Unit  := Unit.Null_Id;
      All_Units := UnitStore.Get_All_Units;
      while not Units.IsEmpty (All_Units) loop
         Units.Pop (TheStack => All_Units,
                    TheUnit  => Id);
         Current_Unit := UnitStore.Get (The_Unit => Id);
         if E_Strings.Eq_String (E_Str1 => In_File,
                                 E_Str2 => Current_Unit.The_File) then
            Found    := True;
            The_Unit := Current_Unit.The_Id;
            exit;
         end if;
      end loop;
   end Get_Unit;

   -------------------------------------------------------------

   function Get (The_Unit : Unit.Id) return Unit.Object
   --# global in UnitStore.State;
   is
   begin
      return UnitStore.Get (The_Unit => The_Unit);
   end Get;

   -------------------------------------------------------------

   function Parent (Of_Unit : Unit.Id) return Unit.Id
   --# global in UnitStore.State;
   is
      Parent_Unit : Unit.Id;
   begin
      case Of_Unit.The_Kind is

         when Unit.Package_Specification_Unit | Unit.Main_Program_Unit | Unit.Package_Body_Unit =>
            -- These units do not have parents.
            Parent_Unit := Unit.Null_Id;

         when Unit.Separate_Body_Unit =>

            Parent_Unit := UnitStore.Get_Body_Unit (With_Name => Unit.Prefix (Of_Unit.The_Name)).The_Id;

         when Unit.Child_Specification_Unit =>

            Parent_Unit := UnitStore.Get_Specification_Unit (With_Name => Unit.Prefix (Of_Unit.The_Name)).The_Id;

      end case;
      return Parent_Unit;
   end Parent;

   -------------------------------------------------------------

   function Package_Body (For_Unit : Unit.Id) return Unit.Id
   --# global in UnitStore.State;
   is
      Result : Unit.Id;
   begin
      case For_Unit.The_Kind is

         when Unit.Specification_Unit =>

            Result := Unit.Id'(The_Name => For_Unit.The_Name,
                               The_Kind => Unit.Package_Body_Unit);

         when Unit.Package_Body_Unit =>

            Result := For_Unit;

         when Unit.Separate_Body_Unit =>

            Result := For_Unit;
            while Result.The_Kind /= Unit.Package_Body_Unit loop
               Result := Parent (Of_Unit => Result);
            end loop;

         when Unit.Main_Program_Unit =>

            Result := Unit.Null_Id;

      end case;
      return Result;
   end Package_Body;

   -------------------------------------------------------------

   function Is_A_Component (This_Unit    : Unit.Id;
                            Of_This_Unit : Unit.Id) return Boolean
   --# global in UnitStore.State;
   --
   -- Returns True is This_Unit is a component Of_This_Unit according to
   -- the rules given below
   is
      Result      : Boolean := False;
      Parent_Unit : Unit.Id;
   begin
      case This_Unit.The_Kind is

         when Unit.Private_Child_Package_Specification_Unit =>

            -- If This_Unit is a private child then it is a component
            -- Of_This_Unit if Of_This_Unit is its immediate parent.
            Result := E_Strings.Eq_String (E_Str1 => Of_This_Unit.The_Name,
                                           E_Str2 => Parent (Of_Unit => This_Unit).The_Name);

         when Unit.Public_Child_Package_Specification_Unit =>

            -- If This_Unit is a public child then it is a component
            -- Of_This_Unit if there is exactly one private parent
            -- between it and Of_This_Unit and this private parent is an
            -- immediate child Of_This_Unit.
            Parent_Unit := Parent (Of_Unit => This_Unit);
            while Parent_Unit /= Unit.Null_Id loop
               if Parent_Unit.The_Kind = Unit.Private_Child_Package_Specification_Unit then
                  Result :=
                    E_Strings.Eq_String (E_Str1 => Of_This_Unit.The_Name,
                                         E_Str2 => Parent (Of_Unit => Parent_Unit).The_Name);
                  exit;
               end if;
               Parent_Unit := Parent (Of_Unit => Parent_Unit);
            end loop;

         when others =>
            null;

      end case;
      return Result;
   end Is_A_Component;

   -------------------------------------------------------------

   function Inherited_Units (For_Unit : Unit.Id) return Units.Stack
   --# global in UnitStore.State;
   is
      Result         : Units.Stack;
      The_Unit       : Unit.Object;
      Inherited_Unit : Unit.Object;
      It             : StringList.Iterator;
   begin
      Result   := Units.NullStack;
      The_Unit := UnitStore.Get (The_Unit => For_Unit);
      if The_Unit /= Unit.Null_Object then
         It := StringList.Get_First (In_List => The_Unit.The_Inherited_Units);
         while not StringList.Is_Null (It => It) loop
            Inherited_Unit := UnitStore.Get_Specification_Unit (With_Name => StringList.Value (It));
            if Inherited_Unit /= Unit.Null_Object then
               Units.Push (TheStack => Result,
                           TheUnit  => Inherited_Unit.The_Id);
            end if;
            It := StringList.Next (It);
         end loop;
      end if;
      return Result;
   end Inherited_Units;

   -------------------------------------------------------------

   function Withed_Units (For_Unit : Unit.Id) return Units.Stack
   --# global in UnitStore.State;
   is
      Result      : Units.Stack;
      The_Unit    : Unit.Object;
      Withed_Unit : Unit.Object;
      It          : StringList.Iterator;
   begin
      Result   := Units.NullStack;
      The_Unit := UnitStore.Get (The_Unit => For_Unit);
      if The_Unit /= Unit.Null_Object then
         It := StringList.Get_First (In_List => The_Unit.The_Withed_Units);
         while not StringList.Is_Null (It => It) loop
            Withed_Unit := UnitStore.Get_Specification_Unit (With_Name => StringList.Value (It));
            if Withed_Unit /= Unit.Null_Object then
               Units.Push (TheStack => Result,
                           TheUnit  => Withed_Unit.The_Id);
            end if;
            It := StringList.Next (It);
         end loop;
      end if;
      return Result;
   end Withed_Units;

   -------------------------------------------------------------

   function Withed_Components (For_Unit : Unit.Id) return Units.Stack
   --# global in UnitStore.State;
   is
      The_Withed_Units : Units.Stack;
      Result           : Units.Stack;
      Id               : Unit.Id;
      Parent_Unit      : Unit.Id;
   begin
      Result           := Units.NullStack;
      The_Withed_Units := Withed_Units (For_Unit => For_Unit);
      while not Units.IsEmpty (The_Withed_Units) loop
         Units.Pop (TheStack => The_Withed_Units,
                    TheUnit  => Id);

         Parent_Unit := For_Unit;
         while Parent_Unit /= Unit.Null_Id loop
            if Is_A_Component (This_Unit    => Id,
                               Of_This_Unit => Parent_Unit) then
               Units.Push (TheStack => Result,
                           TheUnit  => Id);
            end if;
            Parent_Unit := Parent (Of_Unit => Parent_Unit);
         end loop;
      end loop;
      return Result;
   end Withed_Components;

   -------------------------------------------------------------

   function Separate_Units (For_Unit : Unit.Id) return Units.Stack
   --# global in UnitStore.State;
   is
      All_Units    : Units.Stack;
      Id           : Unit.Id;
      Result       : Units.Stack;
      Current_Unit : Unit.Object;
   begin
      Result    := Units.NullStack;
      All_Units := UnitStore.Get_All_Units;
      while not Units.IsEmpty (All_Units) loop
         Units.Pop (TheStack => All_Units,
                    TheUnit  => Id);
         Current_Unit := UnitStore.Get (The_Unit => Id);
         if Current_Unit.The_Id.The_Kind = Unit.Separate_Body_Unit then
            if Unit.Are_Equal (L => Parent (Of_Unit => Current_Unit.The_Id),
                               R => For_Unit) then
               Units.Push (TheStack => Result,
                           TheUnit  => Current_Unit.The_Id);
            end if;
         end if;
      end loop;
      return Result;
   end Separate_Units;

   -------------------------------------------------------------

   function Required_Units (For_Unit : Unit.Id) return Units.Stack
   --# global in UnitStore.State;
   is
      Result                : Units.Stack;
      The_Withed_Components : Units.Stack;
      Id                    : Unit.Id;
   begin
      -- We'll need all the inherited units
      Result := Inherited_Units (For_Unit => For_Unit);

      if For_Unit.The_Kind = Unit.Separate_Body_Unit then

         -- .. we need any withed components as no inherit is required
         The_Withed_Components := Withed_Components (For_Unit => For_Unit);

         while not Units.IsEmpty (The_Withed_Components) loop
            Units.Pop (TheStack => The_Withed_Components,
                       TheUnit  => Id);
            Units.Push (TheStack => Result,
                        TheUnit  => Id);
         end loop;

         -- We'll also need the body if it's a separate ...
         Units.Push (TheStack => Result,
                     TheUnit  => Parent (Of_Unit => For_Unit));

      elsif For_Unit.The_Kind = Unit.Package_Body_Unit then

         -- .. we need any withed components as no inherit is required
         The_Withed_Components := Withed_Components (For_Unit => For_Unit);

         while not Units.IsEmpty (The_Withed_Components) loop
            Units.Pop (TheStack => The_Withed_Components,
                       TheUnit  => Id);
            Units.Push (TheStack => Result,
                        TheUnit  => Id);
         end loop;

         -- ... and the spec ...
         Units.Push (TheStack => Result,
                     TheUnit  => UnitStore.Get_Specification_Unit (With_Name => For_Unit.The_Name).The_Id);

      elsif For_Unit.The_Kind in Unit.Child_Specification_Unit then
         -- ... or the parent if it's a child package specification
         Units.Push (TheStack => Result,
                     TheUnit  => Parent (Of_Unit => For_Unit));
      end if;
      return Result;
   end Required_Units;

   -------------------------------------------------------------

   function Components (For_Unit : Unit.Id) return Units.Stack
   --# global in UnitStore.State;
   is
      Result    : Units.Stack;
      Id        : Unit.Id;
      All_Units : Units.Stack;
   begin
      Result    := Units.NullStack;
      All_Units := UnitStore.Get_All_Units;
      while not Units.IsEmpty (All_Units) loop
         Units.Pop (TheStack => All_Units,
                    TheUnit  => Id);
         if Is_A_Component (This_Unit    => Id,
                            Of_This_Unit => For_Unit) then
            Units.Push (TheStack => Result,
                        TheUnit  => Id);
         end if;
      end loop;
      return Result;
   end Components;

   -------------------------------------------------------------
   -- Find the root units. Slightly trickier than it may seem at
   -- first because we are not simply dealing with relationships
   -- between packages (eg package P requires package Q) but have
   -- to consider relationships between all compilation units.
   -- For example, q.adb requires q.ads. If q.adb isn't required
   -- by anything else (ie no separates) then it would seem to be
   -- a 'root' but we must not treat it as one because any
   -- package bodies are automatically added to the meta file
   -- after their corresponding specs. So the roots we want to
   -- find are:
   --  - any main programs;
   --  - any package specifications that are not required by
   --    other packages or main programs.
   function Find_Roots return  Units.Stack
   --# global in UnitStore.State;
   is
      All_Units : Units.Stack;
      The_Unit  : Unit.Id;
      Result    : Units.Stack;

      -- Return value indicates whether there are any other units
      -- that require the given unit.
      function Is_Required (This_Unit : Unit.Id) return Boolean
      --# global in UnitStore.State;
      is
         Other_Units    : Units.Stack;
         Req_Units      : Units.Stack;
         The_Req_Unit   : Unit.Id;
         The_Other_Unit : Unit.Id;
         Found          : Boolean := False;
      begin

         Other_Units := Get_All_Units;

         -- Check whether each other unit requires this unit.
         while not Found and not Units.IsEmpty (Other_Units) loop

            Units.Pop (TheStack => Other_Units,
                       TheUnit  => The_Other_Unit);

            -- Get the required units for the other unit
            Req_Units := Required_Units (For_Unit => The_Other_Unit);

            -- Check each other unit to see if it requires this unit.
            -- If any other unit requires it then it can't be a root.
            while not Found and not Units.IsEmpty (Req_Units) loop

               Units.Pop (TheStack => Req_Units,
                          TheUnit  => The_Req_Unit);

               -- Don't count a spec as 'required' if the only thing that needs it
               -- is its own body, otherwise the presence of a body will prevent a
               -- spec from being counted as a root.
               if The_Req_Unit = This_Unit and not (Package_Body (This_Unit) = The_Other_Unit) then
                  Found := True;
               end if;

            end loop;

         end loop;

         return Found;

      end Is_Required;

   begin -- Find_Roots

      All_Units := Get_All_Units;
      Result    := Units.NullStack;

      -- Check all the units we know about...
      while not Units.IsEmpty (All_Units) loop

         Units.Pop (TheStack => All_Units,
                    TheUnit  => The_Unit);

         -- If it's a main program, or a package spec that isn't
         -- required by any other units, then it must be a root.
         -- (Bodies always depend on their specs, and separates
         -- always depend on bodies, so they can never be roots.)
         if The_Unit.The_Kind = Unit.Main_Program_Unit
           or else ((The_Unit.The_Kind in Unit.Specification_Unit) and not Is_Required (This_Unit => The_Unit)) then

            Units.Push (TheStack => Result,
                        TheUnit  => The_Unit);

         end if;

      end loop;

      return Result;

   end Find_Roots;

end UnitManager;
