1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 14:00:21 +02:00

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.
This commit is contained in:
Andy Wingo 2009-02-09 11:42:27 +01:00
parent 2f9769b60c
commit 9892287960
3 changed files with 13 additions and 10 deletions

View file

@ -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);

View file

@ -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

View file

@ -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)))))))