summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2008-09-25 13:46:09 +0200
committerAndy Wingo <wingo@pobox.com>2008-09-25 13:46:09 +0200
commit1e6ebf54dbbd1bd54294fcc876ac1a1ffec26265 (patch)
tree57bbc3c22f5591bff480052976a0aaa38f0cb302
parent5ba9d84978641700562a8e166bf9c0cdf3d51ae3 (diff)
downloadguile-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.scm6
-rw-r--r--ice-9/optargs.scm9
-rw-r--r--module/language/scheme/translate.scm5
-rw-r--r--module/system/base/compile.scm10
-rw-r--r--module/system/repl/repl.scm2
-rw-r--r--module/system/vm/frame.scm4
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))))))