kernel: Phase 5 encapsulations + promise demo + 19 tests [nothing]

make-encapsulation-type returns (encapsulator predicate decapsulator).
Fresh empty dict per call as family identity — SX dict reference
equality gives unique per-family opacity. Encap/decap/pred close over
the family marker; foreign values fail both predicate and decap.
Classic promise demo: (force (delay (lambda () (+ 19 23)))) → 42.

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)))

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}))