diff --git a/d-.scm b/d-.scm index da26452..361b20e 100644 --- a/d-.scm +++ b/d-.scm @@ -7,6 +7,7 @@ as~> if-not if-let + when-let for partial argmin @@ -39,14 +40,20 @@ (let [(as v)] (as~> as (fn args ...) more ...))])) -(define-syntax-rule (if-not pred body ...) - (if (not pred) body ...)) +(define-syntax-rule (if-not pred true-arm false-arm) + (if (not pred) true-arm false-arm)) -(define-syntax-rule (if-let ([ident test]) expr ...) +(define-syntax-rule (if-let ([ident test]) true-arm false-arm) + (let ([t test]) + (if t + (let ([ident t]) + true-arm) + false-arm))) + +(define-syntax-rule (when-let ([ident test]) expr ...) (let ([ident test]) - (if ident - (begin expr ...) - #f))) + (when ident + expr ...))) (define-syntax for (syntax-rules () diff --git a/test.scm b/test.scm index 7693855..ce0995a 100644 --- a/test.scm +++ b/test.scm @@ -31,6 +31,21 @@ (define-test "test" (assert-equal 'a (if-not #f 'a 'b)))) +(define-test-suite "if-let" + (define-test "positive case" + (assert-equal 2 (if-let ([v (or #f 1)]) (+ v 1) 3))) + (define-test "negative case" + (assert-equal 3 (if-let ([v (and #f 1)]) (+ v 1) 3))) + (define-test "variable not shadowed in false arm" + (define v 3) + (assert-equal 3 (if-let ([v #f]) (+ v 1) v)))) + +(define-test-suite "when-let" + (define-test "positive case" + (assert-equal 2 (when-let ([v (or #f 1)]) (+ v 1)))) + (define-test "negative case" + (assert-equal (when #f #t) (when-let ([v (and #f 1)]) (+ v 1))))) + (define-test-suite "for" (define-test "permutation" (define value (for ([i (iota 2)] @@ -38,12 +53,6 @@ (cons i j))) (assert-equal '((0 . 0) (0 . 1) (1 . 0) (1 . 1)) value))) -(define-test-suite "if-let" - (define-test "positive-case" - (assert-equal 2 (if-let ([v (or #f 1)]) (+ v 1)))) - (define-test "negative-case" - (assert-equal #f (if-let ([v (and #f 1)]) (+ v 1))))) - (define-test-suite "partial" (define-test "test" (define value (partial / 2))