steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

db4
John Benediktsson 2012-07-11 14:18:11 -07:00
parent bdf02bfd2b
commit c22fcb8e2b
3 changed files with 20 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
basis/sequences/deep/deep-docs.factor
View File

@ -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." } { $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 } ; { $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 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." } { $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 } ; { $see-also filter } ;
@ -26,8 +30,12 @@ HELP: deep-any?
{ $description "Tests whether the given object or any subnode satisfies the given quotation." } { $description "Tests whether the given object or any subnode satisfies the given quotation." }
{ $see-also any? } ; { $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 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." } ; { $description "Creates a sequence of all of the leaf nodes (non-sequence nodes, but including strings and numbers) in the object." } ;
HELP: deep-map! HELP: deep-map!

2
basis/sequences/deep/deep-tests.factor
View File

@ -4,6 +4,8 @@ IN: sequences.deep.tests
[ [ "hello" 3 4 swap ] ] [ [ { "hello" V{ 3 4 } } swap ] flatten ] unit-test [ [ "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 [ "foo" t ] [ { { "foo" } "bar" } [ string? ] (deep-find) ] unit-test
[ f f ] [ { { "foo" } "bar" } [ number? ] (deep-find) ] unit-test [ f f ] [ { { "foo" } "bar" } [ number? ] (deep-find) ] unit-test

11
basis/sequences/deep/deep.factor
View File

@ -20,15 +20,17 @@ M: object branch? drop f ;
[ call ] keep over branch? [ call ] keep over branch?
[ '[ _ deep-map ] map ] [ drop ] if ; inline recursive [ '[ _ 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 ) : deep-filter ( ... obj quot: ( ... elt -- ... ? ) -- ... seq )
over [ selector [ deep-each ] dip ] dip over dup branch? [ drop f ] unless deep-filter-as ; inline
dup branch? [ like ] [ drop ] if ; inline recursive
: (deep-find) ( ... obj quot: ( ... elt -- ... ? ) -- ... elt ? ) : (deep-find) ( ... obj quot: ( ... elt -- ... ? ) -- ... elt ? )
[ call ] 2keep rot [ drop t ] [ [ call ] 2keep rot [ drop t ] [
over branch? [ over branch? [
[ f ] 2dip '[ nip _ (deep-find) ] any? [ f ] 2dip '[ nip _ (deep-find) ] any?
] [ 2drop f f ] if ] [ 2drop f f ] if
] if ; inline recursive ] if ; inline recursive
: deep-find ( ... obj quot: ( ... elt -- ... ? ) -- ... elt ) (deep-find) drop ; inline : deep-find ( ... obj quot: ( ... elt -- ... ? ) -- ... elt ) (deep-find) drop ; inline
@ -55,3 +57,6 @@ M: object branch? drop f ;
: flatten ( obj -- seq ) : flatten ( obj -- seq )
[ branch? not ] deep-filter ; [ branch? not ] deep-filter ;
: flatten-as ( obj exemplar -- seq )
[ branch? not ] swap deep-filter-as ;