mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-12 06:41:13 +02:00
Code Activity

minor cleanups

Browse source 
* 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
Download patch file Download diff file Expand all files Collapse all files

8
libguile/stacks.c
View file

@ -552,8 +552,12 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
SCM_STACK (stack) -> length = n; SCM_STACK (stack) -> length = n;
/* Translate the current chain of stack frames into debugging information. */ /* Translate the current chain of stack frames into debugging information. */
if (read_frames (dframe, offset, vmframe, n, iframe) != n) n = read_frames (dframe, offset, vmframe, n, iframe);
abort (); /* we counted wrong, this really shouldn't happen */ 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. */ /* Narrow the stack according to the arguments given to scm_make_stack. */
SCM_VALIDATE_REST_ARGUMENT (args); SCM_VALIDATE_REST_ARGUMENT (args);

10
module/language/scheme/compile-ghil.scm
View file

@ -317,11 +317,11 @@
;; (lambda FORMALS BODY...) ;; (lambda FORMALS BODY...)
((,formals . ,body) ((,formals . ,body)
(receive (syms rest) (parse-formals formals) (receive (syms rest) (parse-formals formals)
(call-with-ghil-environment e syms (call-with-ghil-environment e syms
(lambda (env vars) (lambda (env vars)
(receive (meta body) (parse-lambda-meta body) (receive (meta body) (parse-lambda-meta body)
(make-ghil-lambda env l vars rest meta (make-ghil-lambda env l vars rest meta
(trans-body env l body)))))))) (trans-body env l body))))))))
(define-scheme-translator delay (define-scheme-translator delay
;; FIXME not hygienic ;; FIXME not hygienic

5
module/system/base/compile.scm
View file

@ -48,7 +48,7 @@
(format (current-error-port) (format (current-error-port)
"~A:~A: ~A: ~A~%" (car loc) (cdr loc) msg exp) "~A:~A: ~A: ~A~%" (car loc) (cdr loc) msg exp)
(format (current-error-port) (format (current-error-port)
"unknown location: ~A: ~A~%" msg exp))))) "unknown location: ~A: ~S~%" msg exp)))))
;;; ;;;
@ -77,8 +77,7 @@
(lambda () (lambda ()
(with-throw-handler #t (with-throw-handler #t
(lambda () (lambda ()
(with-output-to-port tmp (proc tmp)
(lambda () (proc (current-output-port))))
(rename-file template filename)) (rename-file template filename))
(lambda args (lambda args
(delete-file template))))))) (delete-file template)))))))