giles
a759f4da3b
Some checks failed
Build and Deploy / build-and-deploy (push) Has been cancelled
Documents and demonstrates serializable CEK state. Type an expression, step to any point, click Freeze to see the frozen SX. Click Thaw to resume from the frozen state and get the result. - New page at /sx/(geography.(cek.freeze)) - Nav entry under CEK Machine - Interactive island demo with step/run/freeze/thaw buttons - Documentation: the idea, freeze format, thaw/resume, what it enables Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
1197 lines
50 KiB
Plaintext
1197 lines
50 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. CEK state serialization — freeze and resume computation
|
|
;; --------------------------------------------------------------------------
|
|
;;
|
|
;; Serialize a CEK state to an s-expression. The result can be:
|
|
;; - Printed as text (sx-serialize)
|
|
;; - Stored, transmitted, content-addressed
|
|
;; - Parsed back (sx-parse) and resumed (cek-run)
|
|
;;
|
|
;; Native functions serialize as (primitive "name") — looked up on resume.
|
|
;; Lambdas serialize as (lambda (params) body closure-env).
|
|
;; Environments serialize as dicts of their visible bindings.
|
|
|
|
(define primitive-name :effects []
|
|
(fn (f)
|
|
;; For lambdas, use lambda-name. For native callables, check common names.
|
|
(if (lambda? f)
|
|
(lambda-name f)
|
|
;; Native function — try common primitive names
|
|
(let ((result nil)
|
|
(names (list "+" "-" "*" "/" "=" "<" ">" "<=" ">=" "not" "and" "or"
|
|
"str" "len" "first" "rest" "nth" "list" "cons" "append"
|
|
"map" "filter" "reduce" "for-each" "some" "every?"
|
|
"get" "keys" "dict" "dict?" "has-key?" "assoc"
|
|
"empty?" "nil?" "number?" "string?" "list?"
|
|
"type-of" "identity" "inc" "dec" "mod"
|
|
"join" "split" "slice" "contains?" "starts-with?"
|
|
"upper" "lower" "trim" "replace" "format")))
|
|
(for-each (fn (name)
|
|
(when (and (nil? result) (primitive? name) (identical? f (get-primitive name)))
|
|
(set! result name)))
|
|
names)
|
|
result))))
|
|
|
|
(define cek-serialize-value :effects []
|
|
(fn (val)
|
|
(cond
|
|
(nil? val) nil
|
|
(number? val) val
|
|
(string? val) val
|
|
(boolean? val) val
|
|
(symbol? val) val
|
|
(keyword? val) val
|
|
(list? val) (map cek-serialize-value val)
|
|
(lambda? val) (list (make-symbol "lambda")
|
|
(lambda-params val)
|
|
(lambda-body val))
|
|
(callable? val) (list (make-symbol "primitive")
|
|
(or (primitive-name val) "?"))
|
|
(dict? val) (cek-serialize-env val)
|
|
:else (str val))))
|
|
|
|
(define cek-serialize-env :effects []
|
|
(fn (env)
|
|
(let ((result (dict))
|
|
(ks (keys env)))
|
|
(for-each (fn (k)
|
|
(dict-set! result k (cek-serialize-value (get env k))))
|
|
ks)
|
|
result)))
|
|
|
|
(define cek-serialize-frame :effects []
|
|
(fn (frame)
|
|
(let ((result (dict))
|
|
(ks (keys frame)))
|
|
(for-each (fn (k)
|
|
(let ((v (get frame k)))
|
|
(dict-set! result k
|
|
(cond
|
|
(= k "type") v
|
|
(= k "tag") v
|
|
(= k "f") (cek-serialize-value v)
|
|
(= k "env") (cek-serialize-env v)
|
|
(= k "evaled") (map cek-serialize-value v)
|
|
(= k "remaining") v ;; unevaluated exprs stay as-is
|
|
(= k "results") (map cek-serialize-value v)
|
|
(= k "raw-args") v
|
|
(= k "current-item") (cek-serialize-value v)
|
|
(= k "name") v
|
|
(= k "update-fn") (cek-serialize-value v)
|
|
(= k "first-render") v
|
|
:else (cek-serialize-value v)))))
|
|
ks)
|
|
result)))
|
|
|
|
(define cek-freeze :effects []
|
|
(fn (state)
|
|
(dict
|
|
"phase" (get state "phase")
|
|
"control" (get state "control")
|
|
"value" (cek-serialize-value (get state "value"))
|
|
"env" (cek-serialize-env (get state "env"))
|
|
"kont" (map cek-serialize-frame (get state "kont")))))
|
|
|
|
;; Deserialize: reconstruct a runnable CEK state from frozen SX.
|
|
;; Native functions are looked up by name in the current PRIMITIVES.
|
|
|
|
(define cek-thaw-value :effects []
|
|
(fn (val)
|
|
(cond
|
|
(nil? val) nil
|
|
(number? val) val
|
|
(string? val) val
|
|
(boolean? val) val
|
|
(symbol? val) val
|
|
(keyword? val) val
|
|
;; (primitive "name") → look up native function
|
|
(and (list? val) (not (empty? val))
|
|
(symbol? (first val))
|
|
(= (symbol-name (first val)) "primitive"))
|
|
(get-primitive (nth val 1))
|
|
;; (lambda (params) body) → reconstruct Lambda
|
|
(and (list? val) (not (empty? val))
|
|
(symbol? (first val))
|
|
(= (symbol-name (first val)) "lambda"))
|
|
(make-lambda (nth val 1) (nth val 2) (dict))
|
|
(list? val) (map cek-thaw-value val)
|
|
(dict? val) (cek-thaw-env val)
|
|
:else val)))
|
|
|
|
(define cek-thaw-env :effects []
|
|
(fn (frozen-env)
|
|
(let ((result (make-env)))
|
|
(for-each (fn (k)
|
|
(env-set! result k (cek-thaw-value (get frozen-env k))))
|
|
(keys frozen-env))
|
|
result)))
|
|
|
|
(define cek-thaw-frame :effects []
|
|
(fn (frozen-frame)
|
|
(let ((result (dict))
|
|
(ks (keys frozen-frame)))
|
|
(for-each (fn (k)
|
|
(let ((v (get frozen-frame k)))
|
|
(dict-set! result k
|
|
(cond
|
|
(= k "type") v
|
|
(= k "tag") v
|
|
(= k "f") (cek-thaw-value v)
|
|
(= k "env") (cek-thaw-env v)
|
|
(= k "evaled") (map cek-thaw-value v)
|
|
(= k "remaining") v
|
|
(= k "results") (map cek-thaw-value v)
|
|
(= k "raw-args") v
|
|
(= k "current-item") (cek-thaw-value v)
|
|
(= k "name") v
|
|
(= k "update-fn") (cek-thaw-value v)
|
|
(= k "first-render") v
|
|
:else (cek-thaw-value v)))))
|
|
ks)
|
|
result)))
|
|
|
|
(define cek-thaw :effects []
|
|
(fn (frozen)
|
|
(dict
|
|
"phase" (get frozen "phase")
|
|
"control" (get frozen "control")
|
|
"value" (cek-thaw-value (get frozen "value"))
|
|
"env" (cek-thaw-env (get frozen "env"))
|
|
"kont" (map cek-thaw-frame (get frozen "kont")))))
|