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

fix io.paths

db4
Doug Coleman 2008-10-02 18:26:56 -05:00
parent 17c8846e9f
commit f9661a4699
1 changed files with 15 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
extra/io/paths/paths.factor
View File

@ -1,14 +1,16 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: io.files kernel sequences accessors USING: io.files kernel sequences accessors
dlists deques arrays sequences.lib ; dlists deques arrays ;
IN: io.paths IN: io.paths
TUPLE: directory-iterator path bfs queue ; TUPLE: directory-iterator path bfs queue ;
: qualified-directory ( path -- seq ) : qualified-directory ( path -- seq )
dup directory [ first2 >r append-path r> 2array ] with map ; dup directory [ first2 [ append-path ] dip 2array ] with map ;
: push-directory ( path iter -- ) : push-directory ( path iter -- )
>r qualified-directory r> [ [ qualified-directory ] dip [
dup queue>> swap bfs>> dup queue>> swap bfs>>
[ push-front ] [ push-back ] if [ push-front ] [ push-back ] if
] curry each ; ] curry each ;
@ -24,27 +26,24 @@ TUPLE: directory-iterator path bfs queue ;
] if ; ] if ;
: iterate-directory ( iter quot -- obj ) : iterate-directory ( iter quot -- obj )
2dup >r >r >r next-file dup [ over next-file [
r> call dup [ over call
r> r> 2drop [ 2drop ] [ iterate-directory ] if
] [
drop r> r> iterate-directory
] if
] [ ] [
drop r> r> r> 3drop f 2drop f
] if ; inline ] if* ; inline recursive
: find-file ( path bfs? quot -- path/f ) : find-file ( path bfs? quot -- path/f )
>r <directory-iterator> r> [ <directory-iterator> ] dip
[ keep and ] curry iterate-directory ; inline [ keep and ] curry iterate-directory ; inline
: each-file ( path bfs? quot -- ) : each-file ( path bfs? quot -- )
>r <directory-iterator> r> [ <directory-iterator> ] dip
[ f ] compose iterate-directory drop ; inline [ f ] compose iterate-directory drop ; inline
: find-all-files ( path bfs? quot -- paths ) : find-all-files ( path bfs? quot -- paths )
>r <directory-iterator> r> [ <directory-iterator> ] dip
pusher >r [ f ] compose iterate-directory drop r> ; inline pusher [ [ f ] compose iterate-directory drop ] dip ; inline
: recursive-directory ( path bfs? -- paths ) : recursive-directory ( path bfs? -- paths )
[ ] accumulator >r each-file r> ; [ ] accumulator [ each-file ] dip ;