summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGary Houston <ghouston@arglist.com>1996-10-06 06:33:11 +0000
committerGary Houston <ghouston@arglist.com>1996-10-06 06:33:11 +0000
commit6fa8995c39bb54570005f03d1d71e5f4364a627d (patch)
tree34f39592cc923c422fb9e977ff926836444a5b7d
parent52f4f4d6aa1250858e9fe7eaee77f7d5ab64f64a (diff)
downloadguile-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/ChangeLog13
-rw-r--r--ice-9/boot-9.scm109
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 "." ()))