summaryrefslogtreecommitdiff
path: root/module/rnrs
diff options
context:
space:
mode:
Diffstat (limited to 'module/rnrs')
-rw-r--r--module/rnrs/6/exceptions.scm23
-rw-r--r--module/rnrs/records/6/procedural.scm2
2 files changed, 23 insertions, 2 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))))))
)
diff --git a/module/rnrs/records/6/procedural.scm b/module/rnrs/records/6/procedural.scm
index a14842e1c..da30fa407 100644
--- a/module/rnrs/records/6/procedural.scm
+++ b/module/rnrs/records/6/procedural.scm
@@ -273,6 +273,6 @@
(throw 'r6rs:exception (make-raise-object-wrapper obj #f)))
(define (r6rs-raise-continuable obj)
(define (r6rs-raise-continuable-internal continuation)
- (raise (make-raise-object-wrapper obj continuation)))
+ (throw 'r6rs:exception (make-raise-object-wrapper obj continuation)))
(call/cc r6rs-raise-continuable-internal))
)