kernel: type predicates + metacircular demo + map/filter/reduce fix [shapes-reflective]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 44s

Five type predicates (number?, string?, list?, boolean?, symbol?).
New tests/metacircular.sx: m-eval defined in Kernel walks expressions
itself, recursing on applicative-call args and delegating to host
eval only for operatives and symbol lookup. 14 demo tests.

The demo surfaced a real bug: map/filter/reduce called kernel-combine
on applicative head-vals directly, which re-evaluates already-
evaluated element values; nested-list elements crashed. Fix: extracted
knl-apply-op (unwrap-applicative-or-pass-through) and use it in all
three combinators before kernel-combine. Mirrors apply's approach.

Added knl-apply-op as a proposed entry in the reflective combiner.sx
API. 322 tests total.
This commit is contained in:
2026-05-11 21:27:23 +00:00
parent 67449f5b0c
commit d5d77a3611
3 changed files with 214 additions and 9 deletions

View File

@@ -534,6 +534,21 @@
(define kernel-not-applicative (knl-unary-app "not" (fn (v) (not v))))
;; Type predicates (Kernel-visible). Note `string?` covers BOTH symbols
;; and string-literals in our representation (symbols are bare SX
;; strings); a `kernel-string?` applicative distinguishes the two if
;; needed.
(define kernel-number?-applicative
(knl-unary-app "number?" (fn (v) (number? v))))
(define kernel-string?-applicative
(knl-unary-app "string?" (fn (v) (string? v))))
(define kernel-list?-applicative
(knl-unary-app "list?" (fn (v) (list? v))))
(define kernel-boolean?-applicative
(knl-unary-app "boolean?" (fn (v) (boolean? v))))
(define kernel-symbol?-applicative
(knl-unary-app "symbol?" (fn (v) (string? v))))
(define kernel-eq?-applicative (knl-bin-app "eq?" (fn (a b) (= a b))))
;; ── the standard environment ────────────────────────────────────
@@ -546,13 +561,27 @@
;; These re-enter the evaluator on each element, so they use the
;; with-env applicative constructor.
;; When the combiner is an applicative, we MUST unwrap before calling
;; — otherwise kernel-combine will re-evaluate the already-evaluated
;; element values (and crash if an element is itself a list).
(define knl-apply-op
(fn (combiner)
(cond
((kernel-applicative? combiner) (kernel-unwrap combiner))
(:else combiner))))
(define knl-map-step
(fn (fn-val xs dyn-env)
(let ((op (knl-apply-op fn-val)))
(knl-map-walk op xs dyn-env))))
(define knl-map-walk
(fn (op 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))))))
(cons (kernel-combine op (list (first xs)) dyn-env)
(knl-map-walk op (rest xs) dyn-env))))))
(define kernel-map-applicative
(kernel-make-primitive-applicative-with-env
@@ -568,15 +597,18 @@
(define knl-filter-step
(fn (pred xs dyn-env)
(knl-filter-walk (knl-apply-op pred) xs dyn-env)))
(define knl-filter-walk
(fn (op xs dyn-env)
(cond
((or (nil? xs) (= (length xs) 0)) (list))
(:else
(let ((keep? (kernel-combine pred (list (first xs)) dyn-env)))
(let ((keep? (kernel-combine op (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))))))))
(cons (first xs) (knl-filter-walk op (rest xs) dyn-env)))
(:else (knl-filter-walk op (rest xs) dyn-env))))))))
(define kernel-filter-applicative
(kernel-make-primitive-applicative-with-env
@@ -592,13 +624,17 @@
(define knl-reduce-step
(fn (fn-val xs acc dyn-env)
(knl-reduce-walk (knl-apply-op fn-val) xs acc dyn-env)))
(define knl-reduce-walk
(fn (op xs acc dyn-env)
(cond
((or (nil? xs) (= (length xs) 0)) acc)
(:else
(knl-reduce-step
fn-val
(knl-reduce-walk
op
(rest xs)
(kernel-combine fn-val (list acc (first xs)) dyn-env)
(kernel-combine op (list acc (first xs)) dyn-env)
dyn-env)))))
;; (apply COMBINER ARGS-LIST) — call COMBINER with the elements of
@@ -861,6 +897,11 @@
(kernel-env-bind! env "apply" kernel-apply-applicative)
(kernel-env-bind! env "append" kernel-append-applicative)
(kernel-env-bind! env "reverse" kernel-reverse-applicative)
(kernel-env-bind! env "number?" kernel-number?-applicative)
(kernel-env-bind! env "string?" kernel-string?-applicative)
(kernel-env-bind! env "list?" kernel-list?-applicative)
(kernel-env-bind! env "boolean?" kernel-boolean?-applicative)
(kernel-env-bind! env "symbol?" kernel-symbol?-applicative)
(kernel-env-bind! env "not" kernel-not-applicative)
(kernel-env-bind! env "make-encapsulation-type"
kernel-make-encap-type-applicative)

View File

@@ -0,0 +1,162 @@
;; lib/kernel/tests/metacircular.sx — Kernel-in-Kernel demo.
;;
;; Demonstrates reflective completeness: a Kernel program implements
;; a recognisable subset of Kernel's own evaluation rules and produces
;; matching values for a battery of test programs.
;;
;; This is a SHALLOW metacircular: it dispatches on expression shape
;; itself (numbers, booleans, lists, symbols), recursively meta-evals
;; each argument of an applicative call, and delegates only to the
;; host evaluator for the leaf cases (operatives, symbol lookup). The
;; point is to show that env-as-value, first-class operatives, and
;; first-class evaluators all line up — enough so a Kernel program
;; can itself reason about Kernel programs.
(define kmc-test-pass 0)
(define kmc-test-fail 0)
(define kmc-test-fails (list))
(define
kmc-test
(fn
(name actual expected)
(if
(= actual expected)
(set! kmc-test-pass (+ kmc-test-pass 1))
(begin
(set! kmc-test-fail (+ kmc-test-fail 1))
(append! kmc-test-fails {:name name :actual actual :expected expected})))))
;; Build a Kernel env with m-eval and m-apply defined. The two refer
;; to each other and to standard primitives, so we use the standard
;; env as the static-env for both.
(define
kmc-make-env
(fn
()
(let
((env (kernel-standard-env)))
(kernel-eval
(kernel-parse
"($define! m-eval\n ($lambda (expr env)\n ($cond\n ((number? expr) expr)\n ((boolean? expr) expr)\n ((null? expr) expr)\n ((symbol? expr) (eval expr env))\n ((list? expr)\n ($let ((head-val (m-eval (car expr) env)))\n ($cond\n ((applicative? head-val)\n (apply head-val\n (map ($lambda (a) (m-eval a env)) (cdr expr))))\n (else (eval expr env)))))\n (else expr))))")
env)
env)))
(define
kmc-eval
(fn
(src)
(let
((env (kmc-make-env)))
(kernel-eval
(kernel-parse
(str "(m-eval (quote " src ") (get-current-environment))"))
env))))
;; ── literals self-evaluate via m-eval ──────────────────────────
(kmc-test
"m-eval: integer literal"
(kernel-eval
(kernel-parse "(m-eval 42 (get-current-environment))")
(kmc-make-env))
42)
(kmc-test
"m-eval: boolean true"
(kernel-eval
(kernel-parse "(m-eval #t (get-current-environment))")
(kmc-make-env))
true)
(kmc-test
"m-eval: boolean false"
(kernel-eval
(kernel-parse "(m-eval #f (get-current-environment))")
(kmc-make-env))
false)
(kmc-test
"m-eval: empty list"
(kernel-eval
(kernel-parse "(m-eval () (get-current-environment))")
(kmc-make-env))
(list))
;; ── symbol lookup goes through env ─────────────────────────────
(kmc-test
"m-eval: symbol lookup"
(let
((env (kmc-make-env)))
(kernel-eval (kernel-parse "($define! shared-x 99)") env)
(kernel-eval
(kernel-parse "(m-eval ($quote shared-x) (get-current-environment))")
env))
99)
;; ── applicative calls are dispatched by m-eval recursively ─────
(kmc-test
"m-eval: addition"
(kernel-eval
(kernel-parse "(m-eval ($quote (+ 1 2)) (get-current-environment))")
(kmc-make-env))
3)
(kmc-test
"m-eval: nested arithmetic"
(kernel-eval
(kernel-parse
"(m-eval ($quote (+ (* 2 3) (- 10 4))) (get-current-environment))")
(kmc-make-env))
12)
(kmc-test
"m-eval: variadic +"
(kernel-eval
(kernel-parse "(m-eval ($quote (+ 1 2 3 4 5)) (get-current-environment))")
(kmc-make-env))
15)
(kmc-test
"m-eval: list construction"
(kernel-eval
(kernel-parse "(m-eval ($quote (list 1 2 3)) (get-current-environment))")
(kmc-make-env))
(list 1 2 3))
(kmc-test "m-eval: cons reverse-style"
(kernel-eval
(kernel-parse "(m-eval ($quote (cons 0 (list 1 2))) (get-current-environment))")
(kmc-make-env)) (list 0 1 2))
(kmc-test "m-eval: nested apply"
(kernel-eval
(kernel-parse "(m-eval ($quote (apply + (list 10 20 30))) (get-current-environment))")
(kmc-make-env)) 60)
;; ── operatives delegate to host eval (transparently for the caller) ─
(kmc-test
"m-eval: $if true branch (via delegation)"
(kernel-eval
(kernel-parse "(m-eval ($quote ($if #t 1 2)) (get-current-environment))")
(kmc-make-env))
1)
(kmc-test
"m-eval: $if false branch"
(kernel-eval
(kernel-parse "(m-eval ($quote ($if #f 1 2)) (get-current-environment))")
(kmc-make-env))
2)
;; ── m-eval can call a user-defined lambda ──────────────────────
(kmc-test
"m-eval: user lambda call"
(let
((env (kmc-make-env)))
(kernel-eval (kernel-parse "($define! sq ($lambda (x) (* x x)))") env)
(kernel-eval
(kernel-parse "(m-eval ($quote (sq 7)) (get-current-environment))")
env))
49)
(define kmc-tests-run! (fn () {:total (+ kmc-test-pass kmc-test-fail) :passed kmc-test-pass :failed kmc-test-fail :fails kmc-test-fails}))