Adding sequences.deep

db4
Daniel Ehrenberg 2007-12-24 13:20:52 -05:00
parent d830ed9314
commit 85a5beed74
5 changed files with 100 additions and 0 deletions

View File

@ -0,0 +1 @@
Daniel Ehrenberg

View File

@ -0,0 +1,29 @@
USING: help.syntax help.markup sequences.deep ;
HELP: deep-each
{ $values { "obj" "an object" } { "quot" "a quotation ( elt -- ) " } }
{ $description "Execute a quotation on each nested element of an object and its children, in preorder." } ;
HELP: deep-map
{ $values { "obj" "an object" } { "quot" "a quotation ( elt -- newelt )" } { "newobj" "the mapped object" } }
{ $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." } ;
HELP: deep-subset
{ $values { "obj" "an object" } { "quot" "a quotation ( elt -- ? )" } { "seq" "a 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." } ;
HELP: deep-find
{ $values { "obj" "an object" } { "quot" "a quotation ( elt -- ? )" } { "elt" "an element" } }
{ $description "Gets the first sub-node of the object, in preorder, which satisfies the quotation. If nothing satisifies it, it returns " { $link f } "." } ;
HELP: deep-contains?
{ $values { "obj" "an object" } { "quot" "a quotation ( elt -- ? )" } { "?" "a boolean" } }
{ $description "Tests whether the given object or any subnode satisfies the given quotation." } ;
HELP: flatten
{ $values { "obj" "an object" } { "seq" "a sequence" } }
{ $description "Creates a sequence of all of the leaf nodes (non-sequence nodes, but including strings and numbers) in the object." } ;
HELP: deep-change-each
{ $values { "obj" "an object" } { "quot" "a quotation ( elt -- newelt )" } }
{ $description "Modifies each sub-node of an object in place, in preorder." } ;

View File

@ -0,0 +1,25 @@
USING: sequences.deep kernel tools.test strings math arrays
namespaces sequences ;
[ [ "hello" 3 4 swap ] ] [ [ { "hello" V{ 3 4 } } swap ] flatten ] unit-test
[ "foo" t ] [ { { "foo" } "bar" } [ string? ] deep-find* ] unit-test
[ f f ] [ { { "foo" } "bar" } [ number? ] deep-find* ] unit-test
[ { { "foo" } "bar" } t ] [ { { "foo" } "bar" } [ array? ] deep-find* ] unit-test
: change-something ( seq -- newseq )
dup array? [ "hi" add ] [ "hello" append ] if ;
[ { { "heyhello" "hihello" } "hihello" } ]
[ "hey" 1array 1array [ change-something ] deep-map ] unit-test
[ { { "heyhello" "hihello" } } ]
[ "hey" 1array 1array [ [ change-something ] deep-change-each ] keep ] unit-test
[ t ] [ "foo" [ string? ] deep-contains? ] unit-test
[ "foo" ] [ "foo" [ string? ] deep-find ] unit-test
[ { { 1 2 } 1 2 } ] [ [ { 1 2 } [ , ] deep-each ] { } make ] unit-test

View File

@ -0,0 +1,44 @@
! Copyright (C) 2007 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
USING: sequences kernel strings math ;
IN: sequences.deep
! All traversal goes in postorder
GENERIC: branch? ( object -- ? )
M: sequence branch? drop t ;
M: string branch? drop f ;
M: number branch? drop f ;
M: object branch? drop f ;
: deep-each ( obj quot -- )
[ call ] 2keep over branch?
[ [ deep-each ] curry each ] [ 2drop ] if ; inline
: deep-map ( obj quot -- newobj )
[ call ] keep over branch?
[ [ deep-map ] curry map ] [ drop ] if ; inline
: deep-subset ( obj quot -- seq )
over >r
pusher >r deep-each r>
r> dup branch? [ like ] [ drop ] if ; inline
: deep-find* ( obj quot -- elt ? )
[ call ] 2keep rot [ drop t ] [
over branch? [
f -rot [ >r nip r> deep-find* ] curry find drop >boolean
] [ 2drop f f ] if
] if ; inline
: deep-find ( obj quot -- elt ) deep-find* drop ; inline
: deep-contains? ( obj quot -- ? ) deep-find* nip ; inline
: deep-change-each ( obj quot -- )
over branch? [ [
[ call ] keep over >r deep-change-each r>
] curry change-each ] [ 2drop ] if ; inline
: flatten ( obj -- seq )
[ branch? not ] deep-subset ;

View File

@ -0,0 +1 @@
Sequence/tree combinators like deep-map, deep-each, etc