From 19be5cd5e55d3dc5653e3d66e46b0f4c001d2481 Mon Sep 17 00:00:00 2001 From: "U-HPLAPTOP\\Ken" Date: Mon, 20 Apr 2009 21:06:42 -0500 Subject: [PATCH 1/5] word change --- basis/help/cookbook/cookbook.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/help/cookbook/cookbook.factor b/basis/help/cookbook/cookbook.factor index 9bb76f8d5a..cd26c6856e 100644 --- a/basis/help/cookbook/cookbook.factor +++ b/basis/help/cookbook/cookbook.factor @@ -67,7 +67,7 @@ $nl } "In Factor, this example will print 3 since word redefinition is explicitly supported." $nl - "Indeed, redefining a word twice in the same source file is an error; this is almost always a mistake since there's no way to call the first definition. See " { $link "definition-checking" } "." + "However, redefining a word twice in the same source file is an error; this is almost always a mistake since there's no way to call the first definition. See " { $link "definition-checking" } "." } { $references { "A whole slew of shuffle words can be used to rearrange the stack. There are forms of word definition other than colon definition, words can be defined entirely at runtime, and word definitions can be " { $emphasis "annotated" } " with tracing calls and breakpoints without modifying the source code." } From 7095ace2c1044615fed09422e8c540ec8a8328b0 Mon Sep 17 00:00:00 2001 From: Ken Causey Date: Mon, 20 Apr 2009 22:11:01 -0500 Subject: [PATCH 2/5] Makes it possible to change the names of the exectables named in the variables at the top of the Makefile and still build. Also removes unused IMAGE variable. --- Makefile | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/Makefile b/Makefile index 35a5ba58bf..db99120a77 100644 --- a/Makefile +++ b/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 @@ -151,17 +150,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: From 33743c1a3d0a240ca6150ac872b4eab80d32b1db Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 24 Apr 2009 14:49:31 -0500 Subject: [PATCH 3/5] refactor io.directories.search --- .../io/directories/search/search-docs.factor | 4 +- basis/io/directories/search/search.factor | 98 +++++++++++-------- 2 files changed, 58 insertions(+), 44 deletions(-) diff --git a/basis/io/directories/search/search-docs.factor b/basis/io/directories/search/search-docs.factor index 818899606d..fb172b78e0 100644 --- a/basis/io/directories/search/search-docs.factor +++ b/basis/io/directories/search/search-docs.factor @@ -41,11 +41,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." } ; diff --git a/basis/io/directories/search/search.factor b/basis/io/directories/search/search.factor index 87fbf67110..440c3a0326 100755 --- a/basis/io/directories/search/search.factor +++ b/basis/io/directories/search/search.factor @@ -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,12 +13,17 @@ IN: io.directories.search : qualified-directory-files ( path -- seq ) dup directory-files [ append-path ] with map ; +: with-qualified-directory-files ( path quot -- ) + '[ "" qualified-directory-files @ ] with-directory ; inline + +: with-qualified-directory-entries ( path quot -- ) + '[ "" qualified-directory-entries @ ] with-directory ; inline + > ] when ] dip +: push-directory-entries ( path iter -- ) [ qualified-directory-entries ] dip '[ _ [ queue>> ] [ bfs>> ] bi [ push-front ] [ push-back ] if @@ -26,77 +31,86 @@ TUPLE: directory-iterator path bfs queue ; : ( path bfs? -- iterator ) directory-iterator boa - dup path>> over push-directory ; + dup path>> over push-directory-entries ; -: next-file ( iter -- file/f ) +: next-directory-entry ( iter -- directory-entry/f ) dup queue>> deque-empty? [ drop f ] [ - dup queue>> pop-back dup directory? - [ over push-directory next-file ] - [ nip name>> ] if - ] if ; + dup queue>> pop-back + dup directory? + [ name>> over push-directory-entries next-directory-entry ] + [ nip ] if + ] if ; recursive -:: iterate-directory ( iter quot: ( obj -- ? ) -- obj ) - iter next-file [ - quot call [ iter quot iterate-directory ] unless* +:: 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' ) + [ ] dip [ f ] compose ; + PRIVATE> -: each-file ( path bfs? quot: ( obj -- ) -- ) - [ ] dip - [ f ] compose iterate-directory drop ; inline +: each-file ( path bfs? quot -- ) + setup-traversal [ name>> ] prepose + iterate-directory-entries drop ; inline -: recursive-directory ( path bfs? -- paths ) +: each-directory-entry ( path bfs? quot -- ) + setup-traversal iterate-directory-entries drop ; + +: recursive-directory-files ( path bfs? -- paths ) [ ] accumulator [ each-file ] dip ; -: find-file ( path bfs? quot: ( obj -- ? ) -- path/f ) +: recursive-directory-entries ( path bfs? -- paths ) + [ ] accumulator [ each-directory-entry ] dip ; + +: find-file ( path bfs? quot -- path/f ) '[ _ _ _ [ ] dip [ keep and ] curry iterate-directory - ] [ drop f ] recover ; inline + ] [ drop f ] recover ; -: find-all-files ( path quot: ( obj -- ? ) -- paths/f ) - f swap +: find-all-files ( path quot -- paths/f ) '[ - _ _ _ [ ] dip + _ _ [ f ] dip pusher [ [ f ] compose iterate-directory drop ] dip - ] [ drop f ] recover ; inline + ] [ drop f ] recover ; -ERROR: file-not-found ; +ERROR: file-not-found path bfs? quot ; -: find-in-directories ( directories bfs? quot: ( obj -- ? ) -- path'/f ) +: 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 [ file-not-found ] unless* ] attempt-all + _ [ _ _ find-file-throws ] attempt-all ] [ drop f - ] recover ; inline + ] recover ; -: find-all-in-directories ( directories bfs? quot: ( obj -- ? ) -- paths/f ) - '[ _ _ find-all-files ] map concat ; inline +: find-all-in-directories ( directories quot -- paths/f ) + '[ _ find-all-files ] map concat ; -: with-qualified-directory-files ( path quot -- ) - '[ "" qualified-directory-files @ ] with-directory ; inline - -: with-qualified-directory-entries ( path quot -- ) - '[ "" qualified-directory-entries @ ] with-directory ; inline +: 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 From c3c51e2c60d6409b95e237c9f1dd559b1fbdff6c Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 24 Apr 2009 15:22:12 -0500 Subject: [PATCH 4/5] more tests for io.directories.search, fix docs, refactoring --- .../io/directories/search/search-docs.factor | 12 ++++++++-- .../io/directories/search/search-tests.factor | 23 ++++++++++++++++--- basis/io/directories/search/search.factor | 13 ++++------- 3 files changed, 35 insertions(+), 13 deletions(-) diff --git a/basis/io/directories/search/search-docs.factor b/basis/io/directories/search/search-docs.factor index fb172b78e0..a6c82a1bff 100644 --- a/basis/io/directories/search/search-docs.factor +++ b/basis/io/directories/search/search-docs.factor @@ -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 } @@ -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 } diff --git a/basis/io/directories/search/search-tests.factor b/basis/io/directories/search/search-tests.factor index 5281ca9c2b..db4b58c4fd 100644 --- a/basis/io/directories/search/search-tests.factor +++ b/basis/io/directories/search/search-tests.factor @@ -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 diff --git a/basis/io/directories/search/search.factor b/basis/io/directories/search/search.factor index 440c3a0326..dc97d4fe45 100755 --- a/basis/io/directories/search/search.factor +++ b/basis/io/directories/search/search.factor @@ -43,7 +43,8 @@ TUPLE: directory-iterator path bfs queue ; :: iterate-directory-entries ( iter quot -- directory-entry/f ) iter next-directory-entry [ - quot call( obj -- obj ) [ iter quot iterate-directory-entries ] unless* + quot call( obj -- obj ) + [ iter quot iterate-directory-entries ] unless* ] [ f ] if* ; inline recursive @@ -57,8 +58,7 @@ TUPLE: directory-iterator path bfs queue ; PRIVATE> : each-file ( path bfs? quot -- ) - setup-traversal [ name>> ] prepose - iterate-directory-entries drop ; inline + setup-traversal iterate-directory drop ; : each-directory-entry ( path bfs? quot -- ) setup-traversal iterate-directory-entries drop ; @@ -87,11 +87,8 @@ ERROR: file-not-found path bfs? quot ; 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-file-throws ] attempt-all ] + [ drop f ] recover ; : find-all-in-directories ( directories quot -- paths/f ) '[ _ find-all-files ] map concat ; From 0220609928a6561195225a89761c19458645386b Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 24 Apr 2009 16:24:31 -0500 Subject: [PATCH 5/5] handle errors when traversing directories --- basis/io/directories/search/search.factor | 14 +++++--------- 1 file changed, 5 insertions(+), 9 deletions(-) diff --git a/basis/io/directories/search/search.factor b/basis/io/directories/search/search.factor index dc97d4fe45..2202f7aa08 100755 --- a/basis/io/directories/search/search.factor +++ b/basis/io/directories/search/search.factor @@ -24,7 +24,7 @@ IN: io.directories.search TUPLE: directory-iterator path bfs queue ; : push-directory-entries ( path iter -- ) - [ qualified-directory-entries ] dip '[ + [ [ qualified-directory-entries ] [ 2drop f ] recover ] dip '[ _ [ queue>> ] [ bfs>> ] bi [ push-front ] [ push-back ] if ] each ; @@ -70,16 +70,12 @@ PRIVATE> [ ] accumulator [ each-directory-entry ] dip ; : find-file ( path bfs? quot -- path/f ) - '[ - _ _ _ [ ] dip - [ keep and ] curry iterate-directory - ] [ drop f ] recover ; + [ ] dip + [ keep and ] curry iterate-directory ; : find-all-files ( path quot -- paths/f ) - '[ - _ _ [ f ] dip - pusher [ [ f ] compose iterate-directory drop ] dip - ] [ drop f ] recover ; + [ f ] dip pusher + [ [ f ] compose iterate-directory drop ] dip ; ERROR: file-not-found path bfs? quot ;