Merge branch 'master' into inline_caching

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:

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 }
@@ -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 }

basis/io/directories/search/search-tests.factor

@@ -1,12 +1,14 @@
-USING: io.directories.search io.files io.files.unique
+USING: combinators.smart io.directories
-io.pathnames kernel namespaces sequences sorting tools.test ;
+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

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,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 [
+    0 swap t [ link-size/0 + ] each-file ;
-        [ link-info size-on-disk>> + ] [ 2drop ] recover
-    ] each-file ;
 
 : path>usage ( directory-entry -- name size )
-    [ name>> dup ] [ directory? ] bi [
+    [ name>> dup ] [ directory? ] bi
-        directory-size
+    [ directory-size ] [ link-size/0 ] if ;
-    ] [
-        [ link-info size-on-disk>> ] [ 2drop 0 ] recover
-    ] 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