diff options
author | Gary Houston <ghouston@arglist.com> | 1996-10-06 06:33:11 +0000 |
---|---|---|
committer | Gary Houston <ghouston@arglist.com> | 1996-10-06 06:33:11 +0000 |
commit | 6fa8995c39bb54570005f03d1d71e5f4364a627d (patch) | |
tree | 34f39592cc923c422fb9e977ff926836444a5b7d | |
parent | 52f4f4d6aa1250858e9fe7eaee77f7d5ab64f64a (diff) | |
download | guile-6fa8995c39bb54570005f03d1d71e5f4364a627d.tar.gz |
* boot-9.scm (load): rewritten again.
Append "." to the default %load-path.
(feature?): new function: checks for a symbol in the features list.
(module-local-variable): remove apparently useless (caddr (list m v
...))
(%load-announce): minor formatting change.
(file-exists?): use access? if posix is featured.
(file-is-directory?): use stat if i/o-extensions is featured.
(try-module-autoload module-name): use file-exists? before
file-is-directory?
-rw-r--r-- | ice-9/ChangeLog | 13 | ||||
-rw-r--r-- | ice-9/boot-9.scm | 109 |
2 files changed, 81 insertions, 41 deletions
diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index edbcb24c2..47c583b67 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,3 +1,16 @@ +Sun Oct 6 03:54:59 1996 Gary Houston <ghouston@actrix.gen.nz> + + * boot-9.scm (load): rewritten again. + Append "." to the default %load-path. + (feature?): new function: checks for a symbol in the features list. + (module-local-variable): remove apparently useless (caddr (list m v + ...)) + (%load-announce): minor formatting change. + (file-exists?): use access? if posix is featured. + (file-is-directory?): use stat if i/o-extensions is featured. + (try-module-autoload module-name): use file-exists? before + file-is-directory? + Sat Oct 5 18:54:03 1996 Mikael Djurfeldt <mdj@kenneth> * boot-9.scm: Added conditional loading of threads.scm. diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm index d3299a69a..18637c4e7 100644 --- a/ice-9/boot-9.scm +++ b/ice-9/boot-9.scm @@ -555,20 +555,34 @@ ;;; !!!! these should be implemented using Tcl commands, not fports. ;;; -(define (file-exists? str) - ;; we don't have false-if-exception (or defmacro) yet. - (let ((port (catch 'system-error (lambda () (open-file str OPEN_READ)) - (lambda args #f)))) - (if port (begin (close-port port) #t) - #f))) - -(define (file-is-directory? str) - (let ((port (catch 'system-error - (lambda () (open-file (string-append str "/.") - OPEN_READ)) - (lambda args #f)))) - (if port (begin (close-port port) #t) - #f))) +(define (feature? feature) + (and (memq feature *features*) #t)) + +(define file-exists? + (if (feature? 'posix) + (lambda (str) + (access? str F_OK)) + (lambda (str) + (let ((port (catch 'system-error (lambda () (open-file str OPEN_READ)) + (lambda args #f)))) + (if port (begin (close-port port) #t) + #f))))) + +(define file-is-directory? + (if (feature? 'i/o-extensions) + (lambda (str) + (> (logand S_IFDIR + (vector-ref (stat str) 2)) + 0)) + (lambda (str) + (display str) + (newline) + (let ((port (catch 'system-error + (lambda () (open-file (string-append str "/.") + OPEN_READ)) + (lambda args #f)))) + (if port (begin (close-port port) #t) + #f))))) (define (has-suffix? str suffix) (let ((sufl (string-length suffix)) @@ -576,8 +590,6 @@ (and (> sl sufl) (string=? (substring str (- sl sufl) sl) suffix)))) - - ;;; {Error Handling} ;;; @@ -657,7 +669,7 @@ (let ((sig-pair (assoc n signal-messages))) (scm-error 'error-signal #f (cdr (or sig-pair - (cons n "Unknow signal: %s"))) + (cons n "Unknown signal: %s"))) (if sig-pair #f (list n)) @@ -821,7 +833,6 @@ (display ";;; ") (display "loading ") (display file) - (display "...") (newline) (force-output))))) @@ -832,7 +843,6 @@ (display ";;; ") (display "...loaded ") (display file) - (display ".") (newline) (force-output))))) @@ -857,22 +867,36 @@ ; #t) (define (load name) - (current-module) - (%load-announce name) - (cond ((and (file-exists? name) - (not (file-is-directory? name))) - (primitive-load name #t read-sharp) - (%load-announce-win name)) - (else - (let ((name.scm (string-append name (scheme-file-suffix)))) - (cond ((and (not (has-suffix? name (scheme-file-suffix))) - (file-exists? name.scm) - (not (file-is-directory? name.scm))) - (primitive-load name.scm #t read-sharp) - (%load-announce-win name.scm)) - (else - (%try-load-path name #t read-sharp) - (%load-announce-win name))))))) + (let* ((full-path-supplied (eq? (string-ref name 0) #\/)) + (full-path + (cond (full-path-supplied + (or (and (file-exists? name) + (not (file-is-directory? name)) + name) + (and (not (has-suffix? name (scheme-file-suffix))) + (let ((name.scm + (string-append name + (scheme-file-suffix)))) + (and (file-exists? name.scm) + (not (file-is-directory? name.scm)) + name.scm))))) + (else + ;; we find name before name.scm even if the latter + ;; occurs earlier in %load-path (?). + (or (%search-load-path name) + (and (not (has-suffix? name (scheme-file-suffix))) + (%search-load-path (string-append + name + (scheme-file-suffix))))))))) + (cond (full-path + (%load-announce full-path) + (primitive-load full-path #t read-sharp)) + (else + (if full-path-supplied + (scm-error 'misc-error "load" "Unable to find file %S" + (list name) #f) + (scm-error 'misc-error "load" "Unable to find file %S in %S" + (list name %load-path) #f)))))) ;;; {Transcendental Functions} @@ -1468,12 +1492,13 @@ ;;; If the symbol is not found at all, return #f. ;;; (define (module-local-variable m v) - (caddr - (list m v +; (caddr +; (list m v (let ((b (module-obarray-ref (module-obarray m) v))) (or (and (variable? b) b) (and (module-binder m) - ((module-binder m) m v #f))))))) + ((module-binder m) m v #f))))) +;)) ;; module-variable module symbol ;; @@ -1911,7 +1936,7 @@ (define autoloads-in-progress '()) (define (try-module-autoload module-name) - + (define (sfx name) (string-append name (scheme-file-suffix))) (let* ((reverse-name (reverse module-name)) (name (car reverse-name)) @@ -1935,8 +1960,8 @@ (and (or-map (lambda (f) (let ((full (in-vicinity d f))) full - (and (not (file-is-directory? full)) - (file-exists? full) + (and (file-exists? full) + (not (file-is-directory? full)) (begin (save-module-excursion (lambda () @@ -3573,3 +3598,5 @@ (define-module (guile) :use-module (ice-9 threads))) (define-module (guile)) + +(append! %load-path (cons "." ())) |