sequences.deep: adding deep-filter-as and flatten-as.

diff --git a/basis/sequences/deep/deep-docs.factor b/basis/sequences/deep/deep-docs.factor
index 8f3cba2631b2908e051cb698c28e26e80f4538b9..4d0b2e3699619ea5eeee2e2cdb5e821bccbf3a37 100644 (file)
--- a/basis/sequences/deep/deep-docs.factor
+++ b/basis/sequences/deep/deep-docs.factor
@@ -11,8 +11,12 @@ HELP: deep-map
 { $description "Execute a quotation on each nested element of an object and its children, in preorder. That is, the result of the execution of the quotation on the outer is used to map the inner elements." }
 { $see-also map } ;
 
+HELP: deep-filter-as
+{ $values { "obj" object } { "quot" { $quotation "( ... elt -- ... ? )" } } { "exemplar" sequence } { "seq" sequence } }
+{ $description "Creates a sequence (of the same type as " { $snippet "exemplar" } ") of sub-nodes in the object which satisfy the given quotation, in preorder. This includes the object itself, if it passes the quotation." } ;
+
 HELP: deep-filter
-{ $values { "obj" object } { "quot" { $quotation "( ... elt -- ... ? )" } } { "seq" "a sequence" } }
+{ $values { "obj" object } { "quot" { $quotation "( ... elt -- ... ? )" } } { "seq" sequence } }
 { $description "Creates a sequence of sub-nodes in the object which satisfy the given quotation, in preorder. This includes the object itself, if it passes the quotation." }
 { $see-also filter } ;
 
@@ -26,8 +30,12 @@ HELP: deep-any?
 { $description "Tests whether the given object or any subnode satisfies the given quotation." }
 { $see-also any? } ;
 
+HELP: flatten-as
+{ $values { "obj" object } { "exemplar" sequence } { "seq" sequence } }
+{ $description "Creates a sequence (of the same type as " { $snippet "exemplar" } ") of all of the leaf nodes (non-sequence nodes, but including strings and numbers) in the object." } ;
+
 HELP: flatten
-{ $values { "obj" object } { "seq" "a sequence" } }
+{ $values { "obj" object } { "seq" sequence } }
 { $description "Creates a sequence of all of the leaf nodes (non-sequence nodes, but including strings and numbers) in the object." } ;
 
 HELP: deep-map!

diff --git a/basis/sequences/deep/deep-tests.factor b/basis/sequences/deep/deep-tests.factor
index 63611967b9b7f859ee475a0f2cad16009c3fa471..9e5ae0e3bb5101b9dc2703bed8821b049ea7744f 100644 (file)
--- a/basis/sequences/deep/deep-tests.factor
+++ b/basis/sequences/deep/deep-tests.factor
@@ -4,6 +4,8 @@ IN: sequences.deep.tests
 
 [ [ "hello" 3 4 swap ] ] [ [ { "hello" V{ 3 4 } } swap ] flatten ] unit-test
 
+{ "ABC" } [ { { 65 } 66 { { 67 } } } "" flatten-as ] unit-test
+
 [ "foo" t ] [ { { "foo" } "bar" } [ string? ] (deep-find) ] unit-test
 
 [ f f ] [ { { "foo" } "bar" } [ number? ] (deep-find) ] unit-test

diff --git a/basis/sequences/deep/deep.factor b/basis/sequences/deep/deep.factor
index bab9f17af594ded0d8281f9293b2042428920d25..d748263b02f0e3395bc6716f429c59a3152e8bd7 100644 (file)
--- a/basis/sequences/deep/deep.factor
+++ b/basis/sequences/deep/deep.factor
@@ -20,15 +20,17 @@ M: object branch? drop f ;
     [ call ] keep over branch?
     [ '[ _ deep-map ] map ] [ drop ] if ; inline recursive
 
+: deep-filter-as ( ... obj quot: ( ... elt -- ... ? ) exemplar -- ... seq )
+    [ selector [ deep-each ] dip ] dip [ like ] when* ; inline recursive
+
 : deep-filter ( ... obj quot: ( ... elt -- ... ? ) -- ... seq )
-    over [ selector [ deep-each ] dip ] dip
-    dup branch? [ like ] [ drop ] if ; inline recursive
+    over dup branch? [ drop f ] unless deep-filter-as ; inline
 
 : (deep-find) ( ... obj quot: ( ... elt -- ... ? ) -- ... elt ? )
     [ call ] 2keep rot [ drop t ] [
         over branch? [
             [ f ] 2dip '[ nip _ (deep-find) ] any?
-        ] [ 2drop f f ] if  
+        ] [ 2drop f f ] if
     ] if ; inline recursive
 
 : deep-find ( ... obj quot: ( ... elt -- ... ? ) -- ... elt ) (deep-find) drop ; inline
@@ -55,3 +57,6 @@ M: object branch? drop f ;
 
 : flatten ( obj -- seq )
     [ branch? not ] deep-filter ;
+
+: flatten-as ( obj exemplar -- seq )
+    [ branch? not ] swap deep-filter-as ;