From 3d568063a49204193009ad6a2637176b38902525 Mon Sep 17 00:00:00 2001
From: Vladimir Azarov <avm@intermediate-node.net>
Date: Wed, 14 May 2025 03:19:35 +0200
Subject: Printf

---
 hashtable.sml | 111 +++++++++++++++++++++++++++++++++-------------------------
 1 file changed, 63 insertions(+), 48 deletions(-)

(limited to 'hashtable.sml')

diff --git a/hashtable.sml b/hashtable.sml
index 5b89ebd..6ec7277 100644
--- a/hashtable.sml
+++ b/hashtable.sml
@@ -1,60 +1,75 @@
-structure Hashtable :> HASHTABLE = struct
-    (* (Array, (cells occupied, total size)) *)
-  type 'a t = ((string * 'a) option) array * (int * int)
+structure Hashtable: HASHTABLE = struct
+  open Array
+  open Word
 
-  exception HashtableFull
-  exception Exists
+  (* buf * taken * mask *)
+  type 'a t = (string * 'a) option array * int * word
 
-  fun create size = (Array.array (size, NONE), (0, size))
+  val ` = Word.fromInt
+  val ! = Word.toInt
 
-  val fillLimit = 0.75
+  infixr 4 <<
+  infix 5 andb
+  infixr 6 +
+  infixr 7 *
 
-  val ` = Word32.fromInt
+  fun createLog log =
+  let
+    val size = `1 << `log
+    val mask = size - `1
+  in
+    (array (Word.toInt size, NONE), 0, mask)
+  end
+
+  exception Full and Exists
 
-  fun hashFunc key =
-    List.foldl (fn (x, acc) => acc * `31 + `(ord x)) (`0) $ explode key
+  fun hash key =
+    List.foldl (fn (c, s) => s * `31 + `(ord c)) (`17) (explode key)
 
-  fun insert (buf, (taken, total)) key value =
-    if Real.fromInt (taken + 1) / Real.fromInt total > fillLimit then
-      raise HashtableFull
+  fun checkFreeSpace (array, taken, _) =
+  let
+    open Real
+    val ` = fromInt
+  in
+    if `taken / `(length array) > 0.75 then
+      raise Full
     else
-      let
-        open Array
-        val hash = hashFunc key
-
-        (* TODO: use bitwise manipulation instead of mod *)
-        val i = ref $ Word32.toInt $ Word32.mod (hash, `(length buf))
-        val flag = ref true
-      in
-        while !flag do (
-          case sub (buf, !i) of
-            NONE => (update (buf, !i, SOME (key, value)); flag := false)
-          | SOME (key', _) =>
-              if key' = key then
-                raise Exists
-              else
-                i := (!i + 1) mod (length buf)
-        )
-      end
-
-  fun lookup (buf, _) key =
+      ()
+  end
+
+  fun next idx mask = (idx + `1) andb mask
+
+  fun lookup2 ((array, _, mask): 'a t) (key: string) f g =
   let
-    open Array
-    val hash = hashFunc key
+    fun find idx =
+      case sub (array, !idx) of
+           NONE => g ()
+         | SOME (key', v: 'a) =>
+             if key' = key then
+               case f v of
+                    (NONE, res) => res
+                  | (SOME v, res) =>
+                      (update (array, !idx, SOME (key, v)); res)
+             else
+               find (next idx mask)
+  in
+    find (hash key andb mask)
+  end
+
+  fun lookup H key = lookup2 H key (fn v => (NONE, SOME v)) (fn () => NONE)
 
-    val i = ref $ Word32.toInt $ Word32.mod (hash, `(length buf))
-    val flag = ref true
-    val result = ref NONE
+  fun insert (H as (array, _, mask)) key v =
+  let
+    val () = checkFreeSpace H;
+    fun find idx =
+      case sub (array, !idx) of
+           NONE => update (array, !idx, SOME (key, v))
+         | SOME (key', _) =>
+             if key' = key then
+               raise Exists
+             else
+               find (next idx mask)
   in
-    while !flag do (
-        case sub (buf, !i) of
-          SOME (key', value) =>
-            if key' = key then
-              (result := SOME value; flag := false)
-            else
-              i := (!i + 1) mod (length buf)
-        | NONE => flag := false
-    );
-    !result
+    find (hash key andb mask)
   end
 end
-- 
cgit v1.2.3