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

diff --git a/core/assocs/assocs-docs.factor b/core/assocs/assocs-docs.factor
index 96300ac86da3da873408df910db2d7d93ed32296..00c9847914fdec22cef25952203a4d0de5162629 100644 (file)
--- a/core/assocs/assocs-docs.factor
+++ b/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 } }

diff --git a/core/assocs/assocs-tests.factor b/core/assocs/assocs-tests.factor
index 6e715a32489e91dccb5d3592e124303ac891b811..f780adbca2a94033e84984eb178f9e4e574adab0 100644 (file)
--- a/core/assocs/assocs-tests.factor
+++ b/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 } }
 } [

diff --git a/core/assocs/assocs.factor b/core/assocs/assocs.factor
index ef61ab0bbb67587c4b88ce927993a09b3e1e0da0..8294c8c83c0a675e999653545857d6cd5f3421e3 100644 (file)
--- a/core/assocs/assocs.factor
+++ b/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

diff --git a/extra/assocs/extras/extras.factor b/extra/assocs/extras/extras.factor
index a145599605daeed244d48b5ab25162ff5918d03f..cf63ee847259805f023b91e9bf7be6e3cc02c1b0 100644 (file)
--- a/extra/assocs/extras/extras.factor
+++ b/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