sets: adding ?delete that returns a boolean if elt was deleted from set.

basis/delegate/protocols/protocols.factor

@@ -13,7 +13,7 @@ at* assoc-size >alist set-at assoc-clone-like
 delete-at clear-assoc new-assoc assoc-like ;
 
 PROTOCOL: set-protocol
-adjoin ?adjoin in? delete set-like fast-set members
+adjoin ?adjoin in? delete ?delete set-like fast-set members
 union intersect intersects? diff subset? set= duplicates
 all-unique? null? cardinality clear-set ;
 

basis/hash-sets/wrapped/wrapped.factor

@@ -36,6 +36,9 @@ M: wrapped-hash-set clear-set
 M: wrapped-hash-set delete
     wrapper@ delete ; inline
 
+M: wrapped-hash-set ?delete
+    wrapper@ ?delete ; inline
+
 M: wrapped-hash-set cardinality
     underlying>> cardinality ; inline
 

core/hash-sets/hash-sets-tests.factor

@@ -11,8 +11,12 @@ sets sorting tools.test ;
 { f } [ 3 HS{ 0 1 2 } in? ] unit-test
 { HS{ 1 2 3 } } [ 3 HS{ 1 2 } clone [ adjoin ] keep ] unit-test
 { HS{ 1 2 } } [ 2 HS{ 1 2 } clone [ adjoin ] keep ] unit-test
+{ t } [ 1 HS{ } ?adjoin ] unit-test
+{ f } [ 1 HS{ 1 } ?adjoin ] unit-test
 { HS{ 1 2 3 } } [ 4 HS{ 1 2 3 } clone [ delete ] keep ] unit-test
 { HS{ 1 2 } } [ 3 HS{ 1 2 3 } clone [ delete ] keep ] unit-test
+{ t } [ 1 HS{ 1 } ?delete ] unit-test
+{ f } [ 1 HS{ } ?delete ] unit-test
 { HS{ 1 2 } } [ HS{ 1 2 } fast-set ] unit-test
 { { 1 2 } } [ HS{ 1 2 } members natural-sort ] unit-test
 

core/hash-sets/hash-sets.factor

@@ -65,6 +65,14 @@ TUPLE: hash-set
 : (adjoin) ( key hash -- ? )
     dupd new-key@ [ set-nth-item ] dip ; inline
 
+: (delete) ( key hash -- ? )
+    [ nip ] [ key@ ] 2bi [
+        [ +tombstone+ ] 2dip set-nth-item
+        hash-deleted+ t
+    ] [
+        3drop f
+    ] if ; inline
+
 : (rehash) ( seq hash -- )
     [ (adjoin) drop ] curry each ; inline
 
@@ -98,12 +106,10 @@ M: hash-set clear-set
     [ init-hash ] [ array>> [ drop +empty+ ] map! drop ] bi ;
 
 M: hash-set delete
-    [ nip ] [ key@ ] 2bi [
-        [ +tombstone+ ] 2dip set-nth-item
-        hash-deleted+
-    ] [
-        3drop
-    ] if ;
+    (delete) drop ;
+
+M: hash-set ?delete
+    (delete) ;
 
 M: hash-set cardinality
     [ count>> ] [ deleted>> ] bi - ; inline

core/sets/sets-docs.factor

@@ -93,14 +93,17 @@ HELP: adjoin
 
 HELP: ?adjoin
 { $values { "elt" object } { "set" set } { "?" boolean } }
-{ $description "A version of " { $link adjoin } " which returns whether the element was added to the set." }
-{ $notes "This is slightly less efficient than " { $link adjoin } " due to the initial membership test." } ;
+{ $description "A version of " { $link adjoin } " which returns whether the element was added to the set." } ;
 
 HELP: delete
 { $values { "elt" object } { "set" set } }
 { $description "Destructively removes " { $snippet "elt" } " from " { $snippet "set" } ". If the element is not present, this does nothing." $nl "Each mutable set type is expected to implement a method on this generic word." }
 { $side-effects "set" } ;
 
+HELP: ?delete
+{ $values { "elt" object } { "set" set } { "?" boolean } }
+{ $description "A version of " { $link delete } " which returns whether the element was removed from the set." } ;
+
 HELP: clear-set
 { $values { "set" set } }
 { $contract "Removes all entries from the set." }

core/sets/sets-tests.factor

@@ -6,6 +6,8 @@ IN: sets.tests
 
 { V{ 1 2 3 } } [ 3 V{ 1 2 } clone [ adjoin ] keep ] unit-test
 { V{ 1 2 } } [ 2 V{ 1 2 } clone [ adjoin ] keep ] unit-test
+{ t } [ 1 V{ } ?adjoin ] unit-test
+{ f } [ 1 V{ 1 } ?adjoin ] unit-test
 
 { t } [ 4 { 2 4 5 } in? ] unit-test
 { f } [ 1 { 2 4 5 } in? ] unit-test
@@ -13,6 +15,8 @@ IN: sets.tests
 
 { V{ 1 2 } } [ 3 V{ 1 2 } clone [ delete ] keep ] unit-test
 { V{ 2 } } [ 1 V{ 1 2 } clone [ delete ] keep ] unit-test
+{ t } [ 1 V{ 1 } ?delete ] unit-test
+{ f } [ 1 V{ } ?delete ] unit-test
 { 0 } [ 5 <bit-set> 0 over delete cardinality ] unit-test
 { 0 } [ 5 <bit-set> f over delete cardinality ] unit-test
 { 0 } [ 5 <bit-set> 3 over adjoin 3 over delete cardinality ] unit-test

core/sets/sets.factor

@@ -10,6 +10,7 @@ GENERIC: adjoin ( elt set -- )
 GENERIC: ?adjoin ( elt set -- ? )
 GENERIC: in? ( elt set -- ? )
 GENERIC: delete ( elt set -- )
+GENERIC: ?delete ( elt set -- ? )
 GENERIC: set-like ( set exemplar -- set' )
 GENERIC: fast-set ( set -- set' )
 GENERIC: members ( set -- seq )
@@ -38,6 +39,8 @@ M: f clear-set drop ; inline
 
 M: set ?adjoin 2dup in? [ 2drop f ] [ adjoin t ] if ;
 
+M: set ?delete 2dup in? [ delete t ] [ 2drop f ] if ;
+
 M: set null? cardinality zero? ; inline
 
 M: set cardinality members length ;