interning: now based on dyn_interning.

2 files changed, 25 insertions, 106 deletions

diff --git a/src/interning.adb b/src/interning.adb
index 66aedf903..da4e88dfc 100644
--- a/src/interning.adb
+++ b/src/interning.adb
@@ -16,125 +16,29 @@
 --  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
 --  02111-1307, USA.
 
-with Ada.Unchecked_Deallocation;
-with Dyn_Tables;
-
 package body Interning is
-   type Element_Wrapper is record
-      Hash : Hash_Value_Type;
-      Next : Index_Type;
-      Obj  : Object_Type;
-   end record;
-
-   package Wrapper_Tables is new Dyn_Tables
-     (Table_Index_Type => Index_Type,
-      Table_Component_Type => Element_Wrapper,
-      Table_Low_Bound => No_Index + 1,
-      Table_Initial => 128);
-
-   type Hash_Array is array (Hash_Value_Type range <>) of Index_Type;
-   type Hash_Array_Acc is access Hash_Array;
-
-   Initial_Size : constant Hash_Value_Type := 1024;
-
-   Size : Hash_Value_Type;
-   Hash_Table : Hash_Array_Acc;
-   Els : Wrapper_Tables.Instance;
-
-   procedure Deallocate is new Ada.Unchecked_Deallocation
-     (Hash_Array, Hash_Array_Acc);
+   Inst : Implementation.Instance;
 
    procedure Init is
    begin
-      Size := Initial_Size;
-      Hash_Table := new Hash_Array'(0 .. Initial_Size - 1 => No_Index);
-      Wrapper_Tables.Init (Els);
-      pragma Assert (Wrapper_Tables.Last (Els) = No_Index);
+      Implementation.Init (Inst);
    end Init;
 
-   --  Expand the hash table (double the size).
-   procedure Expand
-   is
-      Old_Hash_Table : Hash_Array_Acc;
-      Idx : Index_Type;
-   begin
-      Old_Hash_Table := Hash_Table;
-      Size := Size * 2;
-      Hash_Table := new Hash_Array'(0 .. Size - 1 => No_Index);
-
-      --  Rehash.
-      for I in Old_Hash_Table'Range loop
-         Idx := Old_Hash_Table (I);
-         while Idx /= No_Index loop
-            --  Note: collisions are put in reverse order.
-            declare
-               Ent : Element_Wrapper renames Els.Table (Idx);
-               Hash_Index : constant Hash_Value_Type :=
-                 Ent.Hash and (Size - 1);
-               Next_Idx : constant Index_Type := Ent.Next;
-            begin
-               Ent.Next := Hash_Table (Hash_Index);
-               Hash_Table (Hash_Index) := Idx;
-               Idx := Next_Idx;
-            end;
-         end loop;
-      end loop;
-
-      Deallocate (Old_Hash_Table);
-   end Expand;
-
    function Get (Params : Params_Type) return Object_Type
    is
-      Hash_Value : Hash_Value_Type;
-      Hash_Index : Hash_Value_Type;
-      Idx : Index_Type;
       Res : Object_Type;
    begin
-      --  Check if the package was initialized.
-      pragma Assert (Hash_Table /= null);
-
-      Hash_Value := Hash (Params);
-      Hash_Index := Hash_Value and (Size - 1);
-
-      Idx := Hash_Table (Hash_Index);
-      while Idx /= No_Index loop
-         declare
-            E : Element_Wrapper renames Els.Table (Idx);
-         begin
-            if E.Hash = Hash_Value and then Equal (E.Obj, Params) then
-               return E.Obj;
-            end if;
-            Idx := E.Next;
-         end;
-      end loop;
-
-      --  Maybe expand the table.
-      if Hash_Value_Type (Wrapper_Tables.Last (Els)) > 2 * Size then
-         Expand;
-
-         --  Recompute hash index.
-         Hash_Index := Hash_Value and (Size - 1);
-      end if;
-
-      Res := Build (Params);
-
-      --  Insert.
-      Wrapper_Tables.Append (Els,
-                             (Hash => Hash_Value,
-                              Next => Hash_Table (Hash_Index),
-                              Obj => Res));
-      Hash_Table (Hash_Index) := Wrapper_Tables.Last (Els);
+      Implementation.Get (Inst, Params, Res);
       return Res;
    end Get;
 
    function Last_Index return Index_Type is
    begin
-      return Wrapper_Tables.Last (Els);
+      return Implementation.Last_Index (Inst);
    end Last_Index;
 
    function Get_By_Index (Index : Index_Type) return Object_Type is
    begin
-      pragma Assert (Index <= Wrapper_Tables.Last (Els));
-      return Els.Table (Index).Obj;
+      return Implementation.Get_By_Index (Inst, Index);
    end Get_By_Index;
 end Interning;
diff --git a/src/interning.ads b/src/interning.ads
index 70573022e..530d9be6f 100644
--- a/src/interning.ads
+++ b/src/interning.ads
@@ -16,8 +16,8 @@
 --  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
 --  02111-1307, USA.
 
-with Types; use Types;
 with Hash; use Hash;
+with Dyn_Interning;
 
 --  This generic package provides a factory to build unique objects.
 --  Get will return an existing object or create a new one.
@@ -39,6 +39,22 @@ generic
    with function Equal (Obj : Object_Type; Params : Params_Type)
                        return Boolean;
 package Interning is
+   package Implementation is new Dyn_Interning
+     (Params_Type => Params_Type,
+      Object_Type => Object_Type,
+      Hash => Hash,
+      Build => Build,
+      Equal => Equal);
+
+   subtype Index_Type is Implementation.Index_Type;
+
+   --  Re-export (some) operators of Index_Type.
+   --  FIXME: is there a better way to do this ?
+   function "<=" (L, R : Index_Type) return Boolean
+     renames Implementation."<=";
+   function "+" (L, R : Index_Type) return Index_Type
+     renames Implementation."+";
+
    --  Initialize.  Required before any other operation.
    procedure Init;
 
@@ -46,14 +62,13 @@ package Interning is
    --  Otherwise create it.
    function Get (Params : Params_Type) return Object_Type;
 
-   type Index_Type is new Uns32;
-   No_Index : constant Index_Type := 0;
-   First_Index : constant Index_Type := 1;
-
    --  Get the number of elements in the table.
    function Last_Index return Index_Type;
 
    --  Get an element by index.  The index has no real meaning, but the
    --  current implementation allocates index incrementally.
    function Get_By_Index (Index : Index_Type) return Object_Type;
+
+   No_Index : constant Index_Type := Implementation.No_Index;
+   First_Index : constant Index_Type := Implementation.First_Index;
 end Interning;