hashtables: switch to quadratic probing.

diff --git a/core/hashtables/hashtables.factor b/core/hashtables/hashtables.factor
index e7acf1245439d421bc4ac01cea5d392c9759b80f..858f0e19abfb7fe837e2cceed04702d5993a0c7d 100644 (file)
--- a/core/hashtables/hashtables.factor
+++ b/core/hashtables/hashtables.factor
@@ -17,21 +17,23 @@ TUPLE: hashtable
 : hash@ ( key array -- i )
     [ hashcode >fixnum dup fixnum+fast ] dip wrap ; inline
 
-: probe ( array i -- array i )
-    2 fixnum+fast over wrap ; inline
+: probe ( array i probe# -- array i' probe# )
+    2 fixnum+fast [ fixnum+fast over wrap ] keep ; inline
 
 : no-key ( key array -- array n ? ) nip f f ; inline
 
-: (key@) ( key array i -- array n ? )
-    3dup swap array-nth
-    dup ((empty)) eq?
-    [ 3drop no-key ] [
-        = [ rot drop t ] [ probe (key@) ] if
+: (key@) ( key array i probe# -- array n ? )
+    [ 3dup swap array-nth ] dip over ((empty)) eq?
+    [ drop 3drop no-key ] [
+        [ = ] dip swap
+        [ drop rot drop t ]
+        [ probe (key@) ]
+        if
     ] if ; inline recursive
 
 : key@ ( key hash -- array n ? )
     array>> dup length>> 0 eq?
-    [ no-key ] [ 2dup hash@ (key@) ] if ; inline
+    [ no-key ] [ 2dup hash@ 0 (key@) ] if ; inline
 
 : <hash-array> ( n -- array )
     1 + next-power-of-2 4 * ((empty)) <array> ; inline
@@ -42,19 +44,17 @@ TUPLE: hashtable
 : reset-hash ( n hash -- )
     swap <hash-array> >>array init-hash ; inline
 
-: (new-key@) ( key keys i -- keys n empty? )
-    3dup swap array-nth dup ((empty)) eq? [
-        2drop rot drop t
-    ] [
-        = [
-            rot drop f
-        ] [
-            probe (new-key@)
-        ] if
+: (new-key@) ( key array i probe# -- array i empty? )
+    [ 3dup swap array-nth ] dip over ((empty)) eq?
+    [ 3drop rot drop t ] [
+        [ = ] dip swap
+        [ drop rot drop f ]
+        [ probe (new-key@) ]
+        if
     ] if ; inline recursive
 
 : new-key@ ( key hash -- array n empty? )
-    array>> 2dup hash@ (new-key@) ; inline
+    array>> 2dup hash@ 0 (new-key@) ; inline
 
 : set-nth-pair ( value key seq n -- )
     2 fixnum+fast [ set-slot ] 2keep