sets: adding clear-set.

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 ;

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." } ;

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

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 ]