 |  | limi_hash_tabl |  |
 |  | li_has_tab.ads |  |
 | li_has_tab.adb |
|  | hash_tables | |
| | hash_tables | |
| limi_hash_tabl | ||
| positi_functio | ||
| stri_hash_tabl | ||
| st_str_has_tab | ||
| te_str_has_tab |
| | util | |
| | hash_tables/ | |
 | heaps/ | ||
| images/ | ||
| lists/ | ||
| maths/ | ||
| messages/ | ||
| pipes/ | ||
| primes/ | ||
| readers/ | ||
| strings/ | ||
| writers/ |
| | ada | |
| | bin/ | |
| engine/ | ||
| fonts/ | ||
| internal/ | ||
| text/ | ||
| util/ |
|  | Home | |
|  | Showcase | |
 | Snapshots | ||
 | Ada Source | ||
 | PHP Source | ||
 | Fonts |
|  | Sourceforge | |
|  | Summary | |
 | Downloads | ||
 | Browse CVS | ||
 | Donate | ||
 | Activity |
Hosted by
-- $Date: 2004/02/14 02:23:39 $
-- $Revision: 1.4 $
-- $Author: jcrocholl $
with Ada.Text_IO;
with Primes; use Primes;
-- with Messages; use Messages;
package body Limited_Hash_Tables is
-- The table is 100% full. This means you forgot to check for
-- available space before using Put_Internal.
Table_Full : exception;
-- Put a key item pair into the hash table.
-- Raises Key_Exists if the key is already in use.
procedure Put_Internal
(This : access Hash_Table;
Pair : in Pair_Access)
is
Start : Positive;
Index : Natural;
Test : Pair_Access;
begin
Start := Hash(Pair.Key, This.Size);
Index := Start;
loop
-- pragma Debug(Debug("put: testing index" & Positive'Image(Index)));
Test := This.Pairs(Index);
exit when Test = null;
if Equal(Test.Key, Pair.Key) then raise Key_Exists; end if;
Index := Index - 1;
if Index = 0 then Index := This.Size; end if;
if Index = Start then raise Table_Full; end if;
end loop;
This.Count := This.Count + 1;
-- pragma Debug(Debug("put: writing to index" & Positive'Image(Index)));
This.Pairs(Index) := Pair;
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
(This : access Hash_Table)
return Boolean
is
Result : Boolean :=
This.Count >= This.Size - 2 or else
This.Count * 100 > This.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
(This : access Hash_Table;
Size : in Positive)
return Hash_Table_Access
is
New_Table : Hash_Table_Access := new Hash_Table(Size);
Index : Natural := 0;
Pair : Pair_Access;
begin
-- pragma Debug(Print_Usage(This));
-- pragma Debug(Debug("copy:" &
-- " old size" & Positive'Image(This.Size) &
-- " new size" & Positive'Image(Size)));
loop
Get_Next(This, Index, Pair);
exit when Index = 0;
Put_Internal(New_Table, Pair);
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
(This : in out Hash_Table_Access)
is
begin
-- pragma Debug(Debug("grow: copying to bigger table"));
This := Copy(This, Double_Size(This.Size));
end Grow;
---------------
-- Construction
---------------
-- Create a new hash table with the given table size.
function Create
(Size : in Positive := Default_Start_Size) -- Make room for this many pairs.
return Hash_Table_Access is -- The newly created hash table.
begin
-- pragma Debug(Debug("create: creating table from scratch"));
return new Hash_Table(Size);
end Create;
-- Check for available space in the table, grow if necessary, then
-- insert the pair into the table. Raises Key_Exists if the key is
-- already in use.
procedure Put
(This : in out Hash_Table_Access; -- Add pair to this hash table.
Pair : in Pair_Access) is -- Insert this pair.
begin
if Full(This) then Grow(This); end if;
Put_Internal(This, Pair);
end Put;
-----------------
-- Indexed access
-----------------
-- Get the index of a given key.
procedure Get_Index
(This : access Hash_Table; -- Get key from this hash table.
Key : in Key_Type; -- Iteration pointer to the current field.
Index : out Positive; -- The index of the requested key.
Found : out Boolean) -- True if the key was found.
is
Start : Positive;
Test : Pair_Access;
begin
Found := False;
Start := Hash(Key, This.Size);
Index := Start;
loop
-- pragma Debug(Debug("get: testing index" & Positive'Image(Index)));
Test := This.Pairs(Index);
if Test = null then return; end if;
exit when Equal(Test.Key, Key);
if Index = 1
then Index := This.Size;
else Index := Index - 1;
end if;
if Index = Start then return; end if;
end loop;
-- pragma Debug(Debug("get: found index" & Positive'Image(Index)));
Found := True;
end Get_Index;
-- Get the index of a given key.
function Get_Index
(This : access Hash_Table; -- Get key from this hash table.
Key : in Key_Type) -- Iteration pointer to the current field.
return Positive -- The index of the requested key.
is
Index : Natural;
Found : Boolean;
begin
Get_Index(This, Key, Index, Found);
if not Found then raise Key_Not_Found; end if;
return Index;
end Get_Index;
-- Get the pair at a given index position.
function Get_Pair
(This : access Hash_Table; -- Get pair from this hash table.
Index : in Positive) -- Iteration pointer to the current field.
return Pair_Access is -- The requested pair.
begin
return This.Pairs(Index);
end Get_Pair;
pragma Inline(Get_Pair);
-- Get the key at a given index position.
function Get_Key
(This : access Hash_Table; -- Get key from this hash table.
Index : in Positive) -- Iteration pointer to the current field.
return Key_Type is -- The requested key.
begin
return This.Pairs(Index).Key;
end Get_Key;
pragma Inline(Get_Key);
-- Get the item at a given index position.
function Get_Item
(This : access Hash_Table; -- Get item from this hash table.
Index : in Positive) -- Iteration pointer to the current field.
return Item_Type is -- The requested item.
begin
return This.Pairs(Index).Item;
end Get_Item;
pragma Inline(Get_Item);
------------
-- Iterating
------------
-- 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 Next
(This : access Hash_Table; -- Iterate through this hash table.
Index : in out Natural) is -- Iteration pointer to the current field.
begin
loop
Index := Index + 1;
if Index > This.Size then
Index := 0;
return;
end if;
exit when This.Pairs(Index) /= null;
end loop;
end Next;
-- 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
(This : access Hash_Table; -- Get pair from this hash table.
Index : in out Natural; -- Iteration pointer to the current field.
Pair : out Pair_Access) is -- The pair at the updated index position.
begin
Next(This, Index);
if Index = 0 then return; end if;
Pair := Get_Pair(This, Index);
end Get_Next;
------------------------
-- Performance debugging
------------------------
-- Print a visual representation of the hash table's usage. Empty
-- fields are represented by a '-' character, used fields by '#'.
procedure Print_Usage
(This : access Hash_Table) is -- Print usage of this hash table.
begin
for Index in This.Pairs'Range loop
if This.Pairs(Index) = null
then Ada.Text_IO.Put('-');
else Ada.Text_IO.Put('#');
end if;
end loop;
Ada.Text_IO.New_Line;
end Print_Usage;
end Limited_Hash_Tables;