Merge branch 'master' into inline_caching
Slava Pestov
commit
dd306a6212
basis/io/directories/search
7
Makefile
7
Makefile
|
|
@ -7,7 +7,6 @@ CONSOLE_EXECUTABLE = factor-console
|
|||
TEST_LIBRARY = factor-ffi-test
|
||||
VERSION = 0.92
|
||||
|
||||
IMAGE = factor.image
|
||||
BUNDLE = Factor.app
|
||||
LIBPATH = -L/usr/X11R6/lib
|
||||
CFLAGS = -Wall
|
||||
|
|
@ -152,17 +151,17 @@ macosx.app: factor
|
|||
@executable_path/../Frameworks/libfactor.dylib \
|
||||
Factor.app/Contents/MacOS/factor
|
||||
|
||||
factor: $(DLL_OBJS) $(EXE_OBJS)
|
||||
$(EXECUTABLE): $(DLL_OBJS) $(EXE_OBJS)
|
||||
$(LINKER) $(ENGINE) $(DLL_OBJS)
|
||||
$(CC) $(LIBS) $(LIBPATH) -L. $(LINK_WITH_ENGINE) \
|
||||
$(CFLAGS) -o $@$(EXE_SUFFIX)$(EXE_EXTENSION) $(EXE_OBJS)
|
||||
|
||||
factor-console: $(DLL_OBJS) $(EXE_OBJS)
|
||||
$(CONSOLE_EXECUTABLE): $(DLL_OBJS) $(EXE_OBJS)
|
||||
$(LINKER) $(ENGINE) $(DLL_OBJS)
|
||||
$(CC) $(LIBS) $(LIBPATH) -L. $(LINK_WITH_ENGINE) \
|
||||
$(CFLAGS) $(CFLAGS_CONSOLE) -o factor$(EXE_SUFFIX)$(CONSOLE_EXTENSION) $(EXE_OBJS)
|
||||
|
||||
factor-ffi-test: vm/ffi_test.o
|
||||
$(TEST_LIBRARY): vm/ffi_test.o
|
||||
$(CC) $(LIBPATH) $(CFLAGS) $(FFI_TEST_CFLAGS) $(SHARED_FLAG) -o libfactor-ffi-test$(SHARED_DLL_EXTENSION) $(TEST_OBJS)
|
||||
|
||||
clean:
|
||||
|
|
|
|||
|
|
@ -15,13 +15,20 @@ HELP: each-file
|
|||
}
|
||||
} ;
|
||||
|
||||
HELP: recursive-directory
|
||||
HELP: recursive-directory-files
|
||||
{ $values
|
||||
{ "path" "a pathname string" } { "bfs?" "a boolean, breadth-first or depth-first" }
|
||||
{ "paths" "a sequence of pathname strings" }
|
||||
}
|
||||
{ $description "Traverses a directory path recursively and returns a sequence of files in a breadth-first or depth-first manner." } ;
|
||||
|
||||
HELP: recursive-directory-entries
|
||||
{ $values
|
||||
{ "path" "a pathname string" } { "bfs?" "a boolean, breadth-first or depth-first" }
|
||||
{ "directory-entries" "a sequence of directory-entries" }
|
||||
}
|
||||
{ $description "Traverses a directory path recursively and returns a sequence of directory-entries in a breadth-first or depth-first manner." } ;
|
||||
|
||||
HELP: find-file
|
||||
{ $values
|
||||
{ "path" "a pathname string" } { "bfs?" "a boolean, breadth-first or depth-first" } { "quot" quotation }
|
||||
|
|
@ -41,11 +48,11 @@ HELP: find-all-files
|
|||
{ "path" "a pathname string" } { "quot" quotation }
|
||||
{ "paths/f" "a sequence of pathname strings or f" }
|
||||
}
|
||||
{ $description "Finds all files in the input directory matching the predicate quotation in a breadth-first or depth-first traversal." } ;
|
||||
{ $description "Recursively finds all files in the input directory matching the predicate quotation." } ;
|
||||
|
||||
HELP: find-all-in-directories
|
||||
{ $values
|
||||
{ "directories" "a sequence of directory paths" } { "bfs?" "a boolean, breadth-first or depth-first" } { "quot" quotation }
|
||||
{ "directories" "a sequence of directory paths" } { "quot" quotation }
|
||||
{ "paths/f" "a sequence of pathname strings or f" }
|
||||
}
|
||||
{ $description "Finds all files in the input directories matching the predicate quotation in a breadth-first or depth-first traversal." } ;
|
||||
|
|
@ -55,7 +62,8 @@ HELP: find-all-in-directories
|
|||
ARTICLE: "io.directories.search" "Searching directories"
|
||||
"The " { $vocab-link "io.directories.search" } " vocabulary contains words used for recursively iterating over a directory and for finding files in a directory tree." $nl
|
||||
"Traversing directories:"
|
||||
{ $subsection recursive-directory }
|
||||
{ $subsection recursive-directory-files }
|
||||
{ $subsection recursive-directory-entries }
|
||||
{ $subsection each-file }
|
||||
"Finding files:"
|
||||
{ $subsection find-file }
|
||||
|
|
|
|||
|
|
@ -1,12 +1,14 @@
|
|||
USING: io.directories.search io.files io.files.unique
|
||||
io.pathnames kernel namespaces sequences sorting tools.test ;
|
||||
USING: combinators.smart io.directories
|
||||
io.directories.hierarchy io.directories.search io.files
|
||||
io.files.unique io.pathnames kernel namespaces sequences
|
||||
sorting strings tools.test ;
|
||||
IN: io.directories.search.tests
|
||||
|
||||
[ t ] [
|
||||
[
|
||||
10 [ "io.paths.test" "gogogo" make-unique-file ] replicate
|
||||
current-temporary-directory get [ ] find-all-files
|
||||
] with-unique-directory drop [ natural-sort ] bi@ =
|
||||
] cleanup-unique-directory [ natural-sort ] bi@ =
|
||||
] unit-test
|
||||
|
||||
[ f ] [
|
||||
|
|
@ -18,3 +20,18 @@ IN: io.directories.search.tests
|
|||
[ f ] [
|
||||
{ } t [ "asdfasdfasdfasdfasdf" tail? ] find-in-directories
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
[
|
||||
current-temporary-directory get
|
||||
"the-head" unique-file drop t
|
||||
[ file-name "the-head" head? ] find-file string?
|
||||
] cleanup-unique-directory
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
[ unique-directory unique-directory ] output>array
|
||||
[ [ "abcd" append-path touch-file ] each ]
|
||||
[ [ file-name "abcd" = ] find-all-in-directories length 2 = ]
|
||||
[ [ delete-tree ] each ] tri
|
||||
] unit-test
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
USING: accessors arrays continuations deques dlists fry
|
||||
io.directories io.files io.files.info io.pathnames kernel
|
||||
sequences system vocabs.loader locals math namespaces
|
||||
sorting assocs calendar threads ;
|
||||
sorting assocs calendar threads io math.parser ;
|
||||
IN: io.directories.search
|
||||
|
||||
: qualified-directory-entries ( path -- seq )
|
||||
|
|
@ -13,90 +13,97 @@ IN: io.directories.search
|
|||
: qualified-directory-files ( path -- seq )
|
||||
dup directory-files [ append-path ] with map ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
TUPLE: directory-iterator path bfs queue ;
|
||||
|
||||
: push-directory ( path iter -- )
|
||||
[ dup directory-entry? [ name>> ] when ] dip
|
||||
[ qualified-directory-entries ] dip '[
|
||||
_ [ queue>> ] [ bfs>> ] bi
|
||||
[ push-front ] [ push-back ] if
|
||||
] each ;
|
||||
|
||||
: <directory-iterator> ( path bfs? -- iterator )
|
||||
<dlist> directory-iterator boa
|
||||
dup path>> over push-directory ;
|
||||
|
||||
: next-file ( iter -- file/f )
|
||||
dup queue>> deque-empty? [ drop f ] [
|
||||
dup queue>> pop-back dup directory?
|
||||
[ over push-directory next-file ]
|
||||
[ nip name>> ] if
|
||||
] if ;
|
||||
|
||||
:: iterate-directory ( iter quot: ( obj -- ? ) -- obj )
|
||||
iter next-file [
|
||||
quot call [ iter quot iterate-directory ] unless*
|
||||
] [
|
||||
f
|
||||
] if* ; inline recursive
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: each-file ( path bfs? quot: ( obj -- ) -- )
|
||||
[ <directory-iterator> ] dip
|
||||
[ f ] compose iterate-directory drop ; inline
|
||||
|
||||
: recursive-directory ( path bfs? -- paths )
|
||||
[ ] accumulator [ each-file ] dip ;
|
||||
|
||||
: find-file ( path bfs? quot: ( obj -- ? ) -- path/f )
|
||||
'[
|
||||
_ _ _ [ <directory-iterator> ] dip
|
||||
[ keep and ] curry iterate-directory
|
||||
] [ drop f ] recover ; inline
|
||||
|
||||
: find-all-files ( path quot: ( obj -- ? ) -- paths/f )
|
||||
f swap
|
||||
'[
|
||||
_ _ _ [ <directory-iterator> ] dip
|
||||
pusher [ [ f ] compose iterate-directory drop ] dip
|
||||
] [ drop f ] recover ; inline
|
||||
|
||||
ERROR: file-not-found ;
|
||||
|
||||
: find-in-directories ( directories bfs? quot: ( obj -- ? ) -- path'/f )
|
||||
'[
|
||||
_ [ _ _ find-file [ file-not-found ] unless* ] attempt-all
|
||||
] [
|
||||
drop f
|
||||
] recover ; inline
|
||||
|
||||
: find-all-in-directories ( directories bfs? quot: ( obj -- ? ) -- paths/f )
|
||||
'[ _ _ find-all-files ] map concat ; inline
|
||||
|
||||
: with-qualified-directory-files ( path quot -- )
|
||||
'[ "" qualified-directory-files @ ] with-directory ; inline
|
||||
|
||||
: with-qualified-directory-entries ( path quot -- )
|
||||
'[ "" qualified-directory-entries @ ] with-directory ; inline
|
||||
|
||||
<PRIVATE
|
||||
|
||||
TUPLE: directory-iterator path bfs queue ;
|
||||
|
||||
: push-directory-entries ( path iter -- )
|
||||
[ [ qualified-directory-entries ] [ 2drop f ] recover ] dip '[
|
||||
_ [ queue>> ] [ bfs>> ] bi
|
||||
[ push-front ] [ push-back ] if
|
||||
] each ;
|
||||
|
||||
: <directory-iterator> ( path bfs? -- iterator )
|
||||
<dlist> directory-iterator boa
|
||||
dup path>> over push-directory-entries ;
|
||||
|
||||
: next-directory-entry ( iter -- directory-entry/f )
|
||||
dup queue>> deque-empty? [ drop f ] [
|
||||
dup queue>> pop-back
|
||||
dup directory?
|
||||
[ name>> over push-directory-entries next-directory-entry ]
|
||||
[ nip ] if
|
||||
] if ; recursive
|
||||
|
||||
:: iterate-directory-entries ( iter quot -- directory-entry/f )
|
||||
iter next-directory-entry [
|
||||
quot call( obj -- obj )
|
||||
[ iter quot iterate-directory-entries ] unless*
|
||||
] [
|
||||
f
|
||||
] if* ; inline recursive
|
||||
|
||||
: iterate-directory ( iter quot -- path/f )
|
||||
[ name>> ] prepose iterate-directory-entries ;
|
||||
|
||||
: setup-traversal ( path bfs quot -- iterator quot' )
|
||||
[ <directory-iterator> ] dip [ f ] compose ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: each-file ( path bfs? quot -- )
|
||||
setup-traversal iterate-directory drop ;
|
||||
|
||||
: each-directory-entry ( path bfs? quot -- )
|
||||
setup-traversal iterate-directory-entries drop ;
|
||||
|
||||
: recursive-directory-files ( path bfs? -- paths )
|
||||
[ ] accumulator [ each-file ] dip ;
|
||||
|
||||
: recursive-directory-entries ( path bfs? -- paths )
|
||||
[ ] accumulator [ each-directory-entry ] dip ;
|
||||
|
||||
: find-file ( path bfs? quot -- path/f )
|
||||
[ <directory-iterator> ] dip
|
||||
[ keep and ] curry iterate-directory ;
|
||||
|
||||
: find-all-files ( path quot -- paths/f )
|
||||
[ f <directory-iterator> ] dip pusher
|
||||
[ [ f ] compose iterate-directory drop ] dip ;
|
||||
|
||||
ERROR: file-not-found path bfs? quot ;
|
||||
|
||||
: find-file-throws ( path bfs? quot -- path )
|
||||
3dup find-file dup [ 2nip nip ] [ drop file-not-found ] if ;
|
||||
|
||||
: find-in-directories ( directories bfs? quot -- path'/f )
|
||||
'[ _ [ _ _ find-file-throws ] attempt-all ]
|
||||
[ drop f ] recover ;
|
||||
|
||||
: find-all-in-directories ( directories quot -- paths/f )
|
||||
'[ _ find-all-files ] map concat ;
|
||||
|
||||
: link-size/0 ( path -- n )
|
||||
[ link-info size-on-disk>> ] [ 2drop 0 ] recover ;
|
||||
|
||||
: directory-size ( path -- n )
|
||||
0 swap t [
|
||||
[ link-info size-on-disk>> + ] [ 2drop ] recover
|
||||
] each-file ;
|
||||
0 swap t [ link-size/0 + ] each-file ;
|
||||
|
||||
: path>usage ( directory-entry -- name size )
|
||||
[ name>> dup ] [ directory? ] bi [
|
||||
directory-size
|
||||
] [
|
||||
[ link-info size-on-disk>> ] [ 2drop 0 ] recover
|
||||
] if ;
|
||||
[ name>> dup ] [ directory? ] bi
|
||||
[ directory-size ] [ link-size/0 ] if ;
|
||||
|
||||
: directory-usage ( path -- assoc )
|
||||
[
|
||||
[ [ path>usage ] [ drop name>> 0 ] recover ] { } map>assoc
|
||||
[
|
||||
[ path>usage ] [ drop name>> 0 ] recover
|
||||
] { } map>assoc
|
||||
] with-qualified-directory-entries sort-values ;
|
||||
|
||||
os windows? [ "io.directories.search.windows" require ] when
|
||||
|
|
|
|||
Loading…
Reference in New Issue