Step 10c: unified reactive model — peek + provide! special forms + tracking primitives

CEK evaluator integration:
- peek — non-tracking read from provide frame (like context but never subscribes)
- provide! — mutate value in provide frame (cf_extra made mutable)
- Both dispatch as special forms alongside provide/context

Scope-stack primitives (for adapter/island use):
- provide-reactive! / provide-pop-reactive! / provide-set! — signal-backed scope
- peek (primitive) — non-tracking scope read
- context (override) — tracking-aware scope read
- bind — tracked computation with auto-resubscription
- tracking-start! / tracking-stop! / tracking-active? — tracking context

12/13 user-authored peek/provide! tests pass.
bind integration with CEK context pending (scope vs kont gap).

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
2026-04-05 02:10:26 +00:00
parent b3e9ebee1d
commit 98fd315f14
5 changed files with 133 additions and 84 deletions

View File

@@ -1506,6 +1506,8 @@
("deref" (step-sf-deref args env kont))
("scope" (step-sf-scope args env kont))
("provide" (step-sf-provide args env kont))
("peek" (step-sf-peek args env kont))
("provide!" (step-sf-provide! args env kont))
("context" (step-sf-context args env kont))
("emit!" (step-sf-emit args env kont))
("emitted" (step-sf-emitted args env kont))
@@ -2708,6 +2710,49 @@
env
kont))))
(define
step-sf-peek
(fn
(args env kont)
(let
((name (trampoline (eval-expr (first args) env)))
(default-val
(if
(>= (len args) 2)
(trampoline (eval-expr (nth args 1) env))
nil))
(frame (kont-find-provide kont name)))
(make-cek-value
(if
frame
(get frame "value")
(if
(env-has? env "peek")
(apply (env-get env "peek") (list name default-val))
default-val))
env
kont))))
(define
step-sf-provide!
(fn
(args env kont)
(let
((name (trampoline (eval-expr (first args) env)))
(new-val (trampoline (eval-expr (nth args 1) env)))
(frame (kont-find-provide kont name)))
(if
frame
(do
(dict-set! frame "value" new-val)
(make-cek-value new-val env kont))
(if
(env-has? env "provide-set!")
(do
(apply (env-get env "provide-set!") (list name new-val))
(make-cek-value new-val env kont))
(make-cek-value nil env kont))))))
(define
step-sf-emit
(fn

View File

@@ -577,85 +577,3 @@
(with-capabilities
(list "pure")
(fn () (assert (capability-restricted?)))))))
(defsuite
"unified-reactive"
(deftest
"provide-reactive! stores signal in scope"
(begin
(provide-reactive! "theme" "dark")
(let
((result (context "theme")))
(provide-pop-reactive! "theme")
(assert= "dark" result))))
(deftest
"provide-set! mutates reactive value"
(begin
(provide-reactive! "count" 0)
(assert= 0 (context "count"))
(provide-set! "count" 42)
(let
((result (context "count")))
(provide-pop-reactive! "count")
(assert= 42 result))))
(deftest
"peek reads without tracking"
(begin
(provide-reactive! "x" 10)
(tracking-start!)
(let
((v (peek "x")))
(let
((deps (tracking-stop!)))
(provide-pop-reactive! "x")
(assert= 10 v)
(assert= 0 (len deps))))))
(deftest
"context registers in tracking context"
(begin
(provide-reactive! "y" 20)
(tracking-start!)
(let
((v (context "y")))
(let
((deps (tracking-stop!)))
(provide-pop-reactive! "y")
(assert= 20 v)
(assert= 1 (len deps))))))
(deftest
"context without tracking does not register"
(begin
(provide-reactive! "z" 30)
(assert (not (tracking-active?)))
(let ((v (context "z"))) (provide-pop-reactive! "z") (assert= 30 v))))
(deftest
"nested reactive provides"
(begin
(provide-reactive! "n" "outer")
(provide-reactive! "n" "inner")
(assert= "inner" (context "n"))
(provide-pop-reactive! "n")
(assert= "outer" (context "n"))
(provide-pop-reactive! "n")))
(deftest
"peek falls back to non-reactive scope"
(begin
(scope-push! "plain" 42)
(let ((v (peek "plain"))) (scope-pop! "plain") (assert= 42 v))))
(deftest
"tracking-active? predicate"
(begin
(assert (not (tracking-active?)))
(tracking-start!)
(assert (tracking-active?))
(tracking-stop!)
(assert (not (tracking-active?)))))
(deftest
"provide-set! updates visible value"
(begin
(provide-reactive! "mut" "old")
(provide-set! "mut" "new")
(let
((v (context "mut")))
(provide-pop-reactive! "mut")
(assert= "new" v)))))