kernel: variadic +-*/, chained <>=? + 19 tests [nothing]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 25s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 25s
knl-fold-app for n-ary fold with zero-arity identity and one-arity special-case (- negates, / inverts). knl-chain-cmp for chained boolean comparison. 279 tests total.
This commit is contained in:
@@ -391,6 +391,45 @@
|
||||
(error (str name ": expects 2 arguments")))
|
||||
(:else (f (first args) (nth args 1))))))))
|
||||
|
||||
;; Variadic left-fold helper. ZERO-RES is the identity (`(+)` → 0);
|
||||
;; ONE-FN handles single-arg case (`(- x)` negates; `(+ x)` returns x).
|
||||
(define knl-fold-step
|
||||
(fn (f acc rest-args)
|
||||
(cond
|
||||
((or (nil? rest-args) (= (length rest-args) 0)) acc)
|
||||
(:else
|
||||
(knl-fold-step f (f acc (first rest-args)) (rest rest-args))))))
|
||||
|
||||
(define knl-fold-app
|
||||
(fn (name f zero-res one-fn)
|
||||
(kernel-make-primitive-applicative
|
||||
(fn (args)
|
||||
(cond
|
||||
((= (length args) 0) zero-res)
|
||||
((= (length args) 1) (one-fn (first args)))
|
||||
(:else (knl-fold-step f (first args) (rest args))))))))
|
||||
|
||||
;; Variadic n-ary chained comparison: `(< 1 2 3)` ≡ `(< 1 2)` AND `(< 2 3)`.
|
||||
(define knl-chain-step
|
||||
(fn (cmp prev rest-args)
|
||||
(cond
|
||||
((or (nil? rest-args) (= (length rest-args) 0)) true)
|
||||
(:else
|
||||
(let ((next (first rest-args)))
|
||||
(cond
|
||||
((cmp prev next)
|
||||
(knl-chain-step cmp next (rest rest-args)))
|
||||
(:else false)))))))
|
||||
|
||||
(define knl-chain-cmp
|
||||
(fn (name cmp)
|
||||
(kernel-make-primitive-applicative
|
||||
(fn (args)
|
||||
(cond
|
||||
((< (length args) 2)
|
||||
(error (str name ": expects at least 2 arguments")))
|
||||
(:else (knl-chain-step cmp (first args) (rest args))))))))
|
||||
|
||||
;; ── list / pair primitives ──────────────────────────────────────
|
||||
|
||||
(define
|
||||
@@ -657,14 +696,18 @@
|
||||
env
|
||||
"get-current-environment"
|
||||
kernel-get-current-env-operative)
|
||||
(kernel-env-bind! env "+" (knl-bin-app "+" (fn (a b) (+ a b))))
|
||||
(kernel-env-bind! env "-" (knl-bin-app "-" (fn (a b) (- a b))))
|
||||
(kernel-env-bind! env "*" (knl-bin-app "*" (fn (a b) (* a b))))
|
||||
(kernel-env-bind! env "/" (knl-bin-app "/" (fn (a b) (/ a b))))
|
||||
(kernel-env-bind! env "<" (knl-bin-app "<" (fn (a b) (< a b))))
|
||||
(kernel-env-bind! env ">" (knl-bin-app ">" (fn (a b) (> a b))))
|
||||
(kernel-env-bind! env "<=?" (knl-bin-app "<=?" (fn (a b) (<= a b))))
|
||||
(kernel-env-bind! env ">=?" (knl-bin-app ">=?" (fn (a b) (>= a b))))
|
||||
(kernel-env-bind! env "+"
|
||||
(knl-fold-app "+" (fn (a b) (+ a b)) 0 (fn (x) x)))
|
||||
(kernel-env-bind! env "-"
|
||||
(knl-fold-app "-" (fn (a b) (- a b)) 0 (fn (x) (- 0 x))))
|
||||
(kernel-env-bind! env "*"
|
||||
(knl-fold-app "*" (fn (a b) (* a b)) 1 (fn (x) x)))
|
||||
(kernel-env-bind! env "/"
|
||||
(knl-fold-app "/" (fn (a b) (/ a b)) 1 (fn (x) (/ 1 x))))
|
||||
(kernel-env-bind! env "<" (knl-chain-cmp "<" (fn (a b) (< a b))))
|
||||
(kernel-env-bind! env ">" (knl-chain-cmp ">" (fn (a b) (> a b))))
|
||||
(kernel-env-bind! env "<=?" (knl-chain-cmp "<=?" (fn (a b) (<= a b))))
|
||||
(kernel-env-bind! env ">=?" (knl-chain-cmp ">=?" (fn (a b) (>= a b))))
|
||||
(kernel-env-bind! env "=?" kernel-eq?-applicative)
|
||||
(kernel-env-bind! env "equal?" kernel-equal?-applicative)
|
||||
(kernel-env-bind! env "eq?" kernel-eq?-applicative)
|
||||
|
||||
@@ -337,4 +337,30 @@
|
||||
(ks-test "or: middle truthy"
|
||||
(ks-eval "($or? #f 42 nope)") 42)
|
||||
|
||||
;; ── variadic arithmetic ─────────────────────────────────────────
|
||||
(ks-test "+: zero args = 0" (ks-eval "(+)") 0)
|
||||
(ks-test "+: one arg = arg" (ks-eval "(+ 7)") 7)
|
||||
(ks-test "+: two args" (ks-eval "(+ 3 4)") 7)
|
||||
(ks-test "+: five args" (ks-eval "(+ 1 2 3 4 5)") 15)
|
||||
|
||||
(ks-test "*: zero args = 1" (ks-eval "(*)") 1)
|
||||
(ks-test "*: one arg" (ks-eval "(* 7)") 7)
|
||||
(ks-test "*: four args" (ks-eval "(* 1 2 3 4)") 24)
|
||||
|
||||
(ks-test "-: one arg negates" (ks-eval "(- 10)") -10)
|
||||
(ks-test "-: two args" (ks-eval "(- 10 3)") 7)
|
||||
(ks-test "-: four args fold" (ks-eval "(- 100 1 2 3)") 94)
|
||||
|
||||
(ks-test "/: two args" (ks-eval "(/ 20 5)") 4)
|
||||
(ks-test "/: three args fold" (ks-eval "(/ 100 2 5)") 10)
|
||||
|
||||
;; ── variadic chained comparison ─────────────────────────────────
|
||||
(ks-test "<: chained ascending" (ks-eval "(< 1 2 3 4 5)") true)
|
||||
(ks-test "<: not strict" (ks-eval "(< 1 2 2 3)") false)
|
||||
(ks-test "<: anti-monotonic" (ks-eval "(< 5 3)") false)
|
||||
(ks-test ">: chained descending" (ks-eval "(> 5 4 3 2 1)") true)
|
||||
(ks-test "<=? ascending equals" (ks-eval "(<=? 1 1 2 3 3)") true)
|
||||
(ks-test "<=? violation" (ks-eval "(<=? 1 2 1)") false)
|
||||
(ks-test ">=? descending equals" (ks-eval "(>=? 3 3 2 1)") true)
|
||||
|
||||
(define ks-tests-run! (fn () {:total (+ ks-test-pass ks-test-fail) :passed ks-test-pass :failed ks-test-fail :fails ks-test-fails}))
|
||||
|
||||
@@ -160,6 +160,7 @@ The motivation is that SX's host `make-env` family is registered only in HTTP/si
|
||||
|
||||
## Progress log
|
||||
|
||||
- 2026-05-11 — Variadic `+ - * /` and chained `< > <=? >=?`. `(+ 1 2 3)` = 6, `(+)` = 0, `(+ 7)` = 7. `(- 10 1 2 3)` = 4 (left fold); single-arg `-` negates. `(* 1 2 3 4)` = 24, `(*)` = 1. Chained comparison: `(< 1 2 3)` ≡ `(< 1 2) ∧ (< 2 3)`. Implementation: `knl-fold-app` for n-ary fold with zero-arity identity and one-arity special-case; `knl-chain-cmp` for chained boolean. 19 new tests. chisel: nothing (mechanical extension of existing arithmetic primitives). 279 tests total.
|
||||
- 2026-05-11 — `$let*` sequential let. Each binding evaluated in scope where earlier bindings are visible, so `($let* ((x 1) (y (+ x 1))) y)` returns 2. Implemented by nesting envs one per binding — `knl-let*-step` recursively builds the env chain. `$let` and `$let*` now both accept multi-expression bodies (`knl-eval-body` re-used). 8 new tests in `tests/hygiene.sx`. chisel: nothing (a standard derived form). 260 tests total.
|
||||
- 2026-05-11 — `$and?` / `$or?` short-circuit booleans. Operatives (not applicatives) so untaken arguments are NOT evaluated. Identity values: `$and?` empty = true, `$or?` empty = false. Returns the last evaluated value (Kernel convention — not coerced to bool). 10 new tests including the short-circuit verification (`($and? #f nope)` returns false without evaluating `nope`). chisel: shapes-reflective. Sketched `lib/guest/reflective/short-circuit.sx` API; the protocol is identical across reflective Lisps because short-circuit FORCES operative semantics — an applicative variant would defeat the purpose. 252 tests total.
|
||||
- 2026-05-11 — `$cond` / `$when` / `$unless`. Standard Kernel control flow added: `$cond` walks clauses in order, evaluates first truthy test, runs that clause's body in sequence; `else` is the catch-all symbol; empty cond and no-match cond return nil. `$when` and `$unless` are simple conditional execution. All three preserve hygiene (clauses not taken are NOT evaluated). 12 new tests in `tests/standard.sx`. chisel: nothing. 242 tests total. (Third `nothing` in a row but allowable here — these are textbook Kernel idioms with no novel reflective angle.)
|
||||
|
||||
Reference in New Issue
Block a user