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
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:
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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}))
|
||||
|
||||
Reference in New Issue
Block a user