assocs: Add harvest-keys, harvest-values to core/. Remove assoc-sift because it's sift-keys, sift-values in core/.

core/assocs/assocs-docs.factor

@@ -161,6 +161,8 @@ $nl
 { $subsections
     sift-keys
     sift-values
+    harvest-keys
+    harvest-values
 }
 "Mapping between assocs and sequences:"
 { $subsections
@@ -343,11 +345,42 @@ HELP: assoc-subset?
 
 HELP: sift-keys
 { $values { "assoc" assoc } { "assoc'" "a new assoc" } }
-{ $description "Outputs an assoc removing keys that are " { $link f } "." } ;
+{ $description "Outputs an assoc removing keys that are " { $link f } "." }
+{ $examples
+    { $example "USING: prettyprint assocs hashtables ;"
+        "H{ { 1 2 } { f 3 } } sift-keys ."
+        "H{ { 1 2 } }" }
+} ;
 
 HELP: sift-values
 { $values { "assoc" assoc } { "assoc'" "a new assoc" } }
-{ $description "Outputs an assoc removing values that are " { $link f } "." } ;
+{ $description "Outputs an assoc removing values that are " { $link f } "." }
+{ $examples
+    { $example "USING: prettyprint assocs hashtables ;"
+        "H{ { 1 f } { 3 4 } } sift-values ."
+        "H{ { 3 4 } }" }
+} ;
+
+{ sift-keys sift-values harvest-keys harvest-values } related-words
+
+HELP: harvest-keys
+{ $values { "assoc" assoc } { "assoc'" "a new assoc" } }
+{ $description "Outputs an assoc removing keys that are empty sequences." }
+{ $examples
+    { $example "USING: prettyprint assocs hashtables ;"
+        "H{ { { 2 } 1 } { { } 3 } } harvest-keys ."
+        "H{ { { 2 } 1 } }" }
+} ;
+
+HELP: harvest-values
+{ $values { "assoc" assoc } { "assoc'" "a new assoc" } }
+{ $description "Outputs an assoc removing values that are empty sequences." }
+{ $examples
+    { $example "USING: prettyprint assocs hashtables ;"
+        "H{ { 1 { } } { 3 { 4 } } } harvest-values ."
+        "H{ { 3 { 4 } } }" }
+} ;
+
 
 HELP: assoc=
 { $values { "assoc1" assoc } { "assoc2" assoc } { "?" boolean } }

core/assocs/assocs-tests.factor

@@ -217,6 +217,28 @@ unit-test
     { { 1 f } { f 2 } } sift-keys
 ] unit-test
 
+{
+    {
+        { { 2 } 1 }
+    }
+} [
+    {
+        { { 2 } 1 }
+        { { } 3 }
+    } harvest-keys
+] unit-test
+
+{
+    {
+        { 1 { 2 } }
+    }
+} [
+    {
+        { 1 { 2 } }
+        { 3 { } }
+    } harvest-values
+] unit-test
+
 {
     { { f 2 } }
 } [

core/assocs/assocs.factor

@@ -95,6 +95,12 @@ PRIVATE>
 : sift-values ( assoc -- assoc' )
     [ nip ] assoc-filter ; inline
 
+: harvest-keys ( assoc -- assoc' )
+    [ drop empty? ] assoc-reject ; inline
+
+: harvest-values ( assoc -- assoc' )
+    [ nip empty? ] assoc-reject ; inline
+
 : assoc-partition ( ... assoc quot: ( ... key value -- ... ? ) -- ... true-assoc false-assoc )
     [ (assoc-each) partition ] [ drop ] 2bi
     [ assoc-like ] curry bi@ ; inline

extra/assocs/extras/extras.factor

@@ -5,12 +5,6 @@ USING: arrays assocs assocs.private kernel math sequences ;
 
 IN: assocs.extras
 
-: assoc-sift ( assoc -- assoc' )
-    [ nip ] assoc-filter ; inline
-
-: assoc-harvest ( assoc -- assoc' )
-    [ nip empty? ] assoc-reject ; inline
-
 : deep-at ( assoc seq -- value/f )
     [ of ] each ; inline