2008-03-20 16:30:59 -04:00
|
|
|
USING: io.files kernel sequences accessors
|
2008-06-11 03:58:38 -04:00
|
|
|
dlists dequeues arrays sequences.lib ;
|
2007-12-09 12:42:35 -05:00
|
|
|
IN: io.paths
|
|
|
|
|
2008-02-25 04:38:52 -05:00
|
|
|
TUPLE: directory-iterator path bfs queue ;
|
2007-12-09 12:42:35 -05:00
|
|
|
|
2008-02-25 04:38:52 -05:00
|
|
|
: qualified-directory ( path -- seq )
|
2008-03-19 20:15:32 -04:00
|
|
|
dup directory [ first2 >r append-path r> 2array ] with map ;
|
2007-12-09 12:42:35 -05:00
|
|
|
|
2008-02-25 04:38:52 -05:00
|
|
|
: push-directory ( path iter -- )
|
|
|
|
>r qualified-directory r> [
|
|
|
|
dup queue>> swap bfs>>
|
|
|
|
[ push-front ] [ push-back ] if
|
|
|
|
] curry each ;
|
2007-12-09 12:42:35 -05:00
|
|
|
|
2008-02-25 04:38:52 -05:00
|
|
|
: <directory-iterator> ( path bfs? -- iterator )
|
2008-04-13 16:06:27 -04:00
|
|
|
<dlist> directory-iterator boa
|
2008-02-25 04:38:52 -05:00
|
|
|
dup path>> over push-directory ;
|
2008-02-12 13:16:12 -05:00
|
|
|
|
2008-02-25 04:38:52 -05:00
|
|
|
: next-file ( iter -- file/f )
|
2008-06-11 03:58:38 -04:00
|
|
|
dup queue>> dequeue-empty? [ drop f ] [
|
2008-02-25 04:38:52 -05:00
|
|
|
dup queue>> pop-back first2
|
|
|
|
[ over push-directory next-file ] [ nip ] if
|
2008-02-12 13:16:12 -05:00
|
|
|
] if ;
|
|
|
|
|
2008-02-25 04:38:52 -05:00
|
|
|
: iterate-directory ( iter quot -- obj )
|
|
|
|
2dup >r >r >r next-file dup [
|
|
|
|
r> call dup [
|
|
|
|
r> r> 2drop
|
|
|
|
] [
|
|
|
|
drop r> r> iterate-directory
|
|
|
|
] if
|
|
|
|
] [
|
|
|
|
drop r> r> r> 3drop f
|
|
|
|
] if ; inline
|
2008-02-12 13:16:12 -05:00
|
|
|
|
2008-02-25 04:38:52 -05:00
|
|
|
: find-file ( path bfs? quot -- path/f )
|
2008-02-26 19:47:05 -05:00
|
|
|
>r <directory-iterator> r>
|
|
|
|
[ keep and ] curry iterate-directory ; inline
|
|
|
|
|
|
|
|
: each-file ( path bfs? quot -- )
|
|
|
|
>r <directory-iterator> r>
|
|
|
|
[ f ] compose iterate-directory drop ; inline
|
2008-02-25 04:38:52 -05:00
|
|
|
|
|
|
|
: find-all-files ( path bfs? quot -- paths )
|
2008-02-26 19:47:05 -05:00
|
|
|
>r <directory-iterator> r>
|
2008-03-24 18:19:22 -04:00
|
|
|
pusher >r [ f ] compose iterate-directory drop r> ; inline
|
2008-02-12 13:16:12 -05:00
|
|
|
|
2008-02-25 04:38:52 -05:00
|
|
|
: recursive-directory ( path bfs? -- paths )
|
2008-02-26 19:47:05 -05:00
|
|
|
[ ] accumulator >r each-file r> ;
|