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

db4
John Benediktsson 2012-07-16 22:03:49 -07:00
parent 2f325e4fee
commit b519b52fa3
2 changed files with 19 additions and 20 deletions

View File

@ -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
io.encodings.binary io.files io.files.types io.pathnames
kernel namespaces sequences system vocabs.loader fry
vocabs ;
USING: accessors arrays combinators combinators.short-circuit
destructors fry io io.backend io.encodings.binary io.files
io.files.types io.pathnames kernel namespaces sequences
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 {
{ [ dup "." = ] [ ] }
{ [ dup root-directory? ] [ ] }
{ [ dup empty? ] [ ] }
{ [ dup exists? ] [ ] }
[
dup parent-directory make-directories
dup make-directory
]
} cond drop ;
normalize-path trim-tail-separators dup {
[ "." = ]
[ root-directory? ]
[ empty? ]
[ exists? ]
} 1|| [
dup parent-directory make-directories
dup make-directory
] unless 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 ] }

View File

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