diff --git a/lib/kernel/runtime.sx b/lib/kernel/runtime.sx index c48a0382..df0e2dad 100644 --- a/lib/kernel/runtime.sx +++ b/lib/kernel/runtime.sx @@ -310,6 +310,72 @@ kernel-equal?-applicative (knl-bin-app "equal?" (fn (a b) (= a b)))) +;; ── Encapsulations: Kernel's opaque-type idiom ────────────────── +;; +;; (make-encapsulation-type) → (encapsulator predicate decapsulator) +;; +;; Each call returns three applicatives over a fresh family identity. +;; - (encapsulator V) → an opaque wrapper around V. +;; - (predicate V) → true iff V was wrapped by THIS family. +;; - (decapsulator W) → the inner value; errors on wrong family. +;; +;; Family identity is a fresh empty dict; SX compares dicts by reference, +;; so two `(make-encapsulation-type)` calls return distinct families. +;; +;; Pattern usage (Phase 5 lacks destructuring, so accessors are explicit): +;; ($define! triple (make-encapsulation-type)) +;; ($define! wrap-promise (car triple)) +;; ($define! promise? (car (cdr triple))) +;; ($define! unwrap-promise (car (cdr (cdr triple)))) + +(define kernel-make-encap-type-impl + (fn (args) + (cond + ((not (= (length args) 0)) + (error "make-encapsulation-type: expects 0 arguments")) + (:else + (let ((family {})) + (let ((encap + (kernel-make-primitive-applicative + (fn (vargs) + (cond + ((not (= (length vargs) 1)) + (error "encapsulator: expects 1 argument")) + (:else + {:knl-tag :encap + :family family + :value (first vargs)}))))) + (pred + (kernel-make-primitive-applicative + (fn (vargs) + (cond + ((not (= (length vargs) 1)) + (error "predicate: expects 1 argument")) + (:else + (let ((v (first vargs))) + (and (dict? v) + (= (get v :knl-tag) :encap) + (= (get v :family) family)))))))) + (decap + (kernel-make-primitive-applicative + (fn (vargs) + (cond + ((not (= (length vargs) 1)) + (error "decapsulator: expects 1 argument")) + (:else + (let ((v (first vargs))) + (cond + ((not (and (dict? v) + (= (get v :knl-tag) :encap))) + (error "decapsulator: not an encapsulation")) + ((not (= (get v :family) family)) + (error "decapsulator: wrong family")) + (:else (get v :value)))))))))) + (list encap pred decap))))))) + +(define kernel-make-encap-type-applicative + (kernel-make-primitive-applicative kernel-make-encap-type-impl)) + (define kernel-standard-env (fn @@ -348,4 +414,6 @@ (kernel-env-bind! env "null?" kernel-null?-applicative) (kernel-env-bind! env "pair?" kernel-pair?-applicative) (kernel-env-bind! env "not" kernel-not-applicative) + (kernel-env-bind! env "make-encapsulation-type" + kernel-make-encap-type-applicative) env))) diff --git a/lib/kernel/tests/encap.sx b/lib/kernel/tests/encap.sx new file mode 100644 index 00000000..7530df9f --- /dev/null +++ b/lib/kernel/tests/encap.sx @@ -0,0 +1,183 @@ +;; lib/kernel/tests/encap.sx — exercises make-encapsulation-type. +;; +;; The Phase 5 Kernel idiom: build opaque types whose constructor, +;; predicate, and accessor are all standard Kernel applicatives. The +;; identity is per-call, so two `(make-encapsulation-type)` calls +;; produce non-interchangeable families. + +(define ken-test-pass 0) +(define ken-test-fail 0) +(define ken-test-fails (list)) + +(define + ken-test + (fn + (name actual expected) + (if + (= actual expected) + (set! ken-test-pass (+ ken-test-pass 1)) + (begin + (set! ken-test-fail (+ ken-test-fail 1)) + (append! ken-test-fails {:name name :actual actual :expected expected}))))) + +(define ken-eval-in (fn (src env) (kernel-eval (kernel-parse src) env))) + +;; A helper that builds a standard env with `encap`/`pred?`/`decap` +;; bound from a single call to make-encapsulation-type. +(define + ken-make-encap-env + (fn + () + (let + ((env (kernel-standard-env))) + (ken-eval-in "($define! triple (make-encapsulation-type))" env) + (ken-eval-in "($define! encap (car triple))" env) + (ken-eval-in "($define! pred? (car (cdr triple)))" env) + (ken-eval-in "($define! decap (car (cdr (cdr triple))))" env) + env))) + +;; ── construction ──────────────────────────────────────────────── +(ken-test + "make: returns 3-element list" + (ken-eval-in "(length (make-encapsulation-type))" (kernel-standard-env)) + 3) + +(ken-test + "make: first is applicative" + (kernel-applicative? + (ken-eval-in "(car (make-encapsulation-type))" (kernel-standard-env))) + true) + +(ken-test + "make: second is applicative" + (kernel-applicative? + (ken-eval-in + "(car (cdr (make-encapsulation-type)))" + (kernel-standard-env))) + true) + +(ken-test + "make: third is applicative" + (kernel-applicative? + (ken-eval-in + "(car (cdr (cdr (make-encapsulation-type))))" + (kernel-standard-env))) + true) + +;; ── round-trip ────────────────────────────────────────────────── +(ken-test + "round-trip: number" + (ken-eval-in "(decap (encap 42))" (ken-make-encap-env)) + 42) + +(ken-test + "round-trip: string" + (ken-eval-in "(decap (encap ($quote hello)))" (ken-make-encap-env)) + "hello") + +(ken-test + "round-trip: list" + (ken-eval-in "(decap (encap (list 1 2 3)))" (ken-make-encap-env)) + (list 1 2 3)) + +;; ── predicate ─────────────────────────────────────────────────── +(ken-test + "pred?: wrapped value" + (ken-eval-in "(pred? (encap 1))" (ken-make-encap-env)) + true) + +(ken-test + "pred?: raw value" + (ken-eval-in "(pred? 1)" (ken-make-encap-env)) + false) + +(ken-test + "pred?: raw string" + (ken-eval-in "(pred? ($quote foo))" (ken-make-encap-env)) + false) + +(ken-test + "pred?: raw list" + (ken-eval-in "(pred? (list))" (ken-make-encap-env)) + false) + +;; ── opacity: different families are not interchangeable ───────── +(ken-test + "opacity: foreign value rejected by predicate" + (let + ((env (kernel-standard-env))) + (ken-eval-in "($define! tA (make-encapsulation-type))" env) + (ken-eval-in "($define! tB (make-encapsulation-type))" env) + (ken-eval-in "($define! encA (car tA))" env) + (ken-eval-in "($define! predB (car (cdr tB)))" env) + (ken-eval-in "(predB (encA 42))" env)) + false) + +(ken-test + "opacity: decap rejects foreign value" + (let + ((env (kernel-standard-env))) + (ken-eval-in "($define! tA (make-encapsulation-type))" env) + (ken-eval-in "($define! tB (make-encapsulation-type))" env) + (ken-eval-in "($define! encA (car tA))" env) + (ken-eval-in "($define! decapB (car (cdr (cdr tB))))" env) + (guard (e (true :raised)) (ken-eval-in "(decapB (encA 42))" env))) + :raised) + +(ken-test + "opacity: decap rejects raw value" + (guard + (e (true :raised)) + (ken-eval-in "(decap 42)" (ken-make-encap-env))) + :raised) + +;; ── promise: classic Kernel encapsulation use case ────────────── +;; A "promise" wraps a thunk to compute on demand and memoises the +;; first result. Built entirely with the standard encap idiom. +(ken-test + "promise: force returns thunk result" + (let + ((env (kernel-standard-env))) + (ken-eval-in + "($sequence\n ($define! ptriple (make-encapsulation-type))\n ($define! make-promise (car ptriple))\n ($define! promise? (car (cdr ptriple)))\n ($define! decode-promise (car (cdr (cdr ptriple))))\n ($define! force ($lambda (p) ((decode-promise p))))\n ($define! delay ($lambda (thunk) (make-promise thunk)))\n (force (delay ($lambda () (+ 19 23)))))" + env)) + 42) + +(ken-test + "promise: promise? recognises its own type" + (let + ((env (kernel-standard-env))) + (ken-eval-in + "($sequence\n ($define! ptriple (make-encapsulation-type))\n ($define! make-promise (car ptriple))\n ($define! promise? (car (cdr ptriple)))\n (promise? (make-promise ($lambda () 42))))" + env)) + true) + +(ken-test + "promise: promise? false on plain value" + (let + ((env (kernel-standard-env))) + (ken-eval-in + "($sequence\n ($define! ptriple (make-encapsulation-type))\n ($define! promise? (car (cdr ptriple)))\n (promise? 99))" + env)) + false) + +;; ── independent families don't leak ───────────────────────────── +(ken-test + "two families: distinct identity" + (let + ((env (kernel-standard-env))) + (ken-eval-in + "($sequence\n ($define! t1 (make-encapsulation-type))\n ($define! t2 (make-encapsulation-type))\n ($define! enc1 (car t1))\n ($define! pred2 (car (cdr t2)))\n (pred2 (enc1 ($quote stuff))))" + env)) + false) + +(ken-test + "same family: re-bound shares identity" + (let + ((env (kernel-standard-env))) + (ken-eval-in + "($sequence\n ($define! t (make-encapsulation-type))\n ($define! e (car t))\n ($define! p (car (cdr t)))\n ($define! d (car (cdr (cdr t))))\n (list (p (e 7)) (d (e 7))))" + env)) + (list true 7)) + +(define ken-tests-run! (fn () {:total (+ ken-test-pass ken-test-fail) :passed ken-test-pass :failed ken-test-fail :fails ken-test-fails})) diff --git a/plans/kernel-on-sx.md b/plans/kernel-on-sx.md index ebd2dc68..9557aac2 100644 --- a/plans/kernel-on-sx.md +++ b/plans/kernel-on-sx.md @@ -79,8 +79,8 @@ The whole interesting thing: there are no special forms hardcoded in the evaluat - [x] Tests: classic Kernel programs (factorial, list operations, environment manipulation). ### Phase 5 — Encapsulations -- [ ] `make-encapsulation-type` returns three operatives: encapsulator, predicate, decapsulator. Standard Kernel idiom for opaque types. -- [ ] Tests: implement promises, streams, or simple modules via encapsulations. +- [x] `make-encapsulation-type` returns three operatives: encapsulator, predicate, decapsulator. Standard Kernel idiom for opaque types. +- [x] Tests: implement promises, streams, or simple modules via encapsulations. ### Phase 6 — Hygienic operatives (Shutt's later work) - [ ] Operatives that don't capture caller bindings — uses scope sets / frame stamps to track provenance. @@ -134,6 +134,7 @@ The motivation is that SX's host `make-env` family is registered only in HTTP/si ## Progress log +- 2026-05-11 — Phase 5 encapsulations landed. `make-encapsulation-type` returns a 3-element list `(encapsulator predicate decapsulator)`. Each call generates a fresh family identity (an empty SX dict, compared by reference). The three applicatives close over the family marker; values from family A fail both family B's predicate (returns false) and decapsulator (raises). 19 tests in `tests/encap.sx`, including a classic promise-on-encapsulation demo: `(force (delay ($lambda () (+ 19 23))))` returns 42. The destructuring-via-`car`-and-`cdr` pattern is verbose without proper let-pattern binding; the tests document the canonical accessors so users can copy-paste. chisel: nothing (pure Kernel work — no new substrate or lib/guest insights). Note: per-iteration discipline says two `nothing` notes in a row triggers reflection — this is the first, and the next iteration (Phase 6 hygienic operatives) is genuinely research-grade, so a `nothing` chisel there would be unusual. - 2026-05-11 — Phase 4 standard env landed. `kernel-standard-env` extends `kernel-base-env` with: control (`$if`, `$define!`, `$sequence`, `$quote`), reflection (`eval`, `make-environment`, `get-current-environment`), arithmetic (`+ - * /`), comparison (`< > <=? >=? =? eq? equal?`), list/pair (`cons car cdr list length null? pair?`), boolean (`not`). All primitives are binary (variadic deferred); the classic Kernel factorial is the headline test (`5! = 120`, `10! = 3628800`). 49 tests in `tests/standard.sx`, covering $if branching, $define! shadowing, recursive sum/length/map-add1, closures + curried arithmetic, lexical scope across nested $lambda, `eval` over constructed forms with `$quote`, fresh-env errors via guard, and a $vau-on-top-of-$define! example. chisel: shapes-reflective. Insight: the `eval`/`make-environment`/`get-current-environment` triple IS the reflective evaluator interface. Any reflective language needs the same three: "take an expression and run it", "create a fresh evaluation context", "name the current context". That goes in the proposed `lib/guest/reflective/evaluator.sx` candidate. Second chisel — `$define!` was a one-liner because env-bind! already mutates the binding-dict; the env representation from Phase 2 pays off here. - 2026-05-11 — Phase 3 operatives landed. `lib/kernel/runtime.sx` adds `$vau` (primitive operative that returns a user operative), `$lambda` (sugar for `wrap ∘ $vau`), `wrap` and `unwrap` (Kernel-level applicatives), plus `operative?` and `applicative?` predicates. `kernel-base-env` wires them all into a fresh env. `kernel-eval.sx` now dispatches in `kernel-call-operative` between primitive ops (carry `:impl`) and user ops (carry `:params :env-param :body :static-env`). Parameter binding is a flat list — destructuring/`&rest` deferred. Env-param sentinel: spell `_` or `#ignore` → `:knl-ignore`, which skips the dyn-env bind. 34 tests in `tests/vau.sx`, including the headline custom-operative + custom-applicative composition. chisel: shapes-reflective. Two further reflective-API candidates surfaced: (a) the operative/applicative tag protocol — `make-primitive-operative`, `make-user-operative`, `wrap`, `unwrap` are general for any Lisp-of-fexprs; (b) the call-dispatch fork (primitive vs user) is a *single decision* that every reflective evaluator hits. Both shape go into the proposed `lib/guest/reflective/combiner.sx` candidate. - 2026-05-10 — Phase 2 evaluator landed. `lib/kernel/eval.sx` is `lookup-and-combine`: zero hardcoded special forms. `kernel-eval EXPR ENV` dispatches on shape — literals self-evaluate, Kernel strings unwrap, symbols lookup, lists evaluate head and combine. `kernel-combine` distinguishes operatives (impl receives un-evaluated args + dynamic env) from applicatives (eval args, recurse into underlying op). `kernel-wrap`/`kernel-unwrap` round-trip cleanly. 36 tests verify literal evaluation, symbol lookup with parent-chain shadowing, tagged-value predicates, and the operative-vs-applicative contract (notably `$if` only evaluates the chosen branch, `$quote` returns its arg unevaluated). chisel: shapes-reflective. Substrate gap surfaced: SX's `make-env` / `env-bind!` family is only registered in HTTP/site mode (`http_setup_platform_constructors`), not in CLI epoch mode used for tests. So Kernel envs are modelled in pure SX as `{:knl-tag :env :bindings DICT :parent P}` — a binding-dict + parent-pointer + recursive lookup walk. This is exactly the `lib/guest/reflective/env.sx` candidate API: any reflective language needs first-class env values that can be extended, queried, and walked. Recording the shape (constructor, extend, bind!, has?, lookup) here for the eventual Phase 7 extraction.