kernel: $cond/$when/$unless + 12 tests [nothing]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 28s

Standard Kernel control flow. $cond walks clauses in order with `else`
catch-all; clauses past the first match are NOT evaluated. $when/$unless
are simple guards. 12 tests, 242 total.
This commit is contained in:
2026-05-11 21:08:08 +00:00
parent a4a7753314
commit 5fa6c6ecc1
3 changed files with 102 additions and 0 deletions

View File

@@ -237,6 +237,70 @@
((or (nil? xs) (= (length xs) 0)) ys)
(:else (cons (first xs) (knl-list-concat (rest xs) ys))))))
;; $cond — multi-clause branch.
;; ($cond (TEST1 EXPR1 ...) (TEST2 EXPR2 ...) ...)
;; Evaluates each TEST in order; first truthy one runs its EXPRs (in
;; sequence) and returns the last; if no TEST is truthy, returns nil.
;; A clause with TEST = `else` always matches (sugar for $if's default).
(define knl-cond-impl
(fn (clauses dyn-env)
(cond
((or (nil? clauses) (= (length clauses) 0)) nil)
(:else
(let ((clause (first clauses)))
(cond
((not (list? clause))
(error "$cond: each clause must be a list"))
((= (length clause) 0)
(error "$cond: empty clause"))
((and (string? (first clause)) (= (first clause) "else"))
(knl-cond-eval-body (rest clause) dyn-env))
(:else
(let ((test-val (kernel-eval (first clause) dyn-env)))
(cond
(test-val (knl-cond-eval-body (rest clause) dyn-env))
(:else (knl-cond-impl (rest clauses) dyn-env)))))))))))
(define knl-cond-eval-body
(fn (body dyn-env)
(cond
((or (nil? body) (= (length body) 0)) nil)
((= (length body) 1) (kernel-eval (first body) dyn-env))
(:else
(begin
(kernel-eval (first body) dyn-env)
(knl-cond-eval-body (rest body) dyn-env))))))
(define kernel-cond-operative
(kernel-make-primitive-operative
(fn (args dyn-env) (knl-cond-impl args dyn-env))))
;; $when COND BODY... — evaluate body iff COND is truthy; else nil.
(define kernel-when-operative
(kernel-make-primitive-operative
(fn (args dyn-env)
(cond
((< (length args) 1)
(error "$when: expects (cond body...)"))
(:else
(let ((c (kernel-eval (first args) dyn-env)))
(cond
(c (knl-cond-eval-body (rest args) dyn-env))
(:else nil))))))))
;; $unless COND BODY... — evaluate body iff COND is falsy; else nil.
(define kernel-unless-operative
(kernel-make-primitive-operative
(fn (args dyn-env)
(cond
((< (length args) 1)
(error "$unless: expects (cond body...)"))
(:else
(let ((c (kernel-eval (first args) dyn-env)))
(cond
(c nil)
(:else (knl-cond-eval-body (rest args) dyn-env)))))))))
(define kernel-quasiquote-operative
(kernel-make-primitive-operative
(fn (args dyn-env)
@@ -514,6 +578,9 @@
(kernel-env-bind! env "$sequence" kernel-sequence-operative)
(kernel-env-bind! env "$quote" kernel-quote-operative)
(kernel-env-bind! env "$quasiquote" kernel-quasiquote-operative)
(kernel-env-bind! env "$cond" kernel-cond-operative)
(kernel-env-bind! env "$when" kernel-when-operative)
(kernel-env-bind! env "$unless" kernel-unless-operative)
(kernel-env-bind! env "eval" kernel-eval-applicative)
(kernel-env-bind!
env

View File

@@ -285,4 +285,38 @@
(ks-eval-in "`(a ,@x b)" env)))
:raised)
;; ── $cond / $when / $unless ─────────────────────────────────────
(ks-test "cond: first match"
(ks-eval "($cond (#f 1) (#t 2) (#t 3))") 2)
(ks-test "cond: else fallback"
(ks-eval "($cond (#f 1) (else 99))") 99)
(ks-test "cond: no match returns nil"
(ks-eval "($cond (#f 1) (#f 2))") nil)
(ks-test "cond: empty clauses returns nil"
(ks-eval "($cond)") nil)
(ks-test "cond: multi-expr body"
(ks-eval "($cond (#t 1 2 3))") 3)
(ks-test "cond: doesn't evaluate untaken clauses"
;; If the second clause's test were evaluated, the unbound `nope` would error.
(ks-eval "($cond (#t 7) (nope ignored))") 7)
(ks-test "cond: predicate evaluation"
(let ((env (kernel-standard-env)))
(ks-eval-in "($define! n 5)" env)
(ks-eval-in "($cond ((< n 0) ($quote negative)) ((= n 0) ($quote zero)) (else ($quote positive)))" env))
"positive")
(ks-test "when: true runs body"
(ks-eval "($when #t 1 2 3)") 3)
(ks-test "when: false returns nil"
(ks-eval "($when #f 1 2 3)") nil)
(ks-test "when: skips body when false"
(ks-eval "($when #f nope)") nil)
(ks-test "unless: false runs body"
(ks-eval "($unless #f 99)") 99)
(ks-test "unless: true returns nil"
(ks-eval "($unless #t 99)") nil)
(ks-test "unless: skips body when true"
(ks-eval "($unless #t nope)") nil)
(define ks-tests-run! (fn () {:total (+ ks-test-pass ks-test-fail) :passed ks-test-pass :failed ks-test-fail :fails ks-test-fails}))