Rewrite dyn_interning using Dyn_Maps.

2 files changed, 34 insertions, 140 deletions

diff --git a/src/dyn_interning.adb b/src/dyn_interning.adb
index 0550194f6..ccf468b37 100644
--- a/src/dyn_interning.adb
+++ b/src/dyn_interning.adb
@@ -16,105 +16,14 @@
 --  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
 --  02111-1307, USA.
 
-with Ada.Unchecked_Deallocation;
 
 package body Dyn_Interning is
-   procedure Deallocate is new Ada.Unchecked_Deallocation
-     (Hash_Array, Hash_Array_Acc);
-
-   procedure Init (Inst : out Instance) is
-   begin
-      Inst.Size := Initial_Size;
-      Inst.Hash_Table := new Hash_Array'(0 .. Initial_Size - 1 => No_Index);
-      Wrapper_Tables.Init (Inst.Els, 128);
-      pragma Assert (Wrapper_Tables.Last (Inst.Els) = No_Index);
-   end Init;
-
-   procedure Free (Inst : in out Instance) is
-   begin
-      Deallocate (Inst.Hash_Table);
-      Inst.Size := 0;
-      Wrapper_Tables.Free (Inst.Els);
-   end Free;
-
-   --  Expand the hash table (double the size).
-   procedure Expand (Inst : in out Instance)
-   is
-      Old_Hash_Table : Hash_Array_Acc;
-      Idx : Index_Type;
-   begin
-      Old_Hash_Table := Inst.Hash_Table;
-      Inst.Size := Inst.Size * 2;
-      Inst.Hash_Table := new Hash_Array'(0 .. Inst.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 Inst.Els.Table (Idx);
-               Hash_Index : constant Hash_Value_Type :=
-                 Ent.Hash and (Inst.Size - 1);
-               Next_Idx : constant Index_Type := Ent.Next;
-            begin
-               Ent.Next := Inst.Hash_Table (Hash_Index);
-               Inst.Hash_Table (Hash_Index) := Idx;
-               Idx := Next_Idx;
-            end;
-         end loop;
-      end loop;
-
-      Deallocate (Old_Hash_Table);
-   end Expand;
-
-   procedure Get_Index
-     (Inst : in out Instance; Params : Params_Type; Idx : out Index_Type)
+   function Build_No_Value (Obj : Object_Type) return No_Value_Type
    is
-      Hash_Value : Hash_Value_Type;
-      Hash_Index : Hash_Value_Type;
+      pragma Unreferenced (Obj);
    begin
-      --  Check if the package was initialized.
-      pragma Assert (Inst.Hash_Table /= null);
-
-      Hash_Value := Hash (Params);
-      Hash_Index := Hash_Value and (Inst.Size - 1);
-
-      Idx := Inst.Hash_Table (Hash_Index);
-      while Idx /= No_Index loop
-         declare
-            E : Element_Wrapper renames Inst.Els.Table (Idx);
-         begin
-            if E.Hash = Hash_Value and then Equal (E.Obj, Params) then
-               return;
-            end if;
-            Idx := E.Next;
-         end;
-      end loop;
-
-      --  Maybe expand the table.
-      if Hash_Value_Type (Wrapper_Tables.Last (Inst.Els)) > 2 * Inst.Size then
-         Expand (Inst);
-
-         --  Recompute hash index.
-         Hash_Index := Hash_Value and (Inst.Size - 1);
-      end if;
-
-      declare
-         Res : Object_Type;
-      begin
-         Res := Build (Params);
-
-         --  Insert.
-         Wrapper_Tables.Append (Inst.Els,
-                                (Hash => Hash_Value,
-                                 Next => Inst.Hash_Table (Hash_Index),
-                                 Obj => Res));
-         Inst.Hash_Table (Hash_Index) := Wrapper_Tables.Last (Inst.Els);
-      end;
-
-      Idx := Wrapper_Tables.Last (Inst.Els);
-   end Get_Index;
+      return (null record);
+   end Build_No_Value;
 
    procedure Get
      (Inst : in out Instance; Params : Params_Type; Res : out Object_Type)
@@ -124,16 +33,4 @@ package body Dyn_Interning is
       Get_Index (Inst, Params, Idx);
       Res := Get_By_Index (Inst, Idx);
    end Get;
-
-   function Last_Index (Inst : Instance) return Index_Type is
-   begin
-      return Wrapper_Tables.Last (Inst.Els);
-   end Last_Index;
-
-   function Get_By_Index (Inst : Instance; Index : Index_Type)
-                         return Object_Type is
-   begin
-      pragma Assert (Index <= Wrapper_Tables.Last (Inst.Els));
-      return Inst.Els.Table (Index).Obj;
-   end Get_By_Index;
 end Dyn_Interning;
diff --git a/src/dyn_interning.ads b/src/dyn_interning.ads
index abe32a27b..3940029f3 100644
--- a/src/dyn_interning.ads
+++ b/src/dyn_interning.ads
@@ -16,9 +16,8 @@
 --  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
 --  02111-1307, USA.
 
-with Types; use Types;
 with Hash; use Hash;
-with Dyn_Tables;
+with Dyn_Maps;
 
 --  This generic package provides a factory to build unique objects.
 --  Get will return an existing object or create a new one.
@@ -40,16 +39,33 @@ generic
    with function Equal (Obj : Object_Type; Params : Params_Type)
                        return Boolean;
 package Dyn_Interning is
-   type Instance is limited private;
+   type No_Value_Type is null record;
+   function Build_No_Value (Obj : Object_Type) return No_Value_Type;
+
+   package Map is new Dyn_Maps
+     (Params_Type => Params_Type,
+      Object_Type => Object_Type,
+      Value_Type  => No_Value_Type,
+      Hash        => Hash,
+      Build       => Build,
+      Build_Value => Build_No_Value,
+      Equal       => Equal);
+
+   subtype Instance is Map.Instance;
 
    --  Initialize.  Required before any other operation.
-   procedure Init (Inst : out Instance);
+   procedure Init (Inst : out Instance) renames Map.Init;
+
+   procedure Free (Inst : in out Instance) renames Map.Free;
 
-   procedure Free (Inst : in out Instance);
+   --  Export Index_Type...
+   subtype Index_Type is Map.Index_Type;
+   function "+" (L, R : Index_Type) return Index_Type renames Map."+";
+   function ">" (L, R : Index_Type) return Boolean renames Map.">";
+   function "<=" (L, R : Index_Type) return Boolean renames Map."<=";
 
-   type Index_Type is new Uns32;
-   No_Index : constant Index_Type := 0;
-   First_Index : constant Index_Type := 1;
+   No_Index : constant Index_Type := Map.No_Index;
+   First_Index : constant Index_Type := Map.First_Index;
 
    --  If there is already an existing object for PARAMS, return it.
    --  Otherwise create it.
@@ -58,35 +74,16 @@ package Dyn_Interning is
 
    --  Likewise, but return its index.
    procedure Get_Index
-     (Inst : in out Instance; Params : Params_Type; Idx : out Index_Type);
+     (Inst : in out Instance; Params : Params_Type; Idx : out Index_Type)
+     renames Map.Get_Index;
 
    --  Get the number of elements in the table.
-   function Last_Index (Inst : Instance) return Index_Type;
+   function Last_Index (Inst : Instance) return Index_Type
+     renames Map.Last_Index;
 
    --  Get an element by index.  The index has no real meaning, but the
    --  current implementation allocates index incrementally.
    function Get_By_Index (Inst : Instance; Index : Index_Type)
-                          return Object_Type;
-private
-   type Element_Wrapper is record
-      Hash : Hash_Value_Type;
-      Next : Index_Type := No_Index;
-      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);
-
-   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;
-
-   type Instance is record
-      Els : Wrapper_Tables.Instance;
-      Size : Hash_Value_Type;
-      Hash_Table : Hash_Array_Acc;
-   end record;
+                          return Object_Type
+     renames Map.Get_By_Index;
 end Dyn_Interning;