sets: adding clear-set.

diff --git a/core/hash-sets/hash-sets.factor b/core/hash-sets/hash-sets.factor
index 62fe7d016a5a7f182d377d5d46984a64336e983f..fa88cf60bd967ecfb42992f700ca1b45e4d7c622 100644 (file)
--- 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 0a53ec98293f456e6a8a0e69e7dee09c3a5dca80..8f77552e77ebaa2eab31079560cd5b4e33c1c47e 100644 (file)
--- 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 1d1413a4ae3b014c29f7bb70a48e8ecc1ec63d0d..166e4ebd2f22499abdf64ca105e9a32b02263dff 100644 (file)
--- 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 <bit-set> 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 93d880c64262e274eb61984b6898c8d4f3e51a1d..b289f0673426bf6ad65be627cfccecb0de709ec0 100644 (file)
--- 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
 
 <PRIVATE
@@ -125,6 +130,9 @@ M: sequence null?
 M: sequence cardinality
     fast-set cardinality ;
 
+M: sequence clear-set
+    delete-all ; inline
+
 : combine ( sets -- set/f )
     [ f ]
     [ [ [ ?members ] map concat ] [ first ] bi set-like ]