diff --git a/core/hashtables/hashtables-docs.factor b/core/hashtables/hashtables-docs.factor index 3cd9ee23af..07517afdf7 100755 --- a/core/hashtables/hashtables-docs.factor +++ b/core/hashtables/hashtables-docs.factor @@ -93,11 +93,6 @@ HELP: hash-deleted+ { $description "Called to increment the deleted entry counter when an entry is removed with " { $link delete-at } } { $side-effects "hash" } ; -HELP: (set-hash) -{ $values { "value" "a value" } { "key" "a key to add" } { "hash" hashtable } { "new?" "a boolean" } } -{ $description "Stores the key/value pair into the hashtable. This word does not grow the hashtable if it exceeds capacity, therefore a hang can result. User code should use " { $link set-at } " instead, which grows the hashtable if necessary." } -{ $side-effects "hash" } ; - HELP: grow-hash { $values { "hash" hashtable } } { $description "Enlarges the capacity of a hashtable. User code does not need to call this word directly." } diff --git a/core/hashtables/hashtables-tests.factor b/core/hashtables/hashtables-tests.factor index 4e80ed1f6e..32684b92dc 100755 --- a/core/hashtables/hashtables-tests.factor +++ b/core/hashtables/hashtables-tests.factor @@ -164,3 +164,16 @@ H{ } "x" set [ { "one" "two" 3 } ] [ { 1 2 3 } H{ { 1 "one" } { 2 "two" } } substitute ] unit-test + +! We want this to work +[ ] [ hashtable new "h" set ] unit-test + +[ 0 ] [ "h" get assoc-size ] unit-test + +[ f f ] [ "goo" "h" get at* ] unit-test + +[ ] [ 1 2 "h" get set-at ] unit-test + +[ 1 ] [ "h" get assoc-size ] unit-test + +[ 1 ] [ 2 "h" get at ] unit-test diff --git a/core/hashtables/hashtables.factor b/core/hashtables/hashtables.factor index 3b794d1715..e804bb76fa 100755 --- a/core/hashtables/hashtables.factor +++ b/core/hashtables/hashtables.factor @@ -20,15 +20,18 @@ TUPLE: hashtable : probe ( array i -- array i ) 2 fixnum+fast over wrap ; inline -: (key@) ( key keys i -- array n ? ) +: no-key ( key array -- array n ? ) nip f f ; inline + +: (key@) ( key array i -- array n ? ) 3dup swap array-nth dup ((empty)) eq? - [ 3drop nip f f ] [ + [ 3drop no-key ] [ = [ rot drop t ] [ probe (key@) ] if ] if ; inline : key@ ( key hash -- array n ? ) - array>> 2dup hash@ (key@) ; inline + array>> dup array-capacity 0 eq? + [ no-key ] [ 2dup hash@ (key@) ] if ; inline : ( n -- array ) 1+ next-power-of-2 4 * ((empty)) ; inline @@ -63,25 +66,20 @@ TUPLE: hashtable : hash-deleted+ ( hash -- ) [ 1+ ] change-deleted drop ; inline -: (set-hash) ( value key hash -- new? ) - 2dup new-key@ - [ rot hash-count+ set-nth-pair t ] - [ rot drop set-nth-pair f ] if ; inline - : (rehash) ( hash alist -- ) - swap [ swapd (set-hash) drop ] curry assoc-each ; + swap [ swapd set-at ] curry assoc-each ; inline : hash-large? ( hash -- ? ) - [ count>> 3 fixnum*fast ] - [ array>> array-capacity ] bi > ; + [ count>> 3 fixnum*fast 1 fixnum+fast ] + [ array>> array-capacity ] bi fixnum> ; inline : hash-stale? ( hash -- ? ) - [ deleted>> 10 fixnum*fast ] [ count>> ] bi fixnum> ; + [ deleted>> 10 fixnum*fast ] [ count>> ] bi fixnum> ; inline : grow-hash ( hash -- ) [ dup >alist swap assoc-size 1+ ] keep [ reset-hash ] keep - swap (rehash) ; + swap (rehash) ; inline : ?grow-hash ( hash -- ) dup hash-large? [ @@ -122,7 +120,10 @@ M: hashtable assoc-size ( hash -- n ) r> (rehash) ; M: hashtable set-at ( value key hash -- ) - dup >r (set-hash) [ r> ?grow-hash ] [ r> drop ] if ; + dup ?grow-hash + 2dup new-key@ + [ rot hash-count+ set-nth-pair ] + [ rot drop set-nth-pair ] if ; : associate ( value key -- hash ) 2 [ set-at ] keep ;