no call/cc nor exceptions anymore, just a let/cond construction created from the input

This commit is contained in:
2026-05-11 23:19:32 +02:00
parent 20b54b8447
commit e13af168f8
2 changed files with 21 additions and 47 deletions
+1 -1
View File
@@ -4,7 +4,7 @@
(define version "1.0.1") (define version "1.0.1")
(define license '(Apache-2.0 OR MIT)) (define license '(Apache-2.0 OR MIT))
(define collection "let-assert") (define collection "let-assert")
(define pkg-desc "A let construct with assertions, i.e. when an assertion is not satisfied, one can prematurely exit a function with a given return value.") (define pkg-desc "A let* construct with assertions, i.e. when an assertion is not satisfied, one can prematurely exit a function with a given return value.")
(define scribblings (define scribblings
'( '(
+20 -46
View File
@@ -56,58 +56,32 @@
(define a-false? (a-eq? #f)) (define a-false? (a-eq? #f))
(define-syntax assert-expr (define-syntax let/assert*
(syntax-rules () (syntax-rules ()
((_ fail (expr cond retval)) ((_ ((v1 e1)) (b1 ...))
(let ((a expr)) (if (cond a) a (fail retval)))) (let ((v1 e1))
((_ fail (expr)) expr) b1 ...))
) ((_ ((v1 e1 assert1 ret1)) (b1 ...))
) (let ((v1 e1))
(cond ((assert1 v1)
(define-syntax let/assert b1 ...)
(syntax-rules (fail) (else ret1))))
((_ ((v rest ...) ...) b1 ...) ((_ ((v1 e1) r ...) (b1 ...))
(call/cc (let ((v1 e1))
(λ (fail) (let/assert* (r ...) (b1 ...))))
(let* ((v (assert-expr fail (rest ...))) ((_ ((v1 e1 assert1 ret1) r ...) (b1 ...))
...) (let ((v1 e1))
b1 (cond ((assert1 v1)
...) (let/assert* (r ...) (b1 ...)))
) (else ret1))))
)
)
)
)
#|
(struct exn:let/assert exn (value) #:transparent)
(define (raise-let/assert v)
(raise (exn:let/assert "let/assert" (current-continuation-marks) v)))
(define (let/assert-value r)
(exn:let/assert-value r))
(define-syntax assert-expr
(syntax-rules ()
((_ expr cond retval)
(let ((a expr)) (if (cond a) a (raise-let/assert retval))))
((_ expr)
expr)
) )
) )
(define-syntax let/assert (define-syntax let/assert
(syntax-rules () (syntax-rules ()
((_ ((v rest ...) ...) b1 ...) ((_ (a1 ...) b1 ...)
(with-handlers ([exn:let/assert? let/assert-value]) (let/assert* (a1 ...) (b1 ...))
(let* ((v (assert-expr rest ...))
...)
b1
...
) )
) )
) )
)
)
|#