use radix literals

[factor.git] / core / hashtables / hashtables.factor

diff --git a/core/hashtables/hashtables.factor b/core/hashtables/hashtables.factor
index 7883b2dfb9e3a5ce33e3593371f7dcbd2785631f..7d0f4b85ffaa2af545e00a6ecb8df3ef98dc6e81 100644 (file)
--- a/core/hashtables/hashtables.factor
+++ b/core/hashtables/hashtables.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2005, 2008 Slava Pestov.
+! Copyright (C) 2005, 2011 John Benediktsson, Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays kernel kernel.private slots.private math
 assocs math.private sequences sequences.private vectors ;
@@ -44,28 +44,49 @@ TUPLE: hashtable
 : reset-hash ( n hash -- )
     swap <hash-array> >>array init-hash ; inline
 
-: (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@) ]
+: hash-count+ ( hash -- )
+    [ 1 fixnum+fast ] change-count drop ; inline
+
+: hash-deleted+ ( hash -- )
+    [ 1 fixnum+fast ] change-deleted drop ; inline
+
+: hash-deleted- ( hash -- )
+    [ 1 fixnum-fast ] change-deleted drop ; inline
+
+! i = first-empty-or-found
+! j = first-deleted
+! empty? = if true, key was not found
+!
+! if empty? is f:
+! - we want to store into i
+! 
+! if empty? is t:
+! - we want to store into j if j is not f
+! - otherwise we want to store into i
+! - ... and increment count
+
+: (new-key@) ( key array i probe# j -- array i j empty? )
+    [ 2dup swap array-nth ] 2dip pick tombstone?
+    [
+        rot ((empty)) eq?
+        [ nip [ drop ] 3dip t ]
+        [ pick or [ probe ] dip (new-key@) ]
+        if
+    ] [
+        [ [ pick ] dip = ] 2dip rot
+        [ nip [ drop ] 3dip f ]
+        [ [ probe ] dip (new-key@) ]
         if
     ] if ; inline recursive
 
-: new-key@ ( key hash -- array n empty? )
-    array>> 2dup hash@ 0 (new-key@) ; inline
+: new-key@ ( key hash -- array n )
+    [ array>> 2dup hash@ 0 f (new-key@) ] keep swap
+    [ over [ hash-deleted- ] [ hash-count+ ] if swap or ] [ 2drop ] if ; inline
 
 : set-nth-pair ( value key seq n -- )
     2 fixnum+fast [ set-slot ] 2keep
     1 fixnum+fast set-slot ; inline
 
-: hash-count+ ( hash -- )
-    [ 1 + ] change-count drop ; inline
-
-: hash-deleted+ ( hash -- )
-    [ 1 + ] change-deleted drop ; inline
-
 : (rehash) ( hash alist -- )
     swap [ swapd set-at ] curry assoc-each ; inline
 
@@ -73,24 +94,13 @@ TUPLE: hashtable
     [ count>> 3 fixnum*fast 1 fixnum+fast ]
     [ array>> length>> ] bi fixnum> ; inline
 
-: hash-stale? ( hash -- ? )
-    [ deleted>> 10 fixnum*fast ] [ count>> ] bi fixnum> ; inline
-
 : grow-hash ( hash -- )
     [ [ >alist ] [ assoc-size 1 + ] bi ] keep
     [ reset-hash ] keep
     swap (rehash) ;
 
 : ?grow-hash ( hash -- )
-    dup hash-large? [
-        grow-hash
-    ] [
-        dup hash-stale? [
-            grow-hash
-        ] [
-            drop
-        ] if
-    ] if ; inline
+    dup hash-large? [ grow-hash ] [ drop ] if ; inline
 
 PRIVATE>
 
@@ -118,10 +128,7 @@ M: hashtable assoc-size ( hash -- n )
     dup >alist [ dup clear-assoc ] dip (rehash) ;
 
 M: hashtable set-at ( value key hash -- )
-    dup ?grow-hash
-    2dup new-key@
-    [ rot hash-count+ set-nth-pair ]
-    [ rot drop set-nth-pair ] if ;
+    dup ?grow-hash dupd new-key@ set-nth-pair ;
 
 : associate ( value key -- hash )
     2 <hashtable> [ set-at ] keep ;
@@ -171,7 +178,7 @@ M: hashtable assoc-like
 ! magic number is 2^29/phi instead of 2^32/phi
 ! due to max fixnum value on 32-bit machines
 : hash-combine ( obj oldhash -- newhash )
-    [ hashcode HEX: 13c6ef37 + ] dip
+    [ hashcode 0x13c6ef37 + ] dip
     [ 6 shift ] [ -2 shift ] bi + + ;
 
 INSTANCE: hashtable assoc