diff --git a/info.rkt b/info.rkt index f8cc4ce..80ae4ad 100644 --- a/info.rkt +++ b/info.rkt @@ -4,7 +4,7 @@ (define version "1.0.1") (define license '(Apache-2.0 OR MIT)) (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 '( diff --git a/main.rkt b/main.rkt index 471b30f..6a440cc 100644 --- a/main.rkt +++ b/main.rkt @@ -56,58 +56,32 @@ (define a-false? (a-eq? #f)) -(define-syntax assert-expr +(define-syntax let/assert* (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) - -(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) + ((_ ((v1 e1)) (b1 ...)) + (let ((v1 e1)) + b1 ...)) + ((_ ((v1 e1 assert1 ret1)) (b1 ...)) + (let ((v1 e1)) + (cond ((assert1 v1) + b1 ...) + (else ret1)))) + ((_ ((v1 e1) r ...) (b1 ...)) + (let ((v1 e1)) + (let/assert* (r ...) (b1 ...)))) + ((_ ((v1 e1 assert1 ret1) r ...) (b1 ...)) + (let ((v1 e1)) + (cond ((assert1 v1) + (let/assert* (r ...) (b1 ...))) + (else ret1)))) ) ) (define-syntax let/assert (syntax-rules () - ((_ ((v rest ...) ...) b1 ...) - (with-handlers ([exn:let/assert? let/assert-value]) - (let* ((v (assert-expr rest ...)) - ...) - b1 - ... - ) - ) + ((_ (a1 ...) b1 ...) + (let/assert* (a1 ...) (b1 ...)) ) ) ) -|# \ No newline at end of file +