diff options
Diffstat (limited to 'module/rnrs/6/exceptions.scm')
-rw-r--r-- | module/rnrs/6/exceptions.scm | 23 |
1 files changed, 22 insertions, 1 deletions
diff --git a/module/rnrs/6/exceptions.scm b/module/rnrs/6/exceptions.scm index eeea9238b..87dfe70b9 100644 --- a/module/rnrs/6/exceptions.scm +++ b/module/rnrs/6/exceptions.scm @@ -18,10 +18,11 @@ (library (rnrs exceptions (6)) - (export with-exception-handler raise raise-continuable) + (export guard with-exception-handler raise raise-continuable) (import (rnrs base (6)) (rnrs conditions (6)) (rnrs records procedural (6)) + (rnrs syntax-case (6)) (only (guile) with-throw-handler)) (define raise (@@ (rnrs records procedural) r6rs-raise)) @@ -48,4 +49,24 @@ (continuation handler-return) (raise (make-non-continuable-violation)))) *unspecified*)))) + + (define-syntax guard0 + (lambda (stx) + (syntax-case stx () + ((_ (variable cond-clause ...) body) + (syntax (call/cc (lambda (continuation) + (with-exception-handler + (lambda (variable) + (continuation (cond cond-clause ...))) + (lambda () body))))))))) + + (define-syntax guard + (lambda (stx) + (syntax-case stx (else) + ((_ (variable cond-clause ... . ((else else-clause ...))) body) + (syntax (guard0 (variable cond-clause ... (else else-clause ...)) + body))) + ((_ (variable cond-clause ...) body) + (syntax (guard0 (variable cond-clause ... (else (raise variable))) + body)))))) ) |