1 ! Copyright (C) 2007 Daniel Ehrenberg
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: sequences kernel strings math ;
6 ! All traversal goes in postorder
8 GENERIC: branch? ( object -- ? )
10 M: sequence branch? drop t ;
11 M: integer branch? drop f ;
12 M: string branch? drop f ;
13 M: object branch? drop f ;
15 : deep-each ( obj quot: ( elt -- ) -- )
16 [ call ] 2keep over branch?
17 [ [ deep-each ] curry each ] [ 2drop ] if ; inline recursive
19 : deep-map ( obj quot: ( elt -- elt' ) -- newobj )
20 [ call ] keep over branch?
21 [ [ deep-map ] curry map ] [ drop ] if ; inline recursive
23 : deep-filter ( obj quot: ( elt -- ? ) -- seq )
25 pusher >r deep-each r>
26 r> dup branch? [ like ] [ drop ] if ; inline recursive
28 : deep-find-from ( obj quot: ( elt -- ? ) -- elt ? )
29 [ call ] 2keep rot [ drop t ] [
31 f -rot [ >r nip r> deep-find-from ] curry find drop >boolean
33 ] if ; inline recursive
35 : deep-find ( obj quot -- elt ) deep-find-from drop ; inline
37 : deep-contains? ( obj quot -- ? ) deep-find-from nip ; inline
39 : deep-all? ( obj quot -- ? )
40 [ not ] compose deep-contains? not ; inline
42 : deep-change-each ( obj quot: ( elt -- elt' ) -- )
44 [ call ] keep over >r deep-change-each r>
45 ] curry change-each ] [ 2drop ] if ; inline recursive
47 : flatten ( obj -- seq )
48 [ branch? not ] deep-filter ;