summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2009-02-09 11:42:27 +0100
committerAndy Wingo <wingo@pobox.com>2009-02-09 11:42:27 +0100
commit989228796043917ad4d445049dc10948ae75853d (patch)
tree08252de4f03a6b4a8dac49f893b0c65bb104562a
parent2f9769b60cec324e6d1cb13d8f5690342ac20152 (diff)
downloadguile-989228796043917ad4d445049dc10948ae75853d.tar.gz
minor cleanups
* libguile/stacks.c (scm_make_stack): Instead of aborting when we misread the number of stack frames, just print a warning. I'd like to figure out what these cases are, exactly. * module/language/scheme/compile-ghil.scm (lambda): Reindent the lambda transformer. * module/system/base/compile.scm (call-with-compile-error-catch): Write the expression instead of displaying it. (call-with-output-file/atomic): Don't actually redirect output to this port, as it's not necessary -- the language-printer should respect the port that we pass.
-rw-r--r--libguile/stacks.c8
-rw-r--r--module/language/scheme/compile-ghil.scm10
-rw-r--r--module/system/base/compile.scm5
3 files changed, 13 insertions, 10 deletions
diff --git a/libguile/stacks.c b/libguile/stacks.c
index d020d36b0..b9595e364 100644
--- a/libguile/stacks.c
+++ b/libguile/stacks.c
@@ -552,8 +552,12 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
SCM_STACK (stack) -> length = n;
/* Translate the current chain of stack frames into debugging information. */
- if (read_frames (dframe, offset, vmframe, n, iframe) != n)
- abort (); /* we counted wrong, this really shouldn't happen */
+ n = read_frames (dframe, offset, vmframe, n, iframe);
+ if (n != SCM_STACK (stack)->length)
+ {
+ scm_puts ("warning: stack count incorrect!\n", scm_current_error_port ());
+ SCM_STACK (stack)->length = n;
+ }
/* Narrow the stack according to the arguments given to scm_make_stack. */
SCM_VALIDATE_REST_ARGUMENT (args);
diff --git a/module/language/scheme/compile-ghil.scm b/module/language/scheme/compile-ghil.scm
index 1213703a8..9376be48c 100644
--- a/module/language/scheme/compile-ghil.scm
+++ b/module/language/scheme/compile-ghil.scm
@@ -317,11 +317,11 @@
;; (lambda FORMALS BODY...)
((,formals . ,body)
(receive (syms rest) (parse-formals formals)
- (call-with-ghil-environment e syms
- (lambda (env vars)
- (receive (meta body) (parse-lambda-meta body)
- (make-ghil-lambda env l vars rest meta
- (trans-body env l body))))))))
+ (call-with-ghil-environment e syms
+ (lambda (env vars)
+ (receive (meta body) (parse-lambda-meta body)
+ (make-ghil-lambda env l vars rest meta
+ (trans-body env l body))))))))
(define-scheme-translator delay
;; FIXME not hygienic
diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
index f83834da9..d9abe9d08 100644
--- a/module/system/base/compile.scm
+++ b/module/system/base/compile.scm
@@ -48,7 +48,7 @@
(format (current-error-port)
"~A:~A: ~A: ~A~%" (car loc) (cdr loc) msg exp)
(format (current-error-port)
- "unknown location: ~A: ~A~%" msg exp)))))
+ "unknown location: ~A: ~S~%" msg exp)))))
;;;
@@ -77,8 +77,7 @@
(lambda ()
(with-throw-handler #t
(lambda ()
- (with-output-to-port tmp
- (lambda () (proc (current-output-port))))
+ (proc tmp)
(rename-file template filename))
(lambda args
(delete-file template)))))))