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

diff --git a/basis/delegate/protocols/protocols.factor b/basis/delegate/protocols/protocols.factor
index aca50d293c316d4d3fb0e6b549603d21b39d8620..7576cc9ef78d8b17aa5f3aedbec9644fcee489df 100644 (file)
--- a/basis/delegate/protocols/protocols.factor
+++ b/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 ;
 

diff --git a/basis/hash-sets/wrapped/wrapped.factor b/basis/hash-sets/wrapped/wrapped.factor
index 76dc893edccba34541fe2ee60d81b04b45c170be..0e9c9bbf89dc5aeb1b922e9ed147bc5deeee96b9 100644 (file)
--- a/basis/hash-sets/wrapped/wrapped.factor
+++ b/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
 

diff --git a/core/hash-sets/hash-sets-tests.factor b/core/hash-sets/hash-sets-tests.factor
index 46dc06849fb1dfc5d6f3fa965df50333566e06a1..d9a2b9c17b3ebcf24ca53b57be8e4182521b1b4f 100644 (file)
--- a/core/hash-sets/hash-sets-tests.factor
+++ b/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
 

diff --git a/core/hash-sets/hash-sets.factor b/core/hash-sets/hash-sets.factor
index 9e99dc6a1a99c041624d6fe27d57719acfa54dac..1a7cbad43fbe8ab7a42f1a53e4292858405cc75e 100644 (file)
--- a/core/hash-sets/hash-sets.factor
+++ b/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

diff --git a/core/sets/sets-docs.factor b/core/sets/sets-docs.factor
index beed7fd8a477236b1756b38f3e4a288bdf108864..a3645d8f757c45a7b74d276fa9c4fbc8d3e0c549 100644 (file)
--- a/core/sets/sets-docs.factor
+++ b/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." }

diff --git a/core/sets/sets-tests.factor b/core/sets/sets-tests.factor
index 0ffd8aff08777cdf276e0c57ec98ea8663b1f9c8..0e2a23a593f49fdf443d2e73bba4cfefc2a58038 100644 (file)
--- a/core/sets/sets-tests.factor
+++ b/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

diff --git a/core/sets/sets.factor b/core/sets/sets.factor
index 22756b92f30940c6d0fb0cabaf09aadadcad1771..b65f4ba5622973e4b99f07c406a658c3c7219591 100644 (file)
--- a/core/sets/sets.factor
+++ b/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 ;