changed the implementation to call/cc
This commit is contained in:
@@ -55,6 +55,31 @@
|
|||||||
(define a-true? (a-eq? #t))
|
(define a-true? (a-eq? #t))
|
||||||
(define a-false? (a-eq? #f))
|
(define a-false? (a-eq? #f))
|
||||||
|
|
||||||
|
|
||||||
|
(define-syntax assert-expr
|
||||||
|
(syntax-rules ()
|
||||||
|
((_ fail (expr cond retval))
|
||||||
|
(let ((a expr)) (if (cond a) a (fail retval))))
|
||||||
|
((_ fail (expr)) expr)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
(define-syntax let/assert
|
||||||
|
(syntax-rules ()
|
||||||
|
((_ fail ((v rest ...) ...) b1 ...)
|
||||||
|
(call/cc
|
||||||
|
(λ (fail)
|
||||||
|
(let* ((v (assert-expr fail (rest ...)))
|
||||||
|
...)
|
||||||
|
b1
|
||||||
|
...)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
#|
|
||||||
(struct exn:let/assert exn (value) #:transparent)
|
(struct exn:let/assert exn (value) #:transparent)
|
||||||
|
|
||||||
(define (raise-let/assert v)
|
(define (raise-let/assert v)
|
||||||
@@ -85,3 +110,4 @@
|
|||||||
)
|
)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
|#
|
||||||
Reference in New Issue
Block a user