Hosted by
 |
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;
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
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;
end Put_Internal;
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
return Result;
end Full;
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;
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;
procedure Put
(Table : in out Hash_Table;
Key : in Key_Type;
Item : in Item_Type)
is
begin
if Full(Table) then Grow(Table); end if;
Put_Internal(Table, Key, Item);
end Put;
procedure Get
(Table : in Hash_Table;
Key : in Key_Type;
Item : out Item_Type;
Found : out Boolean)
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
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;
Item := Table.Pairs(Index).Item;
Found := True;
end Get;
function Get
(Table : in Hash_Table;
Key : in Key_Type)
return Item_Type
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;
procedure Get_Next
(Table : in Hash_Table;
Index : in out Natural;
Key : out Key_Type;
Item : out Item_Type)
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;
procedure Print_Usage
(Table : in Hash_Table) is
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;
|