~ chicken-core (chicken-5) 2943b7a51f9dfd90085b7858b9d0ec22a05e7ca7
commit 2943b7a51f9dfd90085b7858b9d0ec22a05e7ca7
Author: Evan Hanson <evhan@foldling.org>
AuthorDate: Sat Feb 17 17:08:52 2018 +1300
Commit: Peter Bex <peter@more-magic.net>
CommitDate: Sat Feb 24 15:00:45 2018 +0100
Move `file-exists?' and `directory-exists?' from toplevel to chicken.file
This requires using the low-level variant of `file-exists?' from
library.scm in a few places, and adding a local version to eval.scm to
avoid introducing a dependency on the "file" unit.
Signed-off-by: Peter Bex <peter@more-magic.net>
diff --git a/build-version.scm b/build-version.scm
index 218983d8..bac9e17d 100644
--- a/build-version.scm
+++ b/build-version.scm
@@ -33,7 +33,7 @@
(er-macro-transformer
(lambda (x r c)
(let ((fn (cadr x)))
- (and (file-exists? fn)
+ (and (##sys#file-exists? fn #t #f #f)
(call-with-input-file (cadr x)
(lambda (p)
(let ((ver ((##sys#slot (##sys#slot p 2) 8) p 256))) ; read-line
diff --git a/chicken.import.scm b/chicken.import.scm
index 67116e23..7976d168 100644
--- a/chicken.import.scm
+++ b/chicken.import.scm
@@ -41,7 +41,6 @@
(cplxnum? . chicken.base#cplxnum?)
(current-error-port . chicken.base#current-error-port)
(current-exception-handler . chicken.condition#current-exception-handler)
- directory-exists?
(dynamic-load-libraries . chicken.load#dynamic-load-libraries)
(enable-warnings . chicken.base#enable-warnings)
(equal=? . chicken.base#equal=?)
@@ -56,7 +55,6 @@
(expand . chicken.syntax#expand)
(feature? . chicken.platform#feature?)
(features . chicken.platform#features)
- file-exists?
(finite? . chicken.base#finite?)
(fixnum-bits . chicken.fixnum#fixnum-bits)
(fixnum-precision . chicken.fixnum#fixnum-precision)
diff --git a/eval.scm b/eval.scm
index 461740ef..8df126ef 100644
--- a/eval.scm
+++ b/eval.scm
@@ -886,7 +886,7 @@
provide provided? require)
(import scheme
- chicken ; file-exists? and output string stuff
+ chicken ; string ports
chicken.base
chicken.eval
chicken.fixnum
@@ -1243,6 +1243,9 @@
(set! cache (cons path lst))
lst))))))
+(define (file-exists? name) ; defined here to avoid file unit dependency
+ (and (##sys#file-exists? name #t #f #f) name))
+
(define (find-file name search-path)
(let loop ((p (##sys#split-path search-path)))
(cond ((null? p) #f)
@@ -1250,8 +1253,7 @@
(else (loop (cdr p))))))
(define find-dynamic-extension
- (let ((file-exists? file-exists?)
- (string-append string-append))
+ (let ((string-append string-append))
(lambda (path inc?)
(let ((p (##sys#canonicalize-extension-path path #f))
(rp (repository-path)))
@@ -1348,15 +1350,12 @@
(define ##sys#resolve-include-filename
(let ((string-append string-append) )
- (define (exists? fname)
- (##sys#file-exists? fname #t #f #f))
(lambda (fname exts repo source)
(define (test-extensions fname lst)
(if (null? lst)
- (and (exists? fname) fname)
+ (and (file-exists? fname) fname)
(let ((fn (##sys#string-append fname (car lst))))
- (if (exists? fn)
- fn
+ (or (file-exists? fn)
(test-extensions fname (cdr lst))))))
(define (test fname)
(test-extensions
diff --git a/file.scm b/file.scm
index 4792bbdc..3a57d8b2 100644
--- a/file.scm
+++ b/file.scm
@@ -82,8 +82,6 @@ EOF
socket?
symbolic-link?)
-(import (only chicken file-exists? directory-exists?))
-
(import scheme
chicken.base
chicken.condition
@@ -109,6 +107,13 @@ EOF
(let ([rn (##sys#update-errno)])
(apply ##sys#signal-hook type loc (string-append msg " - " (strerror rn)) args) ) ) ) )
+(define (file-exists? name)
+ (##sys#check-string name 'file-exists?)
+ (and (##sys#file-exists? name #f #f 'file-exists?) name))
+
+(define (directory-exists? name)
+ (##sys#check-string name 'directory-exists?)
+ (and (##sys#file-exists? name #f #t 'directory-exists?) name))
(define (delete-file filename)
(##sys#check-string filename 'delete-file)
diff --git a/library.scm b/library.scm
index dd269c23..7a7e5429 100644
--- a/library.scm
+++ b/library.scm
@@ -3453,14 +3453,6 @@ EOF
#:file-error loc "system error while trying to access file"
name))))
-(define (file-exists? name)
- (##sys#check-string name 'file-exists?)
- (and (##sys#file-exists? name #f #f 'file-exists?) name))
-
-(define (directory-exists? name)
- (##sys#check-string name 'directory-exists?)
- (and (##sys#file-exists? name #f #t 'directory-exists?) name))
-
(define (##sys#flush-output port)
((##sys#slot (##sys#slot port 2) 5) port) ; flush-output
(##core#undefined) )
diff --git a/tests/csc-tests.scm b/tests/csc-tests.scm
index b7816f6c..1fa281dc 100644
--- a/tests/csc-tests.scm
+++ b/tests/csc-tests.scm
@@ -1,6 +1,7 @@
;;; csc interface tests
-(import (chicken pathname)
+(import (chicken file)
+ (chicken pathname)
(chicken process)
(chicken process-context)
(chicken string))
diff --git a/tests/file-access-tests.scm b/tests/file-access-tests.scm
index 41e98343..761bb5c9 100644
--- a/tests/file-access-tests.scm
+++ b/tests/file-access-tests.scm
@@ -4,7 +4,8 @@
;; These may seem silly, but some of them actually fail on MinGW without help.
;;
-(import (chicken process-context))
+(import (chicken file)
+ (chicken process-context))
(define / (car (command-line-arguments)))
(define // (string-append / /))
diff --git a/types.db b/types.db
index 5c73ad30..9ee24365 100644
--- a/types.db
+++ b/types.db
@@ -1180,8 +1180,6 @@
(##sys#signal-hook (procedure ##sys#signal-hook (* #!rest) noreturn))
(##sys#debug-mode? (procedure ##sys#debug-mode? () boolean)
(() (##core#inline "C_i_debug_modep")))
-(file-exists? (#(procedure #:clean #:enforce) file-exists? (string) (or false string)))
-(directory-exists? (#(procedure #:clean #:enforce) directory-exists? (string) (or false string)))
;; flonum
@@ -1567,13 +1565,14 @@
(chicken.file#delete-directory (#(procedure #:clean #:enforce) chicken.file#delete-directory (string #!optional *) string))
(chicken.file#delete-file (#(procedure #:clean #:enforce) chicken.file#delete-file (string) string))
(chicken.file#delete-file* (#(procedure #:clean #:enforce) chicken.file#delete-file* (string) *))
+(chicken.file#directory-exists? (#(procedure #:clean #:enforce) chicken.file#directory-exists? (string) (or false string)))
+(chicken.file#file-exists? (#(procedure #:clean #:enforce) chicken.file#file-exists? (string) (or false string)))
(chicken.file#file-copy (#(procedure #:clean #:enforce) chicken.file#file-copy (string string #!optional * fixnum) fixnum))
(chicken.file#file-move (#(procedure #:clean #:enforce) chicken.file#file-move (string string #!optional * fixnum) fixnum))
(chicken.file#find-files (#(procedure #:enforce) chicken.file#find-files (string #!rest) list))
(chicken.file#glob (#(procedure #:clean #:enforce) chicken.file#glob (#!rest string) list))
(chicken.file#rename-file (#(procedure #:clean #:enforce) chicken.file#rename-file (string string) string))
-
;; pathname
(chicken.pathname#absolute-pathname? (#(procedure #:clean #:enforce) chicken.pathname#absolute-pathname? (string) boolean))
Trap