From b7620047755b8ce423977a4b090395a37d221c66 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Fri, 22 May 2020 08:25:38 +0200 Subject: Rewrite dyn_interning using Dyn_Maps. --- src/dyn_interning.adb | 111 ++------------------------------------------------ src/dyn_interning.ads | 63 ++++++++++++++-------------- 2 files changed, 34 insertions(+), 140 deletions(-) (limited to 'src') 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; -- cgit v1.2.3