kernel: Phase 5 encapsulations + promise demo + 19 tests [nothing]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 30s

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.
This commit is contained in:
2026-05-11 20:54:31 +00:00
parent b91d8cf72e
commit 45789520ce
3 changed files with 254 additions and 2 deletions

View File

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