factor/basis/sequences/deep/deep.factor

48 lines
1.4 KiB
Factor
Raw Normal View History

2007-12-24 13:20:52 -05:00
! 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
2008-07-27 23:45:46 -04:00
GENERIC: branch? ( object -- ? )
M: sequence branch? drop t ;
M: integer branch? drop f ;
M: string branch? drop f ;
M: object branch? drop f ;
2007-12-24 13:20:52 -05:00
2008-07-18 20:22:59 -04:00
: deep-each ( obj quot: ( elt -- ) -- )
2007-12-24 13:20:52 -05:00
[ call ] 2keep over branch?
2008-07-18 20:22:59 -04:00
[ [ deep-each ] curry each ] [ 2drop ] if ; inline recursive
2007-12-24 13:20:52 -05:00
2008-07-18 20:22:59 -04:00
: deep-map ( obj quot: ( elt -- elt' ) -- newobj )
2007-12-24 13:20:52 -05:00
[ call ] keep over branch?
2008-07-18 20:22:59 -04:00
[ [ deep-map ] curry map ] [ drop ] if ; inline recursive
2007-12-24 13:20:52 -05:00
2008-07-18 20:22:59 -04:00
: deep-filter ( obj quot: ( elt -- ? ) -- seq )
2008-11-23 18:41:11 -05:00
over [ pusher [ deep-each ] dip ] dip
dup branch? [ like ] [ drop ] if ; inline recursive
2007-12-24 13:20:52 -05:00
2008-11-23 18:41:11 -05:00
: (deep-find) ( obj quot: ( elt -- ? ) -- elt ? )
2007-12-24 13:20:52 -05:00
[ call ] 2keep rot [ drop t ] [
over branch? [
2008-11-23 18:41:11 -05:00
f -rot [ [ nip ] dip (deep-find) ] curry find drop >boolean
2007-12-24 13:20:52 -05:00
] [ 2drop f f ] if
2008-07-18 20:22:59 -04:00
] if ; inline recursive
2007-12-24 13:20:52 -05:00
2008-11-23 18:41:11 -05:00
: deep-find ( obj quot -- elt ) (deep-find) drop ; inline
2007-12-24 13:20:52 -05:00
2008-11-23 18:41:11 -05:00
: deep-contains? ( obj quot -- ? ) (deep-find) nip ; inline
2007-12-24 13:20:52 -05:00
2008-02-26 03:07:11 -05:00
: deep-all? ( obj quot -- ? )
[ not ] compose deep-contains? not ; inline
2008-07-18 20:22:59 -04:00
: deep-change-each ( obj quot: ( elt -- elt' ) -- )
2008-11-23 18:41:11 -05:00
over branch? [
[ [ call ] keep over [ deep-change-each ] dip ] curry change-each
] [ 2drop ] if ; inline recursive
2007-12-24 13:20:52 -05:00
: flatten ( obj -- seq )
[ branch? not ] deep-filter ;