diff --git a/core/hash-sets/hash-sets.factor b/core/hash-sets/hash-sets.factor index 62fe7d016a..fa88cf60bd 100644 --- a/core/hash-sets/hash-sets.factor +++ b/core/hash-sets/hash-sets.factor @@ -25,6 +25,7 @@ M: hash-set cardinality table>> assoc-size ; M: hash-set intersect small/large sequence/tester filter >hash-set ; M: hash-set union (union) >hash-set ; M: hash-set diff sequence/tester [ not ] compose filter >hash-set ; +M: hash-set clear-set table>> clear-assoc ; M: sequence fast-set >hash-set ; M: f fast-set drop H{ } clone hash-set boa ; diff --git a/core/sets/sets-docs.factor b/core/sets/sets-docs.factor index 0a53ec9829..8f77552e77 100644 --- a/core/sets/sets-docs.factor +++ b/core/sets/sets-docs.factor @@ -24,6 +24,7 @@ ARTICLE: "set-operations" "Operations on sets" { $subsections adjoin delete + clear-set } "To test if a set is the empty set:" { $subsections null? } @@ -97,6 +98,11 @@ HELP: delete { $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: clear-set +{ $values { "set" set } } +{ $contract "Removes all entries from the set." } +{ $side-effects "set" } ; + HELP: members { $values { "set" set } { "seq" sequence } } { $description "Creates a sequence with a single copy of each member of the set." $nl "Each set type is expected to implement a method on this generic word." } ; diff --git a/core/sets/sets-tests.factor b/core/sets/sets-tests.factor index 1d1413a4ae..166e4ebd2f 100644 --- a/core/sets/sets-tests.factor +++ b/core/sets/sets-tests.factor @@ -123,3 +123,6 @@ M: null-set members drop f ; [ t ] [ { } set? ] unit-test [ t ] [ 5 set? ] unit-test [ f ] [ H{ } set? ] unit-test + +[ HS{ } ] [ HS{ } [ clear-set ] keep ] unit-test +[ HS{ } ] [ HS{ 1 2 3 } [ clear-set ] keep ] unit-test diff --git a/core/sets/sets.factor b/core/sets/sets.factor index 93d880c642..b289f06734 100644 --- a/core/sets/sets.factor +++ b/core/sets/sets.factor @@ -22,9 +22,12 @@ GENERIC: duplicates ( set -- seq ) GENERIC: all-unique? ( set -- ? ) GENERIC: null? ( set -- ? ) GENERIC: cardinality ( set -- n ) +GENERIC: clear-set ( set -- ) M: f cardinality drop 0 ; +M: f clear-set drop ; inline + ! Defaults for some methods. ! Override them for efficiency @@ -32,6 +35,8 @@ M: set null? members null? ; inline M: set cardinality members length ; +M: set clear-set [ members ] keep [ delete ] curry each ; + M: set set-like drop ; inline