From 0f723c17ea018436100a3d1ee0c4219baa6d7644 Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Wed, 3 Apr 2013 00:18:58 +0900 Subject: [PATCH] Alternate guard form - evaluate the guard clauses in the continuation of the raise. We need to override the current-exception-handler and still pass a thunk to be applied on return, but this allows us to print stack traces inside guards. --- lib/init-7.scm | 36 ++++++++++++++++++++---------------- 1 file changed, 20 insertions(+), 16 deletions(-) diff --git a/lib/init-7.scm b/lib/init-7.scm index d744719a..9150f93f 100644 --- a/lib/init-7.scm +++ b/lib/init-7.scm @@ -923,22 +923,26 @@ (define-syntax guard (syntax-rules () ((guard (var clause ...) e1 e2 ...) - ((call-with-current-continuation - (lambda (guard-k) - (with-exception-handler - (lambda (condition) - ((call-with-current-continuation - (lambda (handler-k) - (guard-k - (lambda () - (let ((var condition)) - (guard-aux (handler-k (lambda () - (raise-continuable condition))) - clause ...)))))))) - (lambda () - (call-with-values (lambda () e1 e2 ...) - (lambda args - (guard-k (lambda () (apply values args))))))))))))) + (let ((orig-handler (current-exception-handler))) + ((call-with-current-continuation + (lambda (guard-k) + (with-exception-handler + (lambda (condition) + ((call-with-current-continuation + (lambda (handler-k) + (let* ((var condition) ; clauses may set! var + (res + (with-exception-handler + orig-handler + (lambda () + (guard-aux + (handler-k (lambda () + (raise-continuable condition))) + clause ...))))) + (guard-k (lambda () res))))))) + (lambda () + (let ((res (begin e1 e2 ...))) + (guard-k (lambda () res)))))))))))) (define-syntax guard-aux (syntax-rules (else =>)