-------------------------------------------------------------------------------
-- (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 Ada.Characters.Handling;
with E_Strings;
with E_Strings.Not_SPARK;
with GNAT.HTable;

package body UnitManager.UnitStore is
   ---------------------------------------------------------------------------
   -- This package body is NOT SPARK, and should not be                     --
   -- presented to the Examiner                                             --
   ---------------------------------------------------------------------------

   Max_Units : constant := 1000;
   type Index is range 1 .. Max_Units;

   function Hash (Id : Unit.Id) return Index;

   package Unit_Table is new GNAT.HTable.Simple_HTable (
                                                        Header_Num => Index,
                                                        Element => Unit.Object,
                                                        No_Element => Unit.Null_Object,
                                                        Key => Unit.Id,
                                                        Hash => Hash,
                                                        Equal => Unit.Are_Equal);

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

   function Key (From_Id : Unit.Id) return E_Strings.T
   --
   -- Returns a unique key (string) for the unit.
   is
      Result : E_Strings.T := E_Strings.Empty_String;
   begin
      E_Strings.Append_Examiner_String (E_Str1 => Result,
                                        E_Str2 => From_Id.The_Name);
      E_Strings.Append_String (E_Str => Result,
                               Str   => Unit.Kind'Image (From_Id.The_Kind));
      return Result;
   end Key;

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

   function Hash (Id : Unit.Id) return Index is
      The_Key : E_Strings.T;

      function Raw_Hash (Key : String) return Index is
         type Uns is mod 2 ** 32;

         -- GNAT-Specific Import here
         function Rotate_Left (Value  : Uns;
                               Amount : Natural) return Uns;
         pragma Import (Intrinsic, Rotate_Left);

         Tmp : Uns := 0;
      begin
         for J in Key'Range loop
            Tmp := Rotate_Left (Value  => Tmp,
                                Amount => 1) + Character'Pos (Ada.Characters.Handling.To_Upper (Key (J)));
         end loop;

         return Index'First + Index'Base (Tmp mod Index'Range_Length); -- also GNAT-defined attrib
      end Raw_Hash;

   begin
      The_Key := Key (From_Id => Id);
      return Raw_Hash (Key => E_Strings.Not_SPARK.Get_String (E_Str => The_Key));
   end Hash;

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

   procedure Add (The_Unit : in     Unit.Object;
                  Added    :    out Boolean) is
   begin
      if Get (The_Unit.The_Id) = Unit.Null_Object then
         Added := True;
         Unit_Table.Set (K => The_Unit.The_Id,
                         E => The_Unit);
      else
         Added := False;
      end if;
   end Add;

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

   function Get (The_Unit : Unit.Id) return Unit.Object is
   begin
      return Unit_Table.Get (K => The_Unit);
   end Get;

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

   function Get_Body_Unit (With_Name : in E_Strings.T) return Unit.Object is
      The_Unit : Unit.Object;
   begin
      for Kind in Unit.Kind range Unit.Main_Program_Unit .. Unit.Separate_Body_Unit loop
         The_Unit := Get (The_Unit => Unit.Id'(The_Name => With_Name,
                                               The_Kind => Kind));
         exit when The_Unit /= Unit.Null_Object;
      end loop;
      return The_Unit;
   end Get_Body_Unit;

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

   function Get_Specification_Unit (With_Name : in E_Strings.T) return Unit.Object is
      The_Unit : Unit.Object;
   begin
      for Kind in Unit.Specification_Unit loop
         The_Unit := Get (The_Unit => Unit.Id'(The_Name => With_Name,
                                               The_Kind => Kind));
         exit when The_Unit /= Unit.Null_Object;
      end loop;
      return The_Unit;
   end Get_Specification_Unit;

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

   function Get_All_Units return  Units.Stack is
      CurrentUnit : Unit.Object;
      The_Units   : Units.Stack := Units.NullStack;
   begin
      CurrentUnit := Unit_Table.Get_First;
      while CurrentUnit /= Unit.Null_Object loop
         Units.Push (TheStack => The_Units,
                     TheUnit  => CurrentUnit.The_Id);
         CurrentUnit := Unit_Table.Get_Next;
      end loop;
      return The_Units;
   end Get_All_Units;

begin
   Unit_Table.Reset;
end UnitManager.UnitStore;
