Fix a hashtable bug

TODO.FACTOR.txt

@@ -11,6 +11,7 @@
 - another i/o bug: on factorcode eventually all i/o times out
 - x11 title bars are funny
 - save window positions on x11
+- do top-level window focus on x11
 - restore windows with the correct stacking order
 - if the listener is running a command when the image is saved, it
   restores to an unresponsive gadget
@@ -19,7 +20,6 @@
 - services do not launch if factor not running
 - when scrolling wheel, or moving mouse out of window, rollover is not
   updated
-- focus is not top-level window aware
 - amd64 crash
 - get factor running on mac intel
 - constant branch folding

library/collections/hashtables.factor

@@ -38,11 +38,11 @@ TUPLE: tombstone ;
     swap <hash-array> over set-hash-array init-hash ;
 
 : (new-key@) ( key keys i -- n )
-    3dup swap nth-unsafe dup tombstone? [
+    3dup swap nth-unsafe {
-        2drop 2nip
+        { [ dup ((empty)) eq? ] [ 2drop 2nip ] }
-    ] [
+        { [ = ] [ 2nip ] }
-        = [ 2nip ] [ probe (new-key@) ] if
+        { [ t ] [ probe (new-key@) ] }
-    ] if ; inline
+    } cond ; inline
 
 : new-key@ ( key hash -- n )
     hash-array 2dup hash@ (new-key@) ; inline
@@ -59,15 +59,8 @@ TUPLE: tombstone ;
 : hash-deleted+
     dup hash-deleted 1+ swap set-hash-deleted ; inline
 
-: hash-deleted-
-    dup hash-deleted 1- swap set-hash-deleted ; inline
-
 : change-size ( hash old -- )
-    dup ((tombstone)) eq? [
+    ((empty)) eq? [ hash-count+ ] [ drop ] if ; inline
-        drop hash-deleted-
-    ] [
-        ((empty)) eq? [ hash-count+ ] [ drop ] if
-    ] if ; inline
 
 : (set-hash) ( value key hash -- )
     2dup new-key@ swap

library/collections/hashtables.facts

@@ -62,10 +62,6 @@ HELP: hash-deleted+ "( hash -- )"
 { $values { "hash" "a hashtable" } }
 { $description "Called to increment the deleted entry counter when an entry is removed with " { $link remove-hash } } ;
 
-HELP: hash-deleted- "( hash -- )"
-{ $values { "hash" "a hashtable" } }
-{ $description "Called to decrement the deleted entry counter when a deleted entry storing the " { $link ((tombstone)) } " sentinel is overwritten with a new entry." } ;
-
 HELP: change-size "( hash old -- )"
 { $values { "hash" "a hashtable" } { "old" "the key about to be overwritten" } }
 { $description "Called to update the hashtable counters when a new entry is added with " { $link set-hash } "." } ;

library/generic/tuple.factor

@@ -18,10 +18,6 @@ IN: kernel-internals
         2drop f
     ] if ;
 
-: tuple-hashcode ( n tuple -- n )
-    dup class-tuple hashcode >r >r 1-
-    r> 4 slot hashcode* r> bitxor ;
-
 IN: generic
 
 : class ( object -- class )
@@ -84,14 +80,7 @@ PREDICATE: word tuple-class "tuple-size" word-prop ;
 M: tuple clone ( tuple -- tuple )
     (clone) dup delegate clone over set-delegate ;
 
-M: tuple hashcode* ( n tuple -- n )
+M: tuple hashcode ( tuple -- n ) class hashcode ;
-    {
-        { [ over 0 <= ] [ 2drop 0 ] }
-        { [ dup array-capacity 2 <= ] [ nip class hashcode ] }
-        { [ t ] [ tuple-hashcode ] }
-    } cond ;
-
-M: tuple hashcode ( tuple -- n ) 2 swap hashcode* ;
 
 M: tuple = ( obj tuple -- ? )
     2dup eq?

library/test/collections/hashtables.factor

@@ -49,6 +49,14 @@ f 100000000000000000000000000 "testhash" get set-hash
 [ f ] [ 100000000000000000000000000 "testhash" get hash* drop ] unit-test
 [ { } ] [ { [ { } ] } clone "testhash" get hash* drop ] unit-test
 
+! Regression
+3 <hashtable> "broken-remove" set
+1 W{ \ + } dup "x" set "broken-remove" get set-hash
+2 W{ \ = } dup "y" set "broken-remove" get set-hash
+"x" get "broken-remove" get remove-hash
+2 "y" get "broken-remove" get set-hash
+[ 1 ] [ "broken-remove" get hash-keys length ] unit-test
+
 {
     { "salmon" "fish" }
     { "crocodile" "reptile" }