-------------------------------------------------------------------------------
--
-- <STRONG>Copyright (c) 2001, 2002 by Thomas Wolf.</STRONG>
-- <BLOCKQUOTE>
--    This piece of software 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. This unit is distributed in the hope that it will be
--    useful, but <EM>without any warranty</EM>; without even the implied
--    warranty of <EM>merchantability or fitness for a particular purpose.</EM>
--    See the GNU General Public License for  more details. You should have
--    received a copy of the GNU General Public License with this distribution,
--    see file "<A HREF="GPL.txt">GPL.txt</A>". If not, write to the Free
--    Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
--    USA.
-- </BLOCKQUOTE>
-- <BLOCKQUOTE>
--   As a special exception from the GPL, if other files instantiate generics
--   from this unit, or you link this unit with other files to produce an
--   executable, this unit does not by itself cause the resulting executable
--   to be covered by the GPL. This exception does not however invalidate any
--   other reasons why the executable file might be covered by the GPL.
-- </BLOCKQUOTE>
--
-- <DL><DT><STRONG>
-- Author:</STRONG><DD>
--   Thomas Wolf  (TW)
--   <ADDRESS><A HREF="mailto:twolf@acm.org">twolf@acm.org</A></ADDRESS></DL>
--
-- <DL><DT><STRONG>
-- Purpose:</STRONG><DD>
--   Utilities for hashing.</DL>
--
-- <DL><DT><STRONG>
-- Tasking semantics:</STRONG><DD>
--   N/A. Not abortion-safe.</DL>
--
-- <DL><DT><STRONG>
-- Storage semantics:</STRONG><DD>
--   No dynamic storage allocation.</DL>
--
-- <!--
-- Revision History
--
--   31-DEC-2001   TW  Initial version.
--   18-JUN-2003   TW  Added 'Hash_Case_Insensitive'.
-- -->
-------------------------------------------------------------------------------

pragma License (Modified_GPL);

with Ada.Characters.Handling;

package body GAL.Support.Hashing is

   function Internal_Is_Prime
     (X : in Hash_Type)
     return Boolean
   is
      --  Precondition: X mod 2 = 1 and X mod 3 /= 0!
      D   : Hash_Type := 5;
      Inc : Hash_Type := 2;
   begin
      while D * D <= X loop
         if X mod D = 0 then return False; end if;
         D := D + Inc; Inc := 6 - Inc;
      end loop;
      return True;
   end Internal_Is_Prime;

   function Is_Prime
     (X : in Hash_Type)
     return Boolean
   is
   begin
      return X mod 2 = 1 and then X mod 3 /= 0 and then
             Internal_Is_Prime (X);
   end Is_Prime;

   function Next_Prime
     (After : in Hash_Type)
     return Hash_Type
   is
      P   : Hash_Type := After;
      Inc : Hash_Type := 4;
   begin --  Next_Prime
      --  If it is even, make it odd.
      if P mod 2 = 0 then P := P + 1; end if;
      --  If it is a multiple of three, go to the next odd number and adjust
      --  the initial increment.
      if P mod 3 = 0 then P := P + 2; Inc := 2; end if;
      --  Alternatingly add 2 and 4. This avoids all multiples of 3.
      while not Internal_Is_Prime (P) loop
         P := P + Inc; Inc := 6 - Inc;
      end loop;
      return P;
   end Next_Prime;

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

   function Hash
     (S : in String)
     return Hash_Type
   is
      G : Hash_Type;
      H : Hash_Type := 0;
   begin
      for I in S'Range loop
         H := H * 16 + Character'Pos (S (I));
         G := H and 16#F0000000#;
         if G /= 0 then
            H := H xor (G / (2 ** 24));
            H := H xor G;
         end if;
      end loop;
      return H;
   end Hash;

   function Hash_Case_Insensitive
     (S : in String)
     return Hash_Type
   is
      G : Hash_Type;
      H : Hash_Type := 0;
   begin
      for I in S'Range loop
         H :=
           H * 16 + Character'Pos (Ada.Characters.Handling.To_Lower (S (I)));
         G := H and 16#F0000000#;
         if G /= 0 then
            H := H xor (G / (2 ** 24));
            H := H xor G;
         end if;
      end loop;
      return H;
   end Hash_Case_Insensitive;

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

   function Increase
     (Policy       : access Linear_Growth_Policy;
      Current_Size : in     Size_Type)
     return Size_Type
   is
   begin
      return Current_Size + Policy.Increment;
   end Increase;

   function Increase
     (Policy       : access Double_Growth_Policy;
      Current_Size : in     Size_Type)
     return Size_Type
   is
   begin
      return Current_Size +
             Size_Type'Min (Policy.Maximum_Increment, Current_Size);
   end Increase;

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

   function Next
     (Policy     : access Default_Collision_Policy;
      Current    : in     Size_Type;
      Hash       : in     Hash_Type;
      Table_Size : in     Size_Type;
      Count      : in     Positive)
     return Hash_Type
   is
   begin
      if Count = 1 then
         Policy.Step := 1 + Hash mod (Table_Size - 2);
      elsif Size_Type (Count) > Table_Size then
         return 0;
      end if;
      return (Current + Policy.Step) mod Table_Size;
   end Next;

end GAL.Support.Hashing;
