diff options
author | Andy Wingo <wingo@pobox.com> | 2008-09-25 13:46:09 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2008-09-25 13:46:09 +0200 |
commit | 1e6ebf54dbbd1bd54294fcc876ac1a1ffec26265 (patch) | |
tree | 57bbc3c22f5591bff480052976a0aaa38f0cb302 | |
parent | 5ba9d84978641700562a8e166bf9c0cdf3d51ae3 (diff) | |
download | guile-1e6ebf54dbbd1bd54294fcc876ac1a1ffec26265.tar.gz |
a number of small compilation fixes
* ice-9/boot-9.scm: Allow a compiled load of posix, networking, and
deprecated files.
* module/language/scheme/translate.scm (lookup-transformer): Lookup the
sc-macro by value, not by name. Works around the fact that compiled
macros don't have names, which is probably a bug.
* module/system/base/compile.scm (syntax-error)
(call-with-compile-error-catch): Throw and catch a key that's not used
by anyone else. Write error messages to the error port.
* module/system/repl/repl.scm (default-catch-handler): Call display-error
with the correct number of arguments.
* module/system/vm/frame.scm (frame-program-name): Guard against unbound
variables.
* ice-9/optargs.scm (let-keywords-template): Don't unquote in a helper
procedure. A bit irritating. I suppose we should fix the modules +
syncase situation at some point, and then switch to syncase.
-rw-r--r-- | ice-9/boot-9.scm | 6 | ||||
-rw-r--r-- | ice-9/optargs.scm | 9 | ||||
-rw-r--r-- | module/language/scheme/translate.scm | 5 | ||||
-rw-r--r-- | module/system/base/compile.scm | 10 | ||||
-rw-r--r-- | module/system/repl/repl.scm | 2 | ||||
-rw-r--r-- | module/system/vm/frame.scm | 4 |
6 files changed, 20 insertions, 16 deletions
diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm index f13bf79f6..bdf7d409d 100644 --- a/ice-9/boot-9.scm +++ b/ice-9/boot-9.scm @@ -523,10 +523,10 @@ (if (provided? 'posix) - (primitive-load-path "ice-9/posix.scm")) + (primitive-load-path "ice-9/posix")) (if (provided? 'socket) - (primitive-load-path "ice-9/networking.scm")) + (primitive-load-path "ice-9/networking")) ;; For reference, Emacs file-exists-p uses stat in this same way. ;; ENHANCE-ME: Catching an exception from stat is a bit wasteful, do this in @@ -3406,7 +3406,7 @@ module '(ice-9 q) '(make-q q-length))}." (provided? sym))) (begin-deprecated - (primitive-load-path "ice-9/deprecated.scm")) + (primitive-load-path "ice-9/deprecated")) diff --git a/ice-9/optargs.scm b/ice-9/optargs.scm index 99329c750..4f6bc8308 100644 --- a/ice-9/optargs.scm +++ b/ice-9/optargs.scm @@ -149,11 +149,10 @@ => cdr) (else ,(cadr key))))))) - `(let* ((ra->kbl ,rest-arg->keyword-binding-list) - (,kb-list-gensym (ra->kbl ,REST-ARG ',(map - (lambda (x) (symbol->keyword (if (pair? x) (car x) x))) - BINDINGS) - ,ALLOW-OTHER-KEYS?))) + `(let ((,kb-list-gensym (rest-arg->keyword-binding-list + ,REST-ARG ',(map (lambda (x) (symbol->keyword (if (pair? x) (car x) x))) + BINDINGS) + ,ALLOW-OTHER-KEYS?))) ,(let-o-k-template REST-ARG BINDINGS BODY let-type bindfilter))))) diff --git a/module/language/scheme/translate.scm b/module/language/scheme/translate.scm index 49f90585a..7b1e6daab 100644 --- a/module/language/scheme/translate.scm +++ b/module/language/scheme/translate.scm @@ -25,6 +25,7 @@ #:use-module (system il ghil) #:use-module (system il inline) #:use-module (ice-9 receive) + #:use-module ((ice-9 syncase) #:select (sc-macro)) #:use-module ((system base compile) #:select (syntax-error)) #:export (translate)) @@ -63,7 +64,7 @@ (lambda (env loc exp) (retrans (apply (defmacro-transformer val) (cdr exp))))) - ((and (macro? val) (eq? (macro-name val) 'sc-macro)) + ((eq? val sc-macro) ;; syncase! (let* ((the-syncase-module (resolve-module '(ice-9 syncase))) (eec (module-ref the-syncase-module 'expansion-eval-closure)) @@ -92,7 +93,7 @@ ;; FIXME: lexical/module overrides of forbidden primitives ((memq head *forbidden-primitives*) (syntax-error l (format #f "`~a' is forbidden" head) - (cons head tail))) + (cons head tail))) (else (let ((tail (map retrans tail))) diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm index 4d8ff4bd0..f406eb84f 100644 --- a/module/system/base/compile.scm +++ b/module/system/base/compile.scm @@ -38,15 +38,17 @@ ;;; (define (syntax-error loc msg exp) - (throw 'syntax-error loc msg exp)) + (throw 'syntax-error-compile-time loc msg exp)) (define-macro (call-with-compile-error-catch thunk) - `(catch 'syntax-error + `(catch 'syntax-error-compile-time ,thunk (lambda (key loc msg exp) (if (pair? loc) - (format #t "~A:~A: ~A: ~A~%" (car loc) (cdr loc) msg exp) - (format #t "unknown location: ~A: ~A~%" msg exp))))) + (format (current-error-port) + "~A:~A: ~A: ~A~%" (car loc) (cdr loc) msg exp) + (format (current-error-port) + "unknown location: ~A: ~A~%" msg exp))))) (export-syntax call-with-compile-error-catch) diff --git a/module/system/repl/repl.scm b/module/system/repl/repl.scm index 69a47f387..8fd5be2ee 100644 --- a/module/system/repl/repl.scm +++ b/module/system/repl/repl.scm @@ -83,7 +83,7 @@ (newline cep) (run-hook after-backtrace-hook)))) (run-hook before-error-hook) - (apply display-error (fluid-ref the-last-stack) cep subr msg args rest) + (display-error (fluid-ref the-last-stack) cep subr msg args rest) (run-hook after-error-hook) (set! stack-saved? #f) (force-output cep))) diff --git a/module/system/vm/frame.scm b/module/system/vm/frame.scm index 10d2a949b..70b82f872 100644 --- a/module/system/vm/frame.scm +++ b/module/system/vm/frame.scm @@ -127,7 +127,9 @@ (object-property prog 'name) (and (heap-frame? link) (frame-address link) (frame-object-name link (1- (frame-address link)) prog)) - (hash-fold (lambda (s v d) (if (eq? prog (variable-ref v)) s d)) + (hash-fold (lambda (s v d) (if (and (variable-bound? v) + (eq? prog (variable-ref v))) + s d)) prog (module-obarray (current-module)))))) |