Files
rose-ash/shared/sx/ref/cek.sx
giles cb4f4b85e5
All checks were successful
Build and Deploy / build-and-deploy (push) Successful in 3m20s
Named freeze scopes for serializable reactive state
Replace raw CEK state serialization with named freeze scopes.
A freeze scope collects signals registered within it. On freeze,
signal values are serialized to SX. On thaw, values are restored.

- freeze-scope: scoped effect delimiter for signal collection
- freeze-signal: register a signal with a name in the current scope
- cek-freeze-scope / cek-thaw-scope: freeze/thaw by scope name
- freeze-to-sx / thaw-from-sx: full SX text round-trip
- cek-freeze-all / cek-thaw-all: batch operations

Also: register boolean?, symbol?, keyword? predicates in both
Python and JS platforms with proper var aliases.

Demo: counter + name input with Freeze/Thaw buttons.
Frozen SX: {:name "demo" :signals {:count 5 :name "world"}}

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
2026-03-14 23:21:38 +00:00

1132 lines
48 KiB
Plaintext

;; ==========================================================================
;; cek.sx — Explicit CEK machine evaluator
;;
;; Replaces the implicit CEK (tree-walk + trampoline) with explicit
;; C/E/K data structures. Each evaluation step is a pure function from
;; state to state. Enables stepping, serialization, migration.
;;
;; The CEK uses the frame types defined in frames.sx.
;; eval-expr remains as the public API — it creates a CEK state and runs.
;;
;; Requires: frames.sx loaded first.
;; ==========================================================================
;; --------------------------------------------------------------------------
;; 1. Run loop — drive the CEK machine to completion
;; --------------------------------------------------------------------------
(define cek-run
(fn (state)
;; Drive the CEK machine until terminal state.
;; Returns the final value.
(if (cek-terminal? state)
(cek-value state)
(cek-run (cek-step state)))))
;; --------------------------------------------------------------------------
;; 2. Step function — single CEK step
;; --------------------------------------------------------------------------
(define cek-step
(fn (state)
(if (= (cek-phase state) "eval")
(step-eval state)
(step-continue state))))
;; --------------------------------------------------------------------------
;; 3. step-eval — Control is an expression, dispatch on type
;; --------------------------------------------------------------------------
(define step-eval
(fn (state)
(let ((expr (cek-control state))
(env (cek-env state))
(kont (cek-kont state)))
(case (type-of expr)
;; --- Literals: immediate value ---
"number" (make-cek-value expr env kont)
"string" (make-cek-value expr env kont)
"boolean" (make-cek-value expr env kont)
"nil" (make-cek-value nil env kont)
;; --- Symbol lookup ---
"symbol"
(let ((name (symbol-name expr)))
(let ((val (cond
(env-has? env name) (env-get env name)
(primitive? name) (get-primitive name)
(= name "true") true
(= name "false") false
(= name "nil") nil
:else (error (str "Undefined symbol: " name)))))
(make-cek-value val env kont)))
;; --- Keyword → string ---
"keyword" (make-cek-value (keyword-name expr) env kont)
;; --- Dict literal: evaluate values ---
"dict"
(let ((ks (keys expr)))
(if (empty? ks)
(make-cek-value (dict) env kont)
;; Build entry pairs from dict, evaluate first value
(let ((first-key (first ks))
(remaining-entries (list)))
(for-each (fn (k) (append! remaining-entries (list k (get expr k))))
(rest ks))
(make-cek-state
(get expr first-key)
env
(kont-push
(make-dict-frame
remaining-entries
(list (list first-key)) ;; results: list of (key) waiting for val
env)
kont)))))
;; --- List = call or special form ---
"list"
(if (empty? expr)
(make-cek-value (list) env kont)
(step-eval-list expr env kont))
;; --- Anything else passes through ---
:else (make-cek-value expr env kont)))))
;; --------------------------------------------------------------------------
;; 4. step-eval-list — Dispatch on list head
;; --------------------------------------------------------------------------
(define step-eval-list
(fn (expr env kont)
(let ((head (first expr))
(args (rest expr)))
;; If head isn't symbol/lambda/list → treat as data list
(if (not (or (= (type-of head) "symbol")
(= (type-of head) "lambda")
(= (type-of head) "list")))
;; Evaluate as data list — evaluate each element
(if (empty? expr)
(make-cek-value (list) env kont)
(make-cek-state
(first expr) env
(kont-push (make-map-frame nil (rest expr) (list) env) kont)))
;; Head is symbol — check special forms
(if (= (type-of head) "symbol")
(let ((name (symbol-name head)))
(cond
;; --- Special forms → push appropriate frame ---
(= name "if") (step-sf-if args env kont)
(= name "when") (step-sf-when args env kont)
(= name "cond") (step-sf-cond args env kont)
(= name "case") (step-sf-case args env kont)
(= name "and") (step-sf-and args env kont)
(= name "or") (step-sf-or args env kont)
(= name "let") (step-sf-let args env kont)
(= name "let*") (step-sf-let args env kont)
(= name "lambda") (step-sf-lambda args env kont)
(= name "fn") (step-sf-lambda args env kont)
(= name "define") (step-sf-define args env kont)
(= name "defcomp") (make-cek-value (sf-defcomp args env) env kont)
(= name "defisland") (make-cek-value (sf-defisland args env) env kont)
(= name "defmacro") (make-cek-value (sf-defmacro args env) env kont)
(= name "defstyle") (make-cek-value (sf-defstyle args env) env kont)
(= name "defhandler") (make-cek-value (sf-defhandler args env) env kont)
(= name "defpage") (make-cek-value (sf-defpage args env) env kont)
(= name "defquery") (make-cek-value (sf-defquery args env) env kont)
(= name "defaction") (make-cek-value (sf-defaction args env) env kont)
(= name "deftype") (make-cek-value (sf-deftype args env) env kont)
(= name "defeffect") (make-cek-value (sf-defeffect args env) env kont)
(= name "begin") (step-sf-begin args env kont)
(= name "do") (step-sf-begin args env kont)
(= name "quote") (make-cek-value (if (empty? args) nil (first args)) env kont)
(= name "quasiquote") (make-cek-value (qq-expand (first args) env) env kont)
(= name "->") (step-sf-thread-first args env kont)
(= name "set!") (step-sf-set! args env kont)
(= name "letrec") (make-cek-value (sf-letrec args env) env kont)
;; Continuations — native in CEK
(= name "reset") (step-sf-reset args env kont)
(= name "shift") (step-sf-shift args env kont)
;; Reactive deref-as-shift
(= name "deref") (step-sf-deref args env kont)
;; Scoped effects
(= name "scope") (step-sf-scope args env kont)
(= name "provide") (step-sf-provide args env kont)
;; Dynamic wind
(= name "dynamic-wind") (make-cek-value (sf-dynamic-wind args env) env kont)
;; Higher-order forms
(= name "map") (step-ho-map args env kont)
(= name "map-indexed") (step-ho-map-indexed args env kont)
(= name "filter") (step-ho-filter args env kont)
(= name "reduce") (step-ho-reduce args env kont)
(= name "some") (step-ho-some args env kont)
(= name "every?") (step-ho-every args env kont)
(= name "for-each") (step-ho-for-each args env kont)
;; Macro expansion
(and (env-has? env name) (macro? (env-get env name)))
(let ((mac (env-get env name)))
(make-cek-state (expand-macro mac args env) env kont))
;; Render expression
(and (render-active?) (is-render-expr? expr))
(make-cek-value (render-expr expr env) env kont)
;; Fall through to function call
:else (step-eval-call head args env kont)))
;; Head is lambda or list — function call
(step-eval-call head args env kont))))))
;; --------------------------------------------------------------------------
;; 5. Special form step handlers
;; --------------------------------------------------------------------------
;; if: evaluate condition, push IfFrame
(define step-sf-if
(fn (args env kont)
(make-cek-state
(first args) env
(kont-push
(make-if-frame (nth args 1)
(if (> (len args) 2) (nth args 2) nil)
env)
kont))))
;; when: evaluate condition, push WhenFrame
(define step-sf-when
(fn (args env kont)
(make-cek-state
(first args) env
(kont-push (make-when-frame (rest args) env) kont))))
;; begin/do: evaluate first expr, push BeginFrame for rest
(define step-sf-begin
(fn (args env kont)
(if (empty? args)
(make-cek-value nil env kont)
(if (= (len args) 1)
(make-cek-state (first args) env kont)
(make-cek-state
(first args) env
(kont-push (make-begin-frame (rest args) env) kont))))))
;; let: start evaluating bindings
(define step-sf-let
(fn (args env kont)
;; Detect named let
(if (= (type-of (first args)) "symbol")
;; Named let — delegate to existing handler (complex desugaring)
(make-cek-value (sf-named-let args env) env kont)
(let ((bindings (first args))
(body (rest args))
(local (env-extend env)))
;; Parse first binding
(if (empty? bindings)
;; No bindings — evaluate body
(step-sf-begin body local kont)
;; Start evaluating first binding value
(let ((first-binding (if (and (= (type-of (first bindings)) "list")
(= (len (first bindings)) 2))
;; Scheme-style: ((name val) ...)
(first bindings)
;; Clojure-style: (name val ...) → synthesize pair
(list (first bindings) (nth bindings 1))))
(rest-bindings (if (and (= (type-of (first bindings)) "list")
(= (len (first bindings)) 2))
(rest bindings)
;; Clojure-style: skip 2 elements
(let ((pairs (list)))
(reduce
(fn (acc i)
(append! pairs (list (nth bindings (* i 2))
(nth bindings (inc (* i 2))))))
nil
(range 1 (/ (len bindings) 2)))
pairs))))
(let ((vname (if (= (type-of (first first-binding)) "symbol")
(symbol-name (first first-binding))
(first first-binding))))
(make-cek-state
(nth first-binding 1) local
(kont-push
(make-let-frame vname rest-bindings body local)
kont)))))))))
;; define: evaluate value expression
(define step-sf-define
(fn (args env kont)
(let ((name-sym (first args))
(has-effects (and (>= (len args) 4)
(= (type-of (nth args 1)) "keyword")
(= (keyword-name (nth args 1)) "effects")))
(val-idx (if (and (>= (len args) 4)
(= (type-of (nth args 1)) "keyword")
(= (keyword-name (nth args 1)) "effects"))
3 1))
(effect-list (if (and (>= (len args) 4)
(= (type-of (nth args 1)) "keyword")
(= (keyword-name (nth args 1)) "effects"))
(nth args 2) nil)))
(make-cek-state
(nth args val-idx) env
(kont-push
(make-define-frame (symbol-name name-sym) env has-effects effect-list)
kont)))))
;; set!: evaluate value
(define step-sf-set!
(fn (args env kont)
(make-cek-state
(nth args 1) env
(kont-push (make-set-frame (symbol-name (first args)) env) kont))))
;; and: evaluate first, push AndFrame
(define step-sf-and
(fn (args env kont)
(if (empty? args)
(make-cek-value true env kont)
(make-cek-state
(first args) env
(kont-push (make-and-frame (rest args) env) kont)))))
;; or: evaluate first, push OrFrame
(define step-sf-or
(fn (args env kont)
(if (empty? args)
(make-cek-value false env kont)
(make-cek-state
(first args) env
(kont-push (make-or-frame (rest args) env) kont)))))
;; cond: evaluate first test, push CondFrame
(define step-sf-cond
(fn (args env kont)
(let ((scheme? (cond-scheme? args)))
(if scheme?
;; Scheme-style: ((test body) ...)
(if (empty? args)
(make-cek-value nil env kont)
(let ((clause (first args))
(test (first clause)))
;; Check for :else / else
(if (or (and (= (type-of test) "symbol")
(or (= (symbol-name test) "else")
(= (symbol-name test) ":else")))
(and (= (type-of test) "keyword")
(= (keyword-name test) "else")))
(make-cek-state (nth clause 1) env kont)
(make-cek-state
test env
(kont-push (make-cond-frame args env true) kont)))))
;; Clojure-style: test body test body ...
(if (< (len args) 2)
(make-cek-value nil env kont)
(let ((test (first args)))
(if (or (and (= (type-of test) "keyword") (= (keyword-name test) "else"))
(and (= (type-of test) "symbol")
(or (= (symbol-name test) "else")
(= (symbol-name test) ":else"))))
(make-cek-state (nth args 1) env kont)
(make-cek-state
test env
(kont-push (make-cond-frame args env false) kont)))))))))
;; case: evaluate match value
(define step-sf-case
(fn (args env kont)
(make-cek-state
(first args) env
(kont-push (make-case-frame nil (rest args) env) kont))))
;; thread-first: evaluate initial value
(define step-sf-thread-first
(fn (args env kont)
(make-cek-state
(first args) env
(kont-push (make-thread-frame (rest args) env) kont))))
;; lambda/fn: immediate — create lambda value
(define step-sf-lambda
(fn (args env kont)
(make-cek-value (sf-lambda args env) env kont)))
;; scope: evaluate name, then push ScopeFrame
(define step-sf-scope
(fn (args env kont)
;; Delegate to existing sf-scope for now — scope involves mutation
(make-cek-value (sf-scope args env) env kont)))
;; provide: delegate to existing handler
(define step-sf-provide
(fn (args env kont)
(make-cek-value (sf-provide args env) env kont)))
;; reset: push ResetFrame, evaluate body
(define step-sf-reset
(fn (args env kont)
(make-cek-state
(first args) env
(kont-push (make-reset-frame env) kont))))
;; shift: capture frames to nearest reset
(define step-sf-shift
(fn (args env kont)
(let ((k-name (symbol-name (first args)))
(body (nth args 1))
(captured-result (kont-capture-to-reset kont))
(captured (first captured-result))
(rest-kont (nth captured-result 1)))
;; Store captured frames as a dict on the continuation value.
;; When the continuation is invoked, continue-with-call detects
;; the cek-frames key and restores them.
(let ((k (make-cek-continuation captured rest-kont)))
;; Evaluate shift body with k bound, continuation goes to rest-kont
(let ((shift-env (env-extend env)))
(env-set! shift-env k-name k)
(make-cek-state body shift-env rest-kont))))))
;; deref: evaluate argument, push DerefFrame
(define step-sf-deref
(fn (args env kont)
(make-cek-state
(first args) env
(kont-push (make-deref-frame env) kont))))
;; cek-call — call a function via CEK (replaces invoke)
(define cek-call
(fn (f args)
(let ((a (if (nil? args) (list) args)))
(cond
(nil? f) nil
(lambda? f) (cek-run (continue-with-call f a (dict) a (list)))
(callable? f) (apply f a)
:else nil))))
;; reactive-shift-deref: the heart of deref-as-shift
;; When deref encounters a signal inside a reactive-reset boundary,
;; capture the continuation up to the reactive-reset as the subscriber.
(define reactive-shift-deref
(fn (sig env kont)
(let ((scan-result (kont-capture-to-reactive-reset kont))
(captured-frames (first scan-result))
(reset-frame (nth scan-result 1))
(remaining-kont (nth scan-result 2))
(update-fn (get reset-frame "update-fn")))
;; Sub-scope for nested subscriber cleanup on re-invocation
(let ((sub-disposers (list)))
(let ((subscriber
(fn ()
;; Dispose previous nested subscribers
(for-each (fn (d) (cek-call d nil)) sub-disposers)
(set! sub-disposers (list))
;; Re-invoke: push fresh ReactiveResetFrame (first-render=false)
(let ((new-reset (make-reactive-reset-frame env update-fn false))
(new-kont (concat captured-frames
(list new-reset)
remaining-kont)))
(with-island-scope
(fn (d) (append! sub-disposers d))
(fn ()
(cek-run
(make-cek-value (signal-value sig) env new-kont))))))))
;; Register subscriber
(signal-add-sub! sig subscriber)
;; Register cleanup with island scope
(register-in-scope
(fn ()
(signal-remove-sub! sig subscriber)
(for-each (fn (d) (cek-call d nil)) sub-disposers)))
;; Initial render: value flows through captured frames + reset (first-render=true)
;; so the full expression completes normally
(let ((initial-kont (concat captured-frames
(list reset-frame)
remaining-kont)))
(make-cek-value (signal-value sig) env initial-kont)))))))
;; --------------------------------------------------------------------------
;; 6. Function call step handler
;; --------------------------------------------------------------------------
(define step-eval-call
(fn (head args env kont)
;; First evaluate the head, then evaluate args left-to-right
(make-cek-state
head env
(kont-push
(make-arg-frame nil (list) args env args)
kont))))
;; --------------------------------------------------------------------------
;; 7. Higher-order form step handlers
;; --------------------------------------------------------------------------
;; CEK-native higher-order forms — each callback invocation goes through
;; continue-with-call so deref-as-shift works inside callbacks.
;; Function and collection args are evaluated via tree-walk (simple exprs),
;; then the loop is driven by CEK frames.
(define step-ho-map
(fn (args env kont)
(let ((f (trampoline (eval-expr (first args) env)))
(coll (trampoline (eval-expr (nth args 1) env))))
(if (empty? coll)
(make-cek-value (list) env kont)
(continue-with-call f (list (first coll)) env (list)
(kont-push (make-map-frame f (rest coll) (list) env) kont))))))
(define step-ho-map-indexed
(fn (args env kont)
(let ((f (trampoline (eval-expr (first args) env)))
(coll (trampoline (eval-expr (nth args 1) env))))
(if (empty? coll)
(make-cek-value (list) env kont)
(continue-with-call f (list 0 (first coll)) env (list)
(kont-push (make-map-indexed-frame f (rest coll) (list) env) kont))))))
(define step-ho-filter
(fn (args env kont)
(let ((f (trampoline (eval-expr (first args) env)))
(coll (trampoline (eval-expr (nth args 1) env))))
(if (empty? coll)
(make-cek-value (list) env kont)
(continue-with-call f (list (first coll)) env (list)
(kont-push (make-filter-frame f (rest coll) (list) (first coll) env) kont))))))
(define step-ho-reduce
(fn (args env kont)
(let ((f (trampoline (eval-expr (first args) env)))
(init (trampoline (eval-expr (nth args 1) env)))
(coll (trampoline (eval-expr (nth args 2) env))))
(if (empty? coll)
(make-cek-value init env kont)
(continue-with-call f (list init (first coll)) env (list)
(kont-push (make-reduce-frame f (rest coll) env) kont))))))
(define step-ho-some
(fn (args env kont)
(let ((f (trampoline (eval-expr (first args) env)))
(coll (trampoline (eval-expr (nth args 1) env))))
(if (empty? coll)
(make-cek-value false env kont)
(continue-with-call f (list (first coll)) env (list)
(kont-push (make-some-frame f (rest coll) env) kont))))))
(define step-ho-every
(fn (args env kont)
(let ((f (trampoline (eval-expr (first args) env)))
(coll (trampoline (eval-expr (nth args 1) env))))
(if (empty? coll)
(make-cek-value true env kont)
(continue-with-call f (list (first coll)) env (list)
(kont-push (make-every-frame f (rest coll) env) kont))))))
(define step-ho-for-each
(fn (args env kont)
(let ((f (trampoline (eval-expr (first args) env)))
(coll (trampoline (eval-expr (nth args 1) env))))
(if (empty? coll)
(make-cek-value nil env kont)
(continue-with-call f (list (first coll)) env (list)
(kont-push (make-for-each-frame f (rest coll) env) kont))))))
;; --------------------------------------------------------------------------
;; 8. step-continue — Value produced, dispatch on top frame
;; --------------------------------------------------------------------------
(define step-continue
(fn (state)
(let ((value (cek-value state))
(env (cek-env state))
(kont (cek-kont state)))
(if (kont-empty? kont)
state ;; Terminal — return as-is
(let ((frame (kont-top kont))
(rest-k (kont-pop kont))
(ft (frame-type frame)))
(cond
;; --- IfFrame: condition evaluated ---
(= ft "if")
(if (and value (not (nil? value)))
(make-cek-state (get frame "then") (get frame "env") rest-k)
(if (nil? (get frame "else"))
(make-cek-value nil env rest-k)
(make-cek-state (get frame "else") (get frame "env") rest-k)))
;; --- WhenFrame: condition evaluated ---
(= ft "when")
(if (and value (not (nil? value)))
(let ((body (get frame "body"))
(fenv (get frame "env")))
(if (empty? body)
(make-cek-value nil fenv rest-k)
(if (= (len body) 1)
(make-cek-state (first body) fenv rest-k)
(make-cek-state
(first body) fenv
(kont-push (make-begin-frame (rest body) fenv) rest-k)))))
(make-cek-value nil env rest-k))
;; --- BeginFrame: expression evaluated, continue with next ---
(= ft "begin")
(let ((remaining (get frame "remaining"))
(fenv (get frame "env")))
(if (empty? remaining)
(make-cek-value value fenv rest-k)
(if (= (len remaining) 1)
(make-cek-state (first remaining) fenv rest-k)
(make-cek-state
(first remaining) fenv
(kont-push (make-begin-frame (rest remaining) fenv) rest-k)))))
;; --- LetFrame: binding value evaluated ---
(= ft "let")
(let ((name (get frame "name"))
(remaining (get frame "remaining"))
(body (get frame "body"))
(local (get frame "env")))
;; Bind the value
(env-set! local name value)
;; More bindings?
(if (empty? remaining)
;; All bindings done — evaluate body
(step-sf-begin body local rest-k)
;; Next binding
(let ((next-binding (first remaining))
(vname (if (= (type-of (first next-binding)) "symbol")
(symbol-name (first next-binding))
(first next-binding))))
(make-cek-state
(nth next-binding 1) local
(kont-push
(make-let-frame vname (rest remaining) body local)
rest-k)))))
;; --- DefineFrame: value evaluated ---
(= ft "define")
(let ((name (get frame "name"))
(fenv (get frame "env"))
(has-effects (get frame "has-effects"))
(effect-list (get frame "effect-list")))
(when (and (lambda? value) (nil? (lambda-name value)))
(set-lambda-name! value name))
(env-set! fenv name value)
;; Effect annotation
(when has-effects
(let ((effect-names (if (= (type-of effect-list) "list")
(map (fn (e) (if (= (type-of e) "symbol")
(symbol-name e) (str e)))
effect-list)
(list (str effect-list))))
(effect-anns (if (env-has? fenv "*effect-annotations*")
(env-get fenv "*effect-annotations*")
(dict))))
(dict-set! effect-anns name effect-names)
(env-set! fenv "*effect-annotations*" effect-anns)))
(make-cek-value value fenv rest-k))
;; --- SetFrame: value evaluated ---
(= ft "set")
(let ((name (get frame "name"))
(fenv (get frame "env")))
(env-set! fenv name value)
(make-cek-value value env rest-k))
;; --- AndFrame: value evaluated ---
(= ft "and")
(if (not value)
(make-cek-value value env rest-k)
(let ((remaining (get frame "remaining")))
(if (empty? remaining)
(make-cek-value value env rest-k)
(make-cek-state
(first remaining) (get frame "env")
(if (= (len remaining) 1)
rest-k
(kont-push (make-and-frame (rest remaining) (get frame "env")) rest-k))))))
;; --- OrFrame: value evaluated ---
(= ft "or")
(if value
(make-cek-value value env rest-k)
(let ((remaining (get frame "remaining")))
(if (empty? remaining)
(make-cek-value false env rest-k)
(make-cek-state
(first remaining) (get frame "env")
(if (= (len remaining) 1)
rest-k
(kont-push (make-or-frame (rest remaining) (get frame "env")) rest-k))))))
;; --- CondFrame: test evaluated ---
(= ft "cond")
(let ((remaining (get frame "remaining"))
(fenv (get frame "env"))
(scheme? (get frame "scheme")))
(if scheme?
;; Scheme-style: test truthy → evaluate body
(if value
(make-cek-state (nth (first remaining) 1) fenv rest-k)
;; Next clause
(let ((next-clauses (rest remaining)))
(if (empty? next-clauses)
(make-cek-value nil fenv rest-k)
(let ((next-clause (first next-clauses))
(next-test (first next-clause)))
(if (or (and (= (type-of next-test) "symbol")
(or (= (symbol-name next-test) "else")
(= (symbol-name next-test) ":else")))
(and (= (type-of next-test) "keyword")
(= (keyword-name next-test) "else")))
(make-cek-state (nth next-clause 1) fenv rest-k)
(make-cek-state
next-test fenv
(kont-push (make-cond-frame next-clauses fenv true) rest-k)))))))
;; Clojure-style
(if value
(make-cek-state (nth remaining 1) fenv rest-k)
(let ((next (slice remaining 2)))
(if (< (len next) 2)
(make-cek-value nil fenv rest-k)
(let ((next-test (first next)))
(if (or (and (= (type-of next-test) "keyword") (= (keyword-name next-test) "else"))
(and (= (type-of next-test) "symbol")
(or (= (symbol-name next-test) "else")
(= (symbol-name next-test) ":else"))))
(make-cek-state (nth next 1) fenv rest-k)
(make-cek-state
next-test fenv
(kont-push (make-cond-frame next fenv false) rest-k)))))))))
;; --- CaseFrame ---
(= ft "case")
(let ((match-val (get frame "match-val"))
(remaining (get frame "remaining"))
(fenv (get frame "env")))
(if (nil? match-val)
;; First step: match-val just evaluated
(sf-case-step-loop value remaining fenv rest-k)
;; Subsequent: test clause evaluated
(sf-case-step-loop match-val remaining fenv rest-k)))
;; --- ThreadFirstFrame ---
(= ft "thread")
(let ((remaining (get frame "remaining"))
(fenv (get frame "env")))
(if (empty? remaining)
(make-cek-value value fenv rest-k)
;; Apply next form to value
(let ((form (first remaining))
(rest-forms (rest remaining)))
(let ((result (if (= (type-of form) "list")
(let ((f (trampoline (eval-expr (first form) fenv)))
(rargs (map (fn (a) (trampoline (eval-expr a fenv))) (rest form)))
(all-args (cons value rargs)))
(cond
(and (callable? f) (not (lambda? f))) (apply f all-args)
(lambda? f) (trampoline (call-lambda f all-args fenv))
:else (error (str "-> form not callable: " (inspect f)))))
(let ((f (trampoline (eval-expr form fenv))))
(cond
(and (callable? f) (not (lambda? f))) (f value)
(lambda? f) (trampoline (call-lambda f (list value) fenv))
:else (error (str "-> form not callable: " (inspect f))))))))
(if (empty? rest-forms)
(make-cek-value result fenv rest-k)
(make-cek-value result fenv
(kont-push (make-thread-frame rest-forms fenv) rest-k)))))))
;; --- ArgFrame: head or arg evaluated ---
(= ft "arg")
(let ((f (get frame "f"))
(evaled (get frame "evaled"))
(remaining (get frame "remaining"))
(fenv (get frame "env"))
(raw-args (get frame "raw-args")))
(if (nil? f)
;; Head just evaluated — value is the function
(if (empty? remaining)
;; No args — call immediately
(continue-with-call value (list) fenv raw-args rest-k)
;; Start evaluating args
(make-cek-state
(first remaining) fenv
(kont-push
(make-arg-frame value (list) (rest remaining) fenv raw-args)
rest-k)))
;; An arg was evaluated — accumulate
(let ((new-evaled (append evaled (list value))))
(if (empty? remaining)
;; All args evaluated — call
(continue-with-call f new-evaled fenv raw-args rest-k)
;; Next arg
(make-cek-state
(first remaining) fenv
(kont-push
(make-arg-frame f new-evaled (rest remaining) fenv raw-args)
rest-k))))))
;; --- DictFrame: value evaluated ---
(= ft "dict")
(let ((remaining (get frame "remaining"))
(results (get frame "results"))
(fenv (get frame "env")))
;; Last result entry is (key) — append value to make (key val)
(let ((last-result (last results))
(completed (append (slice results 0 (dec (len results)))
(list (list (first last-result) value)))))
(if (empty? remaining)
;; All done — build dict
(let ((d (dict)))
(for-each
(fn (pair) (dict-set! d (first pair) (nth pair 1)))
completed)
(make-cek-value d fenv rest-k))
;; Next entry
(let ((next-entry (first remaining)))
(make-cek-state
(nth next-entry 1) fenv
(kont-push
(make-dict-frame
(rest remaining)
(append completed (list (list (first next-entry))))
fenv)
rest-k))))))
;; --- ResetFrame: body evaluated normally (no shift) ---
(= ft "reset")
(make-cek-value value env rest-k)
;; --- DerefFrame: deref argument evaluated ---
(= ft "deref")
(let ((val value)
(fenv (get frame "env")))
(if (not (signal? val))
;; Not a signal: pass through
(make-cek-value val fenv rest-k)
;; Signal: check for ReactiveResetFrame
(if (has-reactive-reset-frame? rest-k)
;; Perform reactive shift
(reactive-shift-deref val fenv rest-k)
;; No reactive-reset: normal deref (scope-based tracking)
(do
(let ((ctx (context "sx-reactive" nil)))
(when ctx
(let ((dep-list (get ctx "deps"))
(notify-fn (get ctx "notify")))
(when (not (contains? dep-list val))
(append! dep-list val)
(signal-add-sub! val notify-fn)))))
(make-cek-value (signal-value val) fenv rest-k)))))
;; --- ReactiveResetFrame: expression completed ---
(= ft "reactive-reset")
(let ((update-fn (get frame "update-fn"))
(first? (get frame "first-render")))
;; On re-render (not first), call update-fn with new value
(when (and update-fn (not first?))
(cek-call update-fn (list value)))
(make-cek-value value env rest-k))
;; --- ScopeFrame: body result ---
(= ft "scope")
(let ((name (get frame "name"))
(remaining (get frame "remaining"))
(fenv (get frame "env")))
(if (empty? remaining)
(do (scope-pop! name)
(make-cek-value value fenv rest-k))
(make-cek-state
(first remaining) fenv
(kont-push
(make-scope-frame name (rest remaining) fenv)
rest-k))))
;; --- MapFrame: callback result for map/map-indexed ---
(= ft "map")
(let ((f (get frame "f"))
(remaining (get frame "remaining"))
(results (get frame "results"))
(indexed (get frame "indexed"))
(fenv (get frame "env")))
(let ((new-results (append results (list value))))
(if (empty? remaining)
(make-cek-value new-results fenv rest-k)
(let ((call-args (if indexed
(list (len new-results) (first remaining))
(list (first remaining))))
(next-frame (if indexed
(make-map-indexed-frame f (rest remaining) new-results fenv)
(make-map-frame f (rest remaining) new-results fenv))))
(continue-with-call f call-args fenv (list)
(kont-push next-frame rest-k))))))
;; --- FilterFrame: predicate result ---
(= ft "filter")
(let ((f (get frame "f"))
(remaining (get frame "remaining"))
(results (get frame "results"))
(current-item (get frame "current-item"))
(fenv (get frame "env")))
(let ((new-results (if value
(append results (list current-item))
results)))
(if (empty? remaining)
(make-cek-value new-results fenv rest-k)
(continue-with-call f (list (first remaining)) fenv (list)
(kont-push (make-filter-frame f (rest remaining) new-results (first remaining) fenv) rest-k)))))
;; --- ReduceFrame: accumulator step ---
(= ft "reduce")
(let ((f (get frame "f"))
(remaining (get frame "remaining"))
(fenv (get frame "env")))
(if (empty? remaining)
(make-cek-value value fenv rest-k)
(continue-with-call f (list value (first remaining)) fenv (list)
(kont-push (make-reduce-frame f (rest remaining) fenv) rest-k))))
;; --- ForEachFrame: side effect, discard result ---
(= ft "for-each")
(let ((f (get frame "f"))
(remaining (get frame "remaining"))
(fenv (get frame "env")))
(if (empty? remaining)
(make-cek-value nil fenv rest-k)
(continue-with-call f (list (first remaining)) fenv (list)
(kont-push (make-for-each-frame f (rest remaining) fenv) rest-k))))
;; --- SomeFrame: short-circuit on first truthy ---
(= ft "some")
(let ((f (get frame "f"))
(remaining (get frame "remaining"))
(fenv (get frame "env")))
(if value
(make-cek-value value fenv rest-k)
(if (empty? remaining)
(make-cek-value false fenv rest-k)
(continue-with-call f (list (first remaining)) fenv (list)
(kont-push (make-some-frame f (rest remaining) fenv) rest-k)))))
;; --- EveryFrame: short-circuit on first falsy ---
(= ft "every")
(let ((f (get frame "f"))
(remaining (get frame "remaining"))
(fenv (get frame "env")))
(if (not value)
(make-cek-value false fenv rest-k)
(if (empty? remaining)
(make-cek-value true fenv rest-k)
(continue-with-call f (list (first remaining)) fenv (list)
(kont-push (make-every-frame f (rest remaining) fenv) rest-k)))))
:else (error (str "Unknown frame type: " ft))))))))
;; --------------------------------------------------------------------------
;; 9. Helper: continue with function call
;; --------------------------------------------------------------------------
(define continue-with-call
(fn (f args env raw-args kont)
(cond
;; Continuation — restore captured frames and inject value
(continuation? f)
(let ((arg (if (empty? args) nil (first args)))
(cont-data (continuation-data f)))
(let ((captured (get cont-data "captured"))
(rest-k (get cont-data "rest-kont")))
(make-cek-value arg env (concat captured rest-k))))
;; Native callable
(and (callable? f) (not (lambda? f)) (not (component? f)) (not (island? f)))
(make-cek-value (apply f args) env kont)
;; Lambda — bind params, evaluate body
(lambda? f)
(let ((params (lambda-params f))
(local (env-merge (lambda-closure f) env)))
(if (> (len args) (len params))
(error (str (or (lambda-name f) "lambda")
" expects " (len params) " args, got " (len args)))
(do
(for-each
(fn (pair) (env-set! local (first pair) (nth pair 1)))
(zip params args))
(for-each
(fn (p) (env-set! local p nil))
(slice params (len args)))
(make-cek-state (lambda-body f) local kont))))
;; Component — parse kwargs, bind, evaluate body
(or (component? f) (island? f))
(let ((parsed (parse-keyword-args raw-args env))
(kwargs (first parsed))
(children (nth parsed 1))
(local (env-merge (component-closure f) env)))
(for-each
(fn (p) (env-set! local p (or (dict-get kwargs p) nil)))
(component-params f))
(when (component-has-children? f)
(env-set! local "children" children))
(make-cek-state (component-body f) local kont))
:else (error (str "Not callable: " (inspect f))))))
;; --------------------------------------------------------------------------
;; 10. Case step loop helper
;; --------------------------------------------------------------------------
(define sf-case-step-loop
(fn (match-val clauses env kont)
(if (< (len clauses) 2)
(make-cek-value nil env kont)
(let ((test (first clauses))
(body (nth clauses 1)))
(if (or (and (= (type-of test) "keyword") (= (keyword-name test) "else"))
(and (= (type-of test) "symbol")
(or (= (symbol-name test) "else")
(= (symbol-name test) ":else"))))
(make-cek-state body env kont)
;; Evaluate test expression
(let ((test-val (trampoline (eval-expr test env))))
(if (= match-val test-val)
(make-cek-state body env kont)
(sf-case-step-loop match-val (slice clauses 2) env kont))))))))
;; --------------------------------------------------------------------------
;; 11. Compatibility wrapper — eval-expr-cek
;; --------------------------------------------------------------------------
;;
;; Drop-in replacement for eval-expr. Creates a CEK state and runs.
;; All downstream code (adapters, services) works unchanged.
(define eval-expr-cek
(fn (expr env)
(cek-run (make-cek-state expr env (list)))))
(define trampoline-cek
(fn (val)
;; In CEK mode, thunks are not produced — values are immediate.
;; But for compatibility, resolve any remaining thunks.
(if (thunk? val)
(eval-expr-cek (thunk-expr val) (thunk-env val))
val)))
;; --------------------------------------------------------------------------
;; 13. Freeze scopes — named serializable state boundaries
;; --------------------------------------------------------------------------
;;
;; A freeze scope collects signals registered within it. On freeze,
;; their current values are serialized to SX. On thaw, values are
;; restored. Multiple named scopes can coexist independently.
;;
;; Uses the scoped effects system: scope-push!/scope-pop!/context.
;;
;; Usage:
;; (freeze-scope "editor"
;; (let ((doc (signal "hello")))
;; (freeze-signal "doc" doc)
;; ...))
;;
;; (cek-freeze-scope "editor") → {:name "editor" :signals {:doc "hello"}}
;; (cek-thaw-scope "editor" frozen-data) → restores signal values
;; Registry of freeze scopes: name → list of {name signal} entries
(define freeze-registry (dict))
;; Register a signal in the current freeze scope
(define freeze-signal :effects [mutation]
(fn (name sig)
(let ((scope-name (context "sx-freeze-scope" nil)))
(when scope-name
(let ((entries (or (get freeze-registry scope-name) (list))))
(append! entries (dict "name" name "signal" sig))
(dict-set! freeze-registry scope-name entries))))))
;; Freeze scope delimiter — collects signals registered within body
(define freeze-scope :effects [mutation]
(fn (name body-fn)
(scope-push! "sx-freeze-scope" name)
;; Initialize empty entry list for this scope
(dict-set! freeze-registry name (list))
(cek-call body-fn nil)
(scope-pop! "sx-freeze-scope")
nil))
;; Freeze a named scope → SX dict of signal values
(define cek-freeze-scope :effects []
(fn (name)
(let ((entries (or (get freeze-registry name) (list)))
(signals-dict (dict)))
(for-each (fn (entry)
(dict-set! signals-dict
(get entry "name")
(signal-value (get entry "signal"))))
entries)
(dict "name" name "signals" signals-dict))))
;; Freeze all scopes
(define cek-freeze-all :effects []
(fn ()
(map (fn (name) (cek-freeze-scope name))
(keys freeze-registry))))
;; Thaw a named scope — restore signal values from frozen data
(define cek-thaw-scope :effects [mutation]
(fn (name frozen)
(let ((entries (or (get freeze-registry name) (list)))
(values (get frozen "signals")))
(when values
(for-each (fn (entry)
(let ((sig-name (get entry "name"))
(sig (get entry "signal"))
(val (get values sig-name)))
(when (not (nil? val))
(reset! sig val))))
entries)))))
;; Thaw all scopes from a list of frozen scope dicts
(define cek-thaw-all :effects [mutation]
(fn (frozen-list)
(for-each (fn (frozen)
(cek-thaw-scope (get frozen "name") frozen))
frozen-list)))
;; Serialize a frozen scope to SX text
(define freeze-to-sx :effects []
(fn (name)
(sx-serialize (cek-freeze-scope name))))
;; Restore from SX text
(define thaw-from-sx :effects [mutation]
(fn (sx-text)
(let ((parsed (sx-parse sx-text)))
(when (not (empty? parsed))
(let ((frozen (first parsed)))
(cek-thaw-scope (get frozen "name") frozen))))))