summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGary Houston <ghouston@arglist.com>1996-09-28 19:38:45 +0000
committerGary Houston <ghouston@arglist.com>1996-09-28 19:38:45 +0000
commit5552355a7bf0e34dd9eee54c7384114295b96d7a (patch)
treeb49787439a768117c6c00aa015cd29089071322e
parent1d1cf2bf140e36ed185e4bce4d08ec20c420a3de (diff)
downloadguile-5552355a7bf0e34dd9eee54c7384114295b96d7a.tar.gz
* boot-9.scm (error): replace another throw with scm-error. Throw
to 'misc-error instead of 'error (no need to distinguish these.) Don't set up 'error as a key. Set up regex-error as a key, if regex is available. (signal-handler): use scm-error, not throw. (%try-load, try-load-with-path, %load, load-with-path, basic-try-load-with-path, basic-load-with-path, try-load-module-with-path,load-module-with-path): deleted, since they seem redundant. (try-load): define using %try-load, not try-load-with-path. (load): rewritten. load tries to open the file directly and with a .scm extension before searching the library directories (should "." be added to %load-path? then load could still open directly files starting with "/"). (try-module-autoload): use load, not load-with-path. (%load-indent): deleted, -2 was causing errors. (%read-sharp): use port-line, not line-number.
-rw-r--r--ice-9/ChangeLog22
-rw-r--r--ice-9/boot-9.scm153
2 files changed, 96 insertions, 79 deletions
diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog
index 7e39f6794..38b2a2812 100644
--- a/ice-9/ChangeLog
+++ b/ice-9/ChangeLog
@@ -1,3 +1,25 @@
+Sat Sep 28 00:15:37 1996 Gary Houston <ghouston@actrix.gen.nz>
+
+ * boot-9.scm (error): replace another throw with scm-error. Throw
+ to 'misc-error instead of 'error (no need to distinguish these.)
+ Don't set up 'error as a key.
+ Set up regex-error as a key, if regex is available.
+ (signal-handler): use scm-error, not throw.
+
+* (%try-load, try-load-with-path, %load, load-with-path,
+ basic-try-load-with-path, basic-load-with-path,
+ try-load-module-with-path,load-module-with-path): deleted, since
+ they seem redundant.
+ (try-load): define using %try-load, not try-load-with-path.
+* (load): rewritten. load tries to open the file directly and
+ with a .scm extension before searching the library directories
+ (should "." be added to %load-path? then load could still open
+ directly files starting with "/").
+ (try-module-autoload): use load, not load-with-path.
+ (%load-indent): deleted, -2 was causing errors.
+
+ (%read-sharp): use port-line, not line-number.
+
Tue Sep 24 06:53:04 1996 Gary Houston <ghouston@actrix.gen.nz>
* boot-9.scm (%try-load): define using primitive-load. Previously
diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm
index 072326fd8..6b40f9292 100644
--- a/ice-9/boot-9.scm
+++ b/ice-9/boot-9.scm
@@ -584,13 +584,13 @@
(define (error . args)
(if (null? args)
- (throw 'error #f "?" #f #f)
+ (scm-error 'misc-error #f "?" #f #f)
(let loop ((msg "%s")
(rest (cdr args)))
(if (not (null? rest))
(loop (string-append msg " %S")
(cdr rest))
- (scm-error 'error #f msg args #f)))))
+ (scm-error 'misc-error #f msg args #f)))))
(define (scm-error key subr message args rest)
(throw key subr message args rest))
@@ -655,13 +655,13 @@
((= n 19) (unmask-signals) (alarm-thunk))
(else (unmask-signals)
(let ((sig-pair (assoc n signal-messages)))
- (throw 'error-signal #f
- (cdr (or sig-pair
- (cons n "Unknow signal: %s")))
- (if sig-pair
- #f
- (list n))
- (list n)))))))
+ (scm-error 'error-signal #f
+ (cdr (or sig-pair
+ (cons n "Unknow signal: %s")))
+ (if sig-pair
+ #f
+ (list n))
+ (list n)))))))
(define display-error-message
(lambda (message args port)
@@ -718,15 +718,19 @@
(throw 'abort key)))
;; associate error symbols with %%handle-system-error.
-(let loop ((keys '(error error-signal system-error numerical-overflow
- out-of-range wrong-type-arg wrong-number-of-args
- memory-allocation-error stack-overflow
- misc-error)))
- (cond ((not (null? keys))
- (set-symbol-property! (car keys)
- 'throw-handler-default
- %%handle-system-error)
- (loop (cdr keys)))))
+(let ((keys '(error-signal system-error numerical-overflow
+ out-of-range wrong-type-arg
+ wrong-number-of-args
+ memory-allocation-error stack-overflow
+ misc-error)))
+ (if (memq 'regex *features*)
+ (set! keys (cons 'regex-error keys)))
+ (let loop ((keys keys))
+ (cond ((not (null? keys))
+ (set-symbol-property! (car keys)
+ 'throw-handler-default
+ %%handle-system-error)
+ (loop (cdr keys))))))
(define (getgrnam name) (getgr name))
@@ -793,44 +797,28 @@
;;; {try-load}
;;;
-(define (%try-load file-name case-insensitive sharp)
- (catch #t (lambda ()
- (primitive-load file-name case-insensitive sharp)
- #t)
- (lambda args #f)))
-
-(define (try-load-with-path file-name path)
- (or-map (lambda (d)
- (let ((f (in-vicinity d file-name)))
- (and (not (file-is-directory? f))
- (%try-load f #t read-sharp))))
- path))
+;(define (try-load-with-path file-name path)
+; (or-map (lambda (d)
+; (let ((f (in-vicinity d file-name)))
+; (and (not (file-is-directory? f))
+; (primitive-load f #t read-sharp))))
+; path))
(define (try-load name)
- (if (eval '(defined? %load-path))
- (try-load-with-path name (eval '%load-path))
- (%try-load name #t read-sharp)))
+ (%try-load-path name #t read-sharp))
+
;;; {Load}
;;;
(define %load-verbosely #t)
(define (assert-load-verbosity v) (set! %load-verbosely v))
-(define %load-indent -2)
-
-(define (%load f)
- (current-module)
- (or (and (not (file-is-directory? f))
- (%try-load f #t read-sharp))
- (and (not (has-suffix? f (scheme-file-suffix)))
- (%try-load (string-append f (scheme-file-suffix)) #t read-sharp))))
(define (%load-announce file)
(if %load-verbosely
(with-output-to-port (current-error-port)
(lambda ()
(display ";;; ")
- (display (make-string %load-indent #\ ))
(display "loading ")
(display file)
(display "...")
@@ -842,39 +830,49 @@
(with-output-to-port (current-error-port)
(lambda ()
(display ";;; ")
- (display (make-string %load-indent #\ ))
(display "...loaded ")
(display file)
(display ".")
(newline)
(force-output)))))
-(define (load-with-path name path)
- (define (do-load)
- (%load-announce name)
- (if (not (or-map (lambda (d)
- (if (%load (in-vicinity d name))
- (begin
- (%load-announce-win (in-vicinity d name))
- #t)
- #f))
- path))
- (scm-error 'misc-error #f "Could not load %S from %S"
- (list name path) #f)))
-
- (let ((indent %load-indent))
- (dynamic-wind
- (lambda () (set! %load-indent (modulo (+ indent 2) 16)))
- do-load
- (lambda () (set! %load-indent indent))))
- #t)
-
+;(define (load-with-path name path)
+; (define (do-load)
+; (%load-announce name)
+; (if (not (or-map (lambda (d)
+; (if (%load (in-vicinity d name))
+; (begin
+; (%load-announce-win (in-vicinity d name))
+; #t)
+; #f))
+; path))
+; (scm-error 'misc-error #f "Could not load %S from %S"
+; (list name path) #f)))
+
+; (let ((indent %load-indent))
+; (dynamic-wind
+; (lambda () (set! %load-indent (modulo (+ indent 2) 16)))
+; do-load
+; (lambda () (set! %load-indent indent))))
+; #t)
(define (load name)
- (if (eval '(defined? %load-path))
- (load-with-path name (eval '%load-path))
- (load-with-path 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)))))))
;;; {Transcendental Functions}
@@ -1037,7 +1035,7 @@
((#\c) (read:uniform-vector 0+i port))
((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
(read:array c port))
- ((#\!) (if (= 1 (line-number))
+ ((#\!) (if (= 1 (port-line port)) ; (line-number))
(let skip () (if (eq? #\newline (peek-char port))
(read port #t read-sharp)
(begin (read-char port) (skip))))
@@ -1679,20 +1677,17 @@
(set-current-module outer-module)
(set! outer-module #f)))))
-(define basic-try-load-with-path try-load-with-path)
(define basic-try-load try-load)
-(define basic-load-with-path load-with-path)
(define basic-load load)
-
-(define (try-load-module-with-path . args)
- (save-module-excursion (lambda () (apply basic-try-load-with-path args))))
+;;(define (try-load-module-with-path . args)
+;; (save-module-excursion (lambda () (apply basic-try-load-with-path args))))
(define (try-load-module . args)
(save-module-excursion (lambda () (apply basic-try-load args))))
-(define (load-module-with-path . args)
- (save-module-excursion (lambda () (apply basic-load-with-path args))))
+;;(define (load-module-with-path . args)
+;; (save-module-excursion (lambda () (apply basic-load-with-path args))))
(define (load-module . args)
(save-module-excursion (lambda () (apply basic-load args))))
@@ -1945,8 +1940,8 @@
(begin
(save-module-excursion
(lambda ()
- (list f d)
- (load-with-path f (list d))))
+ (load (string-append
+ d "/" f))))
#t))))
trys)
(begin
@@ -2319,9 +2314,9 @@
-(define try-load-with-path try-load-module-with-path)
+;;(define try-load-with-path try-load-module-with-path)
(define try-load try-load-module)
-(define load-with-path load-module-with-path)
+;;(define load-with-path load-module-with-path)
(define load load-module)