kernel: map/filter/reduce + with-env applicative constructor + 10 tests [shapes-reflective]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 27s

Added kernel-make-primitive-applicative-with-env in eval.sx — IMPL
receives (args dyn-env), needed by combinators that re-enter the
evaluator. map/filter/reduce in runtime.sx use it to call user-supplied
combiners on each element with the caller's dynamic env preserved.
Sketched the env-blind vs env-aware applicative split as a new entry
in the proposed combiner.sx reflective API. 289 tests total.
This commit is contained in:
2026-05-11 21:15:54 +00:00
parent 1fb852ef64
commit 78dab5b28c
4 changed files with 118 additions and 0 deletions

View File

@@ -118,6 +118,14 @@
(kernel-wrap
(kernel-make-primitive-operative (fn (args dyn-env) (impl args))))))
;; As above, but IMPL receives (args dyn-env). Used by combinators that
;; re-enter the evaluator (map, filter, reduce, apply, eval, ...).
(define kernel-make-primitive-applicative-with-env
(fn (impl)
(kernel-wrap
(kernel-make-primitive-operative
(fn (args dyn-env) (impl args dyn-env))))))
;; ── The evaluator ────────────────────────────────────────────────
(define

View File

@@ -500,6 +500,79 @@
kernel-equal?-applicative
(knl-bin-app "equal?" (fn (a b) (= a b))))
;; ── List combinators: map / filter / reduce ─────────────────────
;; These re-enter the evaluator on each element, so they use the
;; with-env applicative constructor.
(define knl-map-step
(fn (fn-val xs dyn-env)
(cond
((or (nil? xs) (= (length xs) 0)) (list))
(:else
(cons (kernel-combine fn-val (list (first xs)) dyn-env)
(knl-map-step fn-val (rest xs) dyn-env))))))
(define kernel-map-applicative
(kernel-make-primitive-applicative-with-env
(fn (args dyn-env)
(cond
((not (= (length args) 2))
(error "map: expects (fn list)"))
((not (kernel-combiner? (first args)))
(error "map: first arg must be a combiner"))
((not (list? (nth args 1)))
(error "map: second arg must be a list"))
(:else (knl-map-step (first args) (nth args 1) dyn-env))))))
(define knl-filter-step
(fn (pred xs dyn-env)
(cond
((or (nil? xs) (= (length xs) 0)) (list))
(:else
(let ((keep? (kernel-combine pred (list (first xs)) dyn-env)))
(cond
(keep?
(cons (first xs)
(knl-filter-step pred (rest xs) dyn-env)))
(:else (knl-filter-step pred (rest xs) dyn-env))))))))
(define kernel-filter-applicative
(kernel-make-primitive-applicative-with-env
(fn (args dyn-env)
(cond
((not (= (length args) 2))
(error "filter: expects (pred list)"))
((not (kernel-combiner? (first args)))
(error "filter: first arg must be a combiner"))
((not (list? (nth args 1)))
(error "filter: second arg must be a list"))
(:else (knl-filter-step (first args) (nth args 1) dyn-env))))))
(define knl-reduce-step
(fn (fn-val xs acc dyn-env)
(cond
((or (nil? xs) (= (length xs) 0)) acc)
(:else
(knl-reduce-step
fn-val
(rest xs)
(kernel-combine fn-val (list acc (first xs)) dyn-env)
dyn-env)))))
(define kernel-reduce-applicative
(kernel-make-primitive-applicative-with-env
(fn (args dyn-env)
(cond
((not (= (length args) 3))
(error "reduce: expects (fn init list)"))
((not (kernel-combiner? (first args)))
(error "reduce: first arg must be a combiner"))
((not (list? (nth args 2)))
(error "reduce: third arg must be a list"))
(:else
(knl-reduce-step (first args) (nth args 2)
(nth args 1) dyn-env))))))
;; ── Encapsulations: Kernel's opaque-type idiom ──────────────────
;;
;; (make-encapsulation-type) → (encapsulator predicate decapsulator)
@@ -718,6 +791,9 @@
(kernel-env-bind! env "length" kernel-length-applicative)
(kernel-env-bind! env "null?" kernel-null?-applicative)
(kernel-env-bind! env "pair?" kernel-pair?-applicative)
(kernel-env-bind! env "map" kernel-map-applicative)
(kernel-env-bind! env "filter" kernel-filter-applicative)
(kernel-env-bind! env "reduce" kernel-reduce-applicative)
(kernel-env-bind! env "not" kernel-not-applicative)
(kernel-env-bind! env "make-encapsulation-type"
kernel-make-encap-type-applicative)

View File

@@ -363,4 +363,36 @@
(ks-test "<=? violation" (ks-eval "(<=? 1 2 1)") false)
(ks-test ">=? descending equals" (ks-eval "(>=? 3 3 2 1)") true)
;; ── list combinators ────────────────────────────────────────────
(ks-test "map: square"
(ks-eval "(map ($lambda (x) (* x x)) (list 1 2 3 4))")
(list 1 4 9 16))
(ks-test "map: empty list"
(ks-eval "(map ($lambda (x) x) (list))") (list))
(ks-test "map: identity preserves"
(ks-eval "(map ($lambda (x) x) (list 1 2 3))") (list 1 2 3))
(ks-test "map: with closure over outer"
(let ((env (kernel-standard-env)))
(ks-eval-in "($define! k 10)" env)
(ks-eval-in "(map ($lambda (x) (+ x k)) (list 1 2 3))" env))
(list 11 12 13))
(ks-test "filter: positives"
(ks-eval "(filter ($lambda (x) (< 0 x)) (list -2 -1 0 1 2))")
(list 1 2))
(ks-test "filter: empty result"
(ks-eval "(filter ($lambda (x) #f) (list 1 2 3))") (list))
(ks-test "filter: all match"
(ks-eval "(filter ($lambda (x) #t) (list 1 2 3))") (list 1 2 3))
(ks-test "reduce: sum"
(ks-eval "(reduce ($lambda (a b) (+ a b)) 0 (list 1 2 3 4 5))") 15)
(ks-test "reduce: product"
(ks-eval "(reduce ($lambda (a b) (* a b)) 1 (list 1 2 3 4))") 24)
(ks-test "reduce: empty returns init"
(ks-eval "(reduce ($lambda (a b) (+ a b)) 42 (list))") 42)
(ks-test "reduce: build list"
(ks-eval "(reduce ($lambda (acc x) (cons x acc)) () (list 1 2 3))")
(list 3 2 1))
(define ks-tests-run! (fn () {:total (+ ks-test-pass ks-test-fail) :passed ks-test-pass :failed ks-test-fail :fails ks-test-fails}))