-- $Date: 2003/12/28 05:54:57 $
-- $Revision: 1.8 $
-- $Author: jcrocholl $

with Ada.Text_IO;
use Ada;

with Primes;
use Primes;

package body Hash_Tables is

   procedure Debug
     (Message : in String) is
   begin
      Text_IO.Put_Line(Text_IO.Current_Error, Message);
   end Debug;

   -- Put a key item pair into the hash table. Before calling this you
   -- should check that there is enough space available. The simplest
   -- way to do so is to call Put instead of Put_Internal.
   -- Raises Key_Exists if key is already in use.
   procedure Put_Internal
     (Table : in out Hash_Table;
      Key   : in Key_Type;
      Item  : in Item_Type)
   is
      Start : Positive;
      Index : Natural;
      Test  : Pair;
   begin
      Start := Hash(Key, Table.Size);
      Index := Start;
      loop
         -- pragma Debug(Debug("put: testing index" & Positive'Image(Index)));
         Test := Table.Pairs(Index);
         exit when Test.Empty;
         if Test.Key = Key then raise Key_Exists; end if;
         Index := Index - 1;
         if Index = 0 then Index := Table.Size; end if;
      end loop;
      Table.Pairs(Index).Empty := False;
      Table.Pairs(Index).Key := Key;
      Table.Pairs(Index).Item := Item;
      Table.Count := Table.Count + 1;
      -- pragma Debug(Debug("put: writing to index" & Positive'Image(Index)));
   end Put_Internal;

   -- Return true if and only if the max fill percentage has been
   -- reached and a grow and rehash operation is necessary.
   function Full
     (Table : in Hash_Table)
     return Boolean
   is
      Result : Boolean :=
        Table = null or else
        Table.Count >= Table.Size - 2 or else
        Table.Count * 100 > Table.Size * Max_Fill_Percentage;
   begin
      -- pragma Debug(Debug("full: " & Boolean'Image(Result)));
      return Result;
   end Full;

   -- Make a copy of a hash table, with a possibly different size.
   function Copy
     (Table : in Hash_Table;
      Size  : in Positive)
     return Hash_Table
   is
      New_Table : Hash_Table := new Hash_Table_Record(Size);
      Index     : Natural := 0;
      Key       : Key_Type;
      Item      : Item_Type;
   begin
      pragma Debug(Print_Usage(Table));
      pragma Debug(Debug("copy:" &
        " old size" & Positive'Image(Table.Size) &
        " new size" & Positive'Image(Size)));
      loop
         Get_Next(Table, Index, Key, Item);
         exit when Index = 0;
         Put_Internal(New_Table, Key, Item);
      end loop;
      return New_Table;
   end Copy;

   function Double_Size
     (N : in Positive)
     return Positive is
   begin
      return Next_Prime(N * 2 - 1);
   end Double_Size;

   -- Increase the available space in the hash table. All entries are
   -- rehashed (this is expensive).
   procedure Grow
     (Table : in out Hash_Table)
   is
   begin
      if Table = null then
         pragma Debug(Debug("grow: creating table from scratch"));
         Table := new Hash_Table_Record(Default_Start_Size);
      else
         pragma Debug(Debug("grow: copying to bigger table"));
         Table := Copy(Table, Double_Size(Table.Size));
      end if;
   end Grow;

   ----------------------
   -- Public interface --
   ----------------------

   -- Check for available space in the table, grow if necessary, then
   -- insert the key item pair into the table.
   --
   -- Raises Key_Exists if the key is already in use.
   procedure Put
     (Table : in out Hash_Table-- Add pair to this hash table.
      Key   : in Key_Type;       -- The new key to be added.
      Item  : in Item_Type)      -- The new item to be added.
   is
   begin
      if Full(Table) then Grow(Table); end if;
      Put_Internal(Table, Key, Item);
   end Put;

   -- Retrieve an item from the table.
   --
   -- Output parameter Found tells you whether the item was found in
   -- the table.
   procedure Get
     (Table : in Hash_Table-- Get value from this hash table.
      Key   : in Key_Type;   -- Look up this key.
      Item  : out Item_Type-- The item associated with the key.
      Found : out Boolean)   -- Was the item actually found?
   is
      Start : Positive;
      Index : Natural;
      Test  : Pair;
   begin
      Found := False;
      if Table = null then return; end if;
      Start := Hash(Key, Table.Size);
      Index := Start;
      loop
         -- pragma Debug(Debug("get: testing index" & Positive'Image(Index)));
         Test := Table.Pairs(Index);
         exit when Test.Key = Key;
         if Test.Empty then return; end if;
         Index := Index - 1;
         if Index = 0 then Index := Table.Size; end if;
      end loop;
      -- pragma Debug(Debug("get: found index" & Positive'Image(Index)));
      Item := Table.Pairs(Index).Item;
      Found := True;
   end Get;

   -- Retrieve an item from the table.
   --
   -- Raises Key_Not_Found if the key is not in the table.
   function Get
     (Table : in Hash_Table-- Get value from this hash table.
      Key   : in Key_Type)   -- Look up this key.
     return Item_Type        -- The item associated with the key.
   is
      Item  : Item_Type;
      Found : Boolean;
   begin
      Get(Table, Key, Item, Found);
      if not Found then raise Key_Not_Found; end if;
      return Item;
   end Get;

   -- Iterate over the items in the table.
   --
   -- You should start with an Index of 0 and stop iterating as soon
   -- as Index is 0 again.
   procedure Get_Next
     (Table : in Hash_Table;  -- Get pair from this hash table.
      Index : in out Natural-- Iteration pointer to the current field.
      Key   : out Key_Type;   -- The key at the current field.
      Item  : out Item_Type)  -- The item at the current field.
   is
      Pair : Hash_Tables.Pair;
   begin
      loop
         Index := Index + 1;
         if Index > Table.Size then
            Index := 0;
            return;
         end if;
         Pair := Table.Pairs(Index);
         exit when not Pair.Empty;
      end loop;
      Key := Pair.Key;
      Item := Pair.Item;
   end Get_Next;

   -- Print a visual representation of the hash table's usage.
   --
   -- Empty fields are represented by a '-' character, used fields by
   -- '#'.
   procedure Print_Usage
     (Table : in Hash_Table) is -- Print usage of this hash table.
   begin
      for Index in Table.Pairs'Range loop
         if Table.Pairs(Index).Empty
         then Text_IO.Put('-');
         else Text_IO.Put('#');
         end if;
      end loop;
      Text_IO.New_Line;
   end Print_Usage;

end Hash_Tables;