io.directories: cleanup and some performance improvements with move/copy.

basis/io/directories/directories.factor

@@ -1,9 +1,9 @@
 ! Copyright (C) 2004, 2008 Slava Pestov, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays combinators destructors io io.backend
+USING: accessors arrays combinators combinators.short-circuit
-io.encodings.binary io.files io.files.types io.pathnames
+destructors fry io io.backend io.encodings.binary io.files
-kernel namespaces sequences system vocabs.loader fry
+io.files.types io.pathnames kernel namespaces sequences
-vocabs ;
+system vocabs vocabs.loader ;
 IN: io.directories
 
 : set-current-directory ( path -- )
@@ -16,16 +16,15 @@ IN: io.directories
 HOOK: make-directory io-backend ( path -- )
 
 : make-directories ( path -- )
-    normalize-path trim-tail-separators {
+    normalize-path trim-tail-separators dup {
-        { [ dup "." = ] [ ] }
+        [ "." = ]
-        { [ dup root-directory? ] [ ] }
+        [ root-directory? ]
-        { [ dup empty? ] [ ] }
+        [ empty? ]
-        { [ dup exists? ] [ ] }
+        [ exists? ]
-        [
+    } 1|| [
-            dup parent-directory make-directories
+        dup parent-directory make-directories
-            dup make-directory
+        dup make-directory
-        ]
+    ] unless drop ;
-    } cond drop ;
 
 ! Listing directories
 TUPLE: directory-entry name type ;
@@ -40,7 +39,7 @@ HOOK: (directory-entries) os ( path -- seq )
     [ name>> { "." ".." } member? not ] filter ;
 
 : directory-files ( path -- seq )
-    directory-entries [ name>> ] map ;
+    directory-entries [ name>> ] map! ;
 
 : with-directory-entries ( path quot -- )
     '[ "" directory-entries @ ] with-directory ; inline
@@ -66,7 +65,7 @@ HOOK: move-file io-backend ( from to -- )
     to-directory move-file ;
 
 : move-files-into ( files to -- )
-    '[ _ move-file-into ] each ;
+    to-directory '[ _ move-file ] each ;
 
 ! Copying files
 HOOK: copy-file io-backend ( from to -- )
@@ -83,7 +82,7 @@ M: object copy-file
     to-directory copy-file ;
 
 : copy-files-into ( files to -- )
-    '[ _ copy-file-into ] each ;
+    to-directory '[ _ copy-file ] each ;
 
 {
     { [ os unix? ] [ "io.directories.unix" require ] }

basis/io/directories/search/search.factor

@@ -8,11 +8,11 @@ IN: io.directories.search
 
 : qualified-directory-entries ( path -- seq )
     absolute-path
-    dup directory-entries [ [ append-path ] change-name ] with map ;
+    dup directory-entries [ [ append-path ] change-name ] with map! ;
 
 : qualified-directory-files ( path -- seq )
     absolute-path
-    dup directory-files [ append-path ] with map ;
+    dup directory-files [ append-path ] with map! ;
 
 : with-qualified-directory-files ( path quot -- )
     '[ "" qualified-directory-files @ ] with-directory ; inline
@@ -110,7 +110,7 @@ ERROR: file-not-found path bfs? quot ;
 : find-by-extensions ( path extensions -- seq )
     [ >lower ] map
     '[ >lower _ [ tail? ] with any? ] find-all-files ;
-    
+
 : find-by-extension ( path extension -- seq )
     1array find-by-extensions ;