From de48558d12e6363a3bc3066f53d58f6a3ea63afd Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Tue, 7 Feb 2017 13:31:07 -0800 Subject: [PATCH] sets: adding ?delete that returns a boolean if elt was deleted from set. --- basis/delegate/protocols/protocols.factor | 2 +- basis/hash-sets/wrapped/wrapped.factor | 3 +++ core/hash-sets/hash-sets-tests.factor | 4 ++++ core/hash-sets/hash-sets.factor | 18 ++++++++++++------ core/sets/sets-docs.factor | 7 +++++-- core/sets/sets-tests.factor | 4 ++++ core/sets/sets.factor | 3 +++ 7 files changed, 32 insertions(+), 9 deletions(-) diff --git a/basis/delegate/protocols/protocols.factor b/basis/delegate/protocols/protocols.factor index aca50d293c..7576cc9ef7 100644 --- 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 76dc893edc..0e9c9bbf89 100644 --- 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 46dc06849f..d9a2b9c17b 100644 --- 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 9e99dc6a1a..1a7cbad43f 100644 --- 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 beed7fd8a4..a3645d8f75 100644 --- 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 0ffd8aff08..0e2a23a593 100644 --- 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 0 over delete cardinality ] unit-test { 0 } [ 5 f over delete cardinality ] unit-test { 0 } [ 5 3 over adjoin 3 over delete cardinality ] unit-test diff --git a/core/sets/sets.factor b/core/sets/sets.factor index 22756b92f3..b65f4ba562 100644 --- 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 ; -- 2.34.1