;; Construct a CEK state: expression to evaluate, env, continuation
(define make-cek-state (fn (control env kont) {:control control :env env :kont kont :value nil :phase "eval"}))

;; Construct a CEK value state: computation complete, result ready
(define make-cek-value (fn (value env kont) {:control nil :env env :kont kont :value value :phase "continue"}))

;; True if state is a terminal value (no more steps needed)
(define
  cek-terminal?
  (fn
    (state)
    (and (= (get state "phase") "continue") (empty? (get state "kont")))))

;; Extract the control expression from a CEK state
(define cek-control (fn (s) (get s "control")))

;; Extract the environment from a CEK state
(define cek-env (fn (s) (get s "env")))

;; Extract the continuation stack from a CEK state
(define cek-kont (fn (s) (get s "kont")))

;; Return state phase: "eval" or "value"
(define cek-phase (fn (s) (get s "phase")))

;; Extract the result value from a terminal CEK state
(define cek-value (fn (s) (get s "value")))

;; Frame for if: holds then/else branches, awaiting test result
(define make-if-frame (fn (then-expr else-expr env) {:else else-expr :env env :type "if" :then then-expr}))

;; Frame for when: holds body, awaiting test result
(define make-when-frame (fn (body-exprs env) {:body body-exprs :env env :type "when"}))

;; Frame for begin/do: holds remaining expressions
(define make-begin-frame (fn (remaining env) {:env env :type "begin" :remaining remaining}))

;; Frame for let: holds remaining bindings and body
(define make-let-frame (fn (name remaining body local) {:body body :env local :type "let" :remaining remaining :name name}))

;; Frame for define: holds name, awaiting value
(define make-define-frame (fn (name env has-effects effect-list) {:env env :effect-list effect-list :has-effects has-effects :type "define" :name name}))

;; Frame for set!: holds name, awaiting new value
(define make-set-frame (fn (name env) {:env env :type "set" :name name}))

;; Frame for function call: accumulates evaluated arguments
(define
  make-arg-frame
  (fn (f evaled remaining env raw-args head-name) {:env env :head-name (or head-name nil) :evaled evaled :type "arg" :f f :remaining remaining :raw-args raw-args}))

;; Frame for call dispatch: holds function and args
(define make-call-frame (fn (f args env) {:args args :env env :type "call" :f f}))

;; Frame for cond: holds remaining clauses
(define make-cond-frame (fn (remaining env scheme?) {:scheme scheme? :env env :type "cond" :remaining remaining}))

;; Frame for case: holds match value and remaining clauses
(define make-case-frame (fn (match-val remaining env) {:match-val match-val :env env :type "case" :remaining remaining}))

;; Frame for -> threading: holds remaining forms
(define make-thread-frame (fn (remaining env) {:env env :type "thread" :remaining remaining}))

;; Insert threaded value as first arg in a form
(define
  thread-insert-arg
  (fn
    (form value fenv)
    (if
      (= (type-of form) "list")
      (eval-expr
        (cons (first form) (cons (list (quote quote) value) (rest form)))
        fenv)
      (eval-expr (list form (list (quote quote) value)) fenv))))

;; Frame for map: accumulates results over remaining items
(define make-map-frame (fn (f remaining results env) {:indexed false :env env :results results :type "map" :f f :remaining remaining}))

;; Frame for map-indexed: like map but tracks index
(define make-map-indexed-frame (fn (f remaining results env) {:indexed true :env env :results results :type "map" :f f :remaining remaining}))

;; Frame for filter: accumulates items passing predicate
(define
  make-filter-frame
  (fn (f remaining results current-item env) {:current-item current-item :env env :results results :type "filter" :f f :remaining remaining}))

;; Frame for reduce: carries accumulator over remaining items
(define make-reduce-frame (fn (f remaining env) {:env env :type "reduce" :f f :remaining remaining}))

;; Frame for for-each: side-effects over remaining items
(define make-for-each-frame (fn (f remaining env) {:env env :type "for-each" :f f :remaining remaining}))

;; Frame for some: short-circuits on first truthy result
(define make-some-frame (fn (f remaining env) {:env env :type "some" :f f :remaining remaining}))

;; Frame for every?: short-circuits on first falsy result
(define make-every-frame (fn (f remaining env) {:env env :type "every" :f f :remaining remaining}))

;; Frame for scope: holds scope name, pops on completion
(define make-scope-frame (fn (name remaining env) {:env env :type "scope" :remaining remaining :name name}))

;; Frame for provide: scope with a downward value
(define make-provide-frame (fn (name value remaining env) {:env env :value value :type "provide" :remaining remaining :name name}))

;; Frame for scope accumulator: tracks emitted values
(define make-scope-acc-frame (fn (name value remaining env) {:env env :value (or value nil) :type "scope-acc" :remaining remaining :emitted (list) :name name}))

;; Frame for reset: delimits continuation capture boundary
(define make-reset-frame (fn (env) {:env env :type "reset"}))

;; Frame for dict literal: accumulates evaluated key-value pairs
(define make-dict-frame (fn (remaining results env) {:env env :results results :type "dict" :remaining remaining}))

;; Frame for and: short-circuits on first falsy value
(define make-and-frame (fn (remaining env) {:env env :type "and" :remaining remaining}))

;; Frame for or: short-circuits on first truthy value
(define make-or-frame (fn (remaining env) {:env env :type "or" :remaining remaining}))

;; Frame for dynamic-wind: holds before/after thunks
(define
  make-dynamic-wind-frame
  (fn (phase body-thunk after-thunk env) {:env env :phase phase :after-thunk after-thunk :type "dynamic-wind" :body-thunk body-thunk}))

;; Frame for reactive reset: delimits signal dependency tracking
(define
  make-reactive-reset-frame
  (fn (env update-fn first-render?) {:first-render first-render? :update-fn update-fn :env env :type "reactive-reset"}))

;; Frame for deref: resolves signal value with dependency tracking
(define make-deref-frame (fn (env) {:env env :type "deref"}))

;; Frame for higher-order setup: staged arg evaluation for map/filter/etc.
(define
  make-ho-setup-frame
  (fn (ho-type remaining-args evaled-args env) {:ho-type ho-type :env env :evaled evaled-args :type "ho-setup" :remaining remaining-args}))

;; Frame for component trace: records component render tree
(define make-comp-trace-frame (fn (name file) {:env file :type "comp-trace" :name name}))

;; Walk continuation stack collecting component trace entries
(define
  kont-collect-comp-trace
  (fn
    (kont)
    (if
      (empty? kont)
      (list)
      (let
        ((frame (first kont)))
        (if
          (= (frame-type frame) "comp-trace")
          (cons {:file (get frame "file") :name (get frame "name")} (kont-collect-comp-trace (rest kont)))
          (kont-collect-comp-trace (rest kont)))))))

;; Frame for handler-bind: condition handler scope
(define make-handler-frame (fn (handlers remaining env) {:env env :type "handler" :f handlers :remaining remaining}))

;; Frame for restart-case: named restart scope
(define make-restart-frame (fn (restarts remaining env) {:env env :type "restart" :f restarts :remaining remaining}))

;; Frame for signal return: restores saved continuation after handler
(define make-signal-return-frame (fn (env saved-kont) {:env env :type "signal-return" :f saved-kont}))

;; Search handler list for one matching a condition type
(define
  find-matching-handler
  (fn
    (handlers condition)
    (if
      (empty? handlers)
      nil
      (let
        ((pair (first handlers)))
        (let
          ((pred (first pair)) (handler-fn (nth pair 1)))
          (if
            (cek-call pred (list condition))
            handler-fn
            (find-matching-handler (rest handlers) condition)))))))

;; Walk continuation stack looking for a matching handler frame
(define
  kont-find-handler
  (fn
    (kont condition)
    (if
      (empty? kont)
      nil
      (let
        ((frame (first kont)))
        (if
          (= (frame-type frame) "handler")
          (let
            ((match (find-matching-handler (get frame "f") condition)))
            (if
              (nil? match)
              (kont-find-handler (rest kont) condition)
              match))
          (kont-find-handler (rest kont) condition))))))

;; Search restart list for one matching a name
(define
  find-named-restart
  (fn
    (restarts name)
    (if
      (empty? restarts)
      nil
      (let
        ((entry (first restarts)))
        (if
          (= (first entry) name)
          entry
          (find-named-restart (rest restarts) name))))))

;; Walk continuation stack looking for a named restart frame
(define
  kont-find-restart
  (fn
    (kont name)
    (if
      (empty? kont)
      nil
      (let
        ((frame (first kont)))
        (if
          (= (frame-type frame) "restart")
          (let
            ((match (find-named-restart (get frame "f") name)))
            (if
              (nil? match)
              (kont-find-restart (rest kont) name)
              (list match frame (rest kont))))
          (kont-find-restart (rest kont) name))))))

;; Get the type tag of a continuation frame
(define frame-type (fn (f) (get f "type")))

;; Push a frame onto the continuation stack
(define kont-push (fn (frame kont) (cons frame kont)))

;; Peek at the top frame of the continuation stack
(define kont-top (fn (kont) (first kont)))

;; Pop the top frame, returning the rest of the stack
(define kont-pop (fn (kont) (rest kont)))

;; True if the continuation stack has no frames
(define kont-empty? (fn (kont) (empty? kont)))

;; Capture continuation frames up to the nearest reset delimiter
(define
  kont-capture-to-reset
  (fn
    (kont)
    (define
      scan
      (fn
        (k captured)
        (if
          (empty? k)
          (error "shift without enclosing reset")
          (let
            ((frame (first k)))
            (if
              (or
                (= (frame-type frame) "reset")
                (= (frame-type frame) "reactive-reset"))
              (list captured (rest k))
              (scan (rest k) (append captured (list frame))))))))
    (scan kont (list))))

;; Walk stack looking for a provide frame with matching name
(define
  kont-find-provide
  (fn
    (kont name)
    (if
      (empty? kont)
      nil
      (let
        ((frame (first kont)))
        (if
          (and
            (= (frame-type frame) "provide")
            (= (get frame "name") name))
          frame
          (kont-find-provide (rest kont) name))))))

;; Walk stack looking for a scope accumulator with matching name
(define
  kont-find-scope-acc
  (fn
    (kont name)
    (if
      (empty? kont)
      nil
      (let
        ((frame (first kont)))
        (if
          (and
            (= (frame-type frame) "scope-acc")
            (= (get frame "name") name))
          frame
          (kont-find-scope-acc (rest kont) name))))))

;; True if stack contains a reactive-reset frame
(define
  has-reactive-reset-frame?
  (fn
    (kont)
    (if
      (empty? kont)
      false
      (if
        (= (frame-type (first kont)) "reactive-reset")
        true
        (has-reactive-reset-frame? (rest kont))))))

;; Capture frames up to the nearest reactive-reset delimiter
(define
  kont-capture-to-reactive-reset
  (fn
    (kont)
    (define
      scan
      (fn
        (k captured)
        (if
          (empty? k)
          (error "reactive deref without enclosing reactive-reset")
          (let
            ((frame (first k)))
            (if
              (= (frame-type frame) "reactive-reset")
              (list captured frame (rest k))
              (scan (rest k) (append captured (list frame))))))))
    (scan kont (list))))

;; Registry of user-defined special forms
(define *custom-special-forms* (dict))

;; Register a function as a custom special form
(define
  register-special-form!
  (fn
    ((name :as string) handler)
    (dict-set! *custom-special-forms* name handler)))

;; Function to check if a symbol is a renderable HTML tag
(define *render-check* nil)

;; Function to render an HTML element
(define *render-fn* nil)

;; Trampoline: repeatedly evaluate thunks until a non-thunk value
(define
  trampoline
  (fn
    ((val :as any))
    (let
      ((result val))
      (do
        (if
          (thunk? result)
          (trampoline (eval-expr (thunk-expr result) (thunk-env result)))
          result)))))

;; Flag: enable strict type checking mode
(define *strict* false)

;; Enable or disable strict type checking
(define set-strict! (fn (val) (set! *strict* val)))

;; Type specs for primitive function parameters
(define *prim-param-types* nil)

;; Set the parameter type spec table for strict mode
(define set-prim-param-types! (fn (types) (set! *prim-param-types* types)))

;; Check if a value matches a declared type (for strict mode)
(define
  value-matches-type?
  (fn
    (val expected-type)
    (match
      expected-type
      ("any" true)
      ("number" (number? val))
      ("string" (string? val))
      ("boolean" (boolean? val))
      ("nil" (nil? val))
      ("list" (list? val))
      ("dict" (dict? val))
      ("lambda" (lambda? val))
      ("symbol" (= (type-of val) "symbol"))
      ("keyword" (= (type-of val) "keyword"))
      (_
        (if
          (and (string? expected-type) (ends-with? expected-type "?"))
          (or
            (nil? val)
            (value-matches-type?
              val
              (slice expected-type 0 (- (string-length expected-type) 1))))
          true)))))

;; Validate function arguments against declared types
(define
  strict-check-args
  (fn
    (name args)
    (when
      (and *strict* *prim-param-types*)
      (let
        ((spec (get *prim-param-types* name)))
        (when
          spec
          (let
            ((positional (get spec "positional"))
              (rest-type (get spec "rest-type")))
            (when
              positional
              (for-each
                (fn
                  (pair)
                  (let
                    ((idx (first pair))
                      (param (nth pair 1))
                      (p-name (first param))
                      (p-type (nth param 1)))
                    (when
                      (< idx (len args))
                      (let
                        ((val (nth args idx)))
                        (when
                          (not (value-matches-type? val p-type))
                          (error
                            (str
                              "Type error: "
                              name
                              " expected "
                              p-type
                              " for param "
                              p-name
                              ", got "
                              (type-of val)
                              " ("
                              (str val)
                              ")")))))))
                (map-indexed (fn (i p) (list i p)) positional)))
            (when
              (and rest-type (> (len args) (len (or positional (list)))))
              (for-each
                (fn
                  (pair)
                  (let
                    ((idx (first pair)) (val (nth pair 1)))
                    (when
                      (not (value-matches-type? val rest-type))
                      (error
                        (str
                          "Type error: "
                          name
                          " expected "
                          rest-type
                          " for rest arg "
                          idx
                          ", got "
                          (type-of val)
                          " ("
                          (str val)
                          ")")))))
                (map-indexed
                  (fn (i v) (list i v))
                  (slice args (len (or positional (list)))))))))))))

;; Evaluate an expression in an environment (CEK entry point)
(define eval-expr (fn (expr (env :as dict)) nil))

;; Call a lambda with evaluated args, binding params in closure env
(define
  call-lambda
  (fn
    ((f :as lambda) (args :as list) (caller-env :as dict))
    (let
      ((params (lambda-params f))
        (local (env-merge (lambda-closure f) caller-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-bind! local (first pair) (nth pair 1)))
            (zip params args))
          (for-each
            (fn (p) (env-bind! local p nil))
            (slice params (len args)))
          (make-thunk (lambda-body f) local))))))

;; Call a component with keyword args, binding params in closure env
(define
  call-component
  (fn
    ((comp :as component) (raw-args :as list) (env :as dict))
    (let
      ((parsed (parse-keyword-args raw-args env))
        (kwargs (first parsed))
        (children (nth parsed 1))
        (local (env-merge (component-closure comp) env)))
      (for-each
        (fn (p) (env-bind! local p (or (dict-get kwargs p) nil)))
        (component-params comp))
      (when
        (component-has-children? comp)
        (env-bind! local "children" children))
      (make-thunk (component-body comp) local))))

;; Parse &key and &rest args from a component call
(define
  parse-keyword-args
  (fn
    ((raw-args :as list) (env :as dict))
    (let
      ((kwargs (dict)) (children (list)) (i 0))
      (reduce
        (fn
          (state arg)
          (let
            ((idx (get state "i")) (skip (get state "skip")))
            (if
              skip
              (assoc state "skip" false "i" (inc idx))
              (if
                (and
                  (= (type-of arg) "keyword")
                  (< (inc idx) (len raw-args)))
                (do
                  (dict-set!
                    kwargs
                    (keyword-name arg)
                    (trampoline (eval-expr (nth raw-args (inc idx)) env)))
                  (assoc state "skip" true "i" (inc idx)))
                (do
                  (append! children (trampoline (eval-expr arg env)))
                  (assoc state "i" (inc idx)))))))
        (dict "i" 0 "skip" false)
        raw-args)
      (list kwargs children))))

;; Detect if a cond uses scheme-style ((test body) ...) syntax
(define
  cond-scheme?
  (fn
    ((clauses :as list))
    (every? (fn (c) (and (= (type-of c) "list") (= (len c) 2))) clauses)))

;; True if a cond clause is the :else / else fallback
(define
  is-else-clause?
  (fn
    (test)
    (or
      (and (= (type-of test) "keyword") (= (keyword-name test) "else"))
      (and
        (= (type-of test) "symbol")
        (or (= (symbol-name test) "else") (= (symbol-name test) ":else"))))))

;; Handle named let: (let name ((var val) ...) body)
(define
  sf-named-let
  (fn
    ((args :as list) (env :as dict))
    (let
      ((loop-name (symbol-name (first args)))
        (bindings (nth args 1))
        (body (slice args 2))
        (params (list))
        (inits (list)))
      (if
        (and
          (= (type-of (first bindings)) "list")
          (= (len (first bindings)) 2))
        (for-each
          (fn
            (binding)
            (append!
              params
              (if
                (= (type-of (first binding)) "symbol")
                (symbol-name (first binding))
                (first binding)))
            (append! inits (nth binding 1)))
          bindings)
        (reduce
          (fn
            (acc pair-idx)
            (do
              (append!
                params
                (if
                  (= (type-of (nth bindings (* pair-idx 2))) "symbol")
                  (symbol-name (nth bindings (* pair-idx 2)))
                  (nth bindings (* pair-idx 2))))
              (append! inits (nth bindings (inc (* pair-idx 2))))))
          nil
          (range 0 (/ (len bindings) 2))))
      (let
        ((loop-body (if (= (len body) 1) (first body) (cons (make-symbol "begin") body)))
          (loop-fn (make-lambda params loop-body env)))
        (set-lambda-name! loop-fn loop-name)
        (env-bind! (lambda-closure loop-fn) loop-name loop-fn)
        (let
          ((init-vals (map (fn (e) (trampoline (eval-expr e env))) inits)))
          (cek-call loop-fn init-vals))))))

;; Construct a lambda value from params and body
(define
  sf-lambda
  (fn
    ((args :as list) (env :as dict))
    (let
      ((params-expr (first args))
        (body-exprs (rest args))
        (body
          (if
            (= (len body-exprs) 1)
            (first body-exprs)
            (cons (make-symbol "begin") body-exprs)))
        (param-names
          (map
            (fn
              (p)
              (cond
                (= (type-of p) "symbol")
                (symbol-name p)
                (and
                  (= (type-of p) "list")
                  (= (len p) 3)
                  (= (type-of (nth p 1)) "keyword")
                  (= (keyword-name (nth p 1)) "as"))
                (symbol-name (first p))
                :else p))
            params-expr)))
      (make-lambda param-names body env))))

;; Handle defcomp: register a named component
(define
  sf-defcomp
  (fn
    ((args :as list) (env :as dict))
    (let
      ((name-sym (first args))
        (params-raw (nth args 1))
        (body (last args))
        (comp-name (strip-prefix (symbol-name name-sym) "~"))
        (parsed (parse-comp-params params-raw))
        (params (first parsed))
        (has-children (nth parsed 1))
        (param-types (nth parsed 2))
        (affinity (defcomp-kwarg args "affinity" "auto")))
      (let
        ((comp (make-component comp-name params has-children body env affinity))
          (effects (defcomp-kwarg args "effects" nil)))
        (when
          (and (not (nil? param-types)) (not (empty? (keys param-types))))
          (component-set-param-types! comp param-types))
        (when
          (not (nil? effects))
          (let
            ((effect-list (if (= (type-of effects) "list") (map (fn (e) (if (= (type-of e) "symbol") (symbol-name e) (str e))) effects) (list (str effects))))
              (effect-anns
                (if
                  (env-has? env "*effect-annotations*")
                  (env-get env "*effect-annotations*")
                  (dict))))
            (dict-set! effect-anns (symbol-name name-sym) effect-list)
            (env-bind! env "*effect-annotations*" effect-anns)))
        (when
          (env-has? env "*current-file*")
          (component-set-file! comp (env-get env "*current-file*")))
        (env-bind! env (symbol-name name-sym) comp)
        comp))))

;; Parse a single &key parameter with optional default
(define
  defcomp-kwarg
  (fn
    ((args :as list) (key :as string) default)
    (let
      ((end (- (len args) 1)) (result default))
      (for-each
        (fn
          (i)
          (when
            (and
              (= (type-of (nth args i)) "keyword")
              (= (keyword-name (nth args i)) key)
              (< (+ i 1) end))
            (let
              ((val (nth args (+ i 1))))
              (set!
                result
                (if (= (type-of val) "keyword") (keyword-name val) val)))))
        (range 2 end 1))
      result)))

;; Parse component parameter list (positional, &key, &rest)
(define
  parse-comp-params
  (fn
    ((params-expr :as list))
    (let
      ((params (list))
        (param-types (dict))
        (has-children false)
        (in-key false))
      (for-each
        (fn
          (p)
          (if
            (and
              (= (type-of p) "list")
              (= (len p) 3)
              (= (type-of (first p)) "symbol")
              (= (type-of (nth p 1)) "keyword")
              (= (keyword-name (nth p 1)) "as"))
            (let
              ((name (symbol-name (first p))) (ptype (nth p 2)))
              (let
                ((type-val (if (= (type-of ptype) "symbol") (symbol-name ptype) ptype)))
                (when
                  (not has-children)
                  (append! params name)
                  (dict-set! param-types name type-val))))
            (when
              (= (type-of p) "symbol")
              (let
                ((name (symbol-name p)))
                (cond
                  (= name "&key")
                  (set! in-key true)
                  (= name "&rest")
                  (set! has-children true)
                  (= name "&children")
                  (set! has-children true)
                  has-children
                  nil
                  in-key
                  (append! params name)
                  :else (append! params name))))))
        params-expr)
      (list params has-children param-types))))

;; Handle defisland: register a reactive island component
(define
  sf-defisland
  (fn
    ((args :as list) (env :as dict))
    (let
      ((name-sym (first args))
        (params-raw (nth args 1))
        (body-exprs (slice args 2))
        (body
          (if
            (= (len body-exprs) 1)
            (first body-exprs)
            (cons (make-symbol "begin") body-exprs)))
        (comp-name (strip-prefix (symbol-name name-sym) "~"))
        (parsed (parse-comp-params params-raw))
        (params (first parsed))
        (has-children (nth parsed 1)))
      (let
        ((island (make-island comp-name params has-children body env)))
        (when
          (env-has? env "*current-file*")
          (component-set-file! island (env-get env "*current-file*")))
        (env-bind! env (symbol-name name-sym) island)
        island))))

;; Handle defmacro: register a macro transformer
(define
  sf-defmacro
  (fn
    ((args :as list) (env :as dict))
    (let
      ((name-sym (first args))
        (params-raw (nth args 1))
        (body (nth args 2))
        (parsed (parse-macro-params params-raw))
        (params (first parsed))
        (rest-param (nth parsed 1)))
      (let
        ((mac (make-macro params rest-param body env (symbol-name name-sym))))
        (env-bind! env (symbol-name name-sym) mac)
        mac))))

;; Parse macro parameter list
(define
  parse-macro-params
  (fn
    ((params-expr :as list))
    (let
      ((params (list)) (rest-param nil))
      (reduce
        (fn
          (state p)
          (if
            (and (= (type-of p) "symbol") (= (symbol-name p) "&rest"))
            (assoc state "in-rest" true)
            (if
              (get state "in-rest")
              (do
                (set!
                  rest-param
                  (if (= (type-of p) "symbol") (symbol-name p) p))
                state)
              (do
                (append!
                  params
                  (if (= (type-of p) "symbol") (symbol-name p) p))
                state))))
        (dict "in-rest" false)
        params-expr)
      (list params rest-param))))

;; Expand a quasiquote template, splicing unquoted values
(define
  qq-expand
  (fn
    (template (env :as dict))
    (if
      (not (= (type-of template) "list"))
      template
      (if
        (empty? template)
        (list)
        (let
          ((head (first template)))
          (if
            (and
              (= (type-of head) "symbol")
              (= (symbol-name head) "unquote"))
            (trampoline (eval-expr (nth template 1) env))
            (reduce
              (fn
                (result item)
                (if
                  (and
                    (= (type-of item) "list")
                    (= (len item) 2)
                    (= (type-of (first item)) "symbol")
                    (= (symbol-name (first item)) "splice-unquote"))
                  (let
                    ((spliced (trampoline (eval-expr (nth item 1) env))))
                    (if
                      (= (type-of spliced) "list")
                      (concat result spliced)
                      (if
                        (nil? spliced)
                        result
                        (concat result (list spliced)))))
                  (concat result (list (qq-expand item env)))))
              (list)
              template)))))))

;; Handle letrec: mutually recursive bindings
(define
  sf-letrec
  (fn
    ((args :as list) (env :as dict))
    (let
      ((bindings (first args))
        (body (rest args))
        (local (env-extend env))
        (names (list))
        (val-exprs (list)))
      (if
        (and
          (= (type-of (first bindings)) "list")
          (= (len (first bindings)) 2))
        (for-each
          (fn
            (binding)
            (let
              ((vname (if (= (type-of (first binding)) "symbol") (symbol-name (first binding)) (first binding))))
              (append! names vname)
              (append! val-exprs (nth binding 1))
              (env-bind! local vname nil)))
          bindings)
        (reduce
          (fn
            (acc pair-idx)
            (let
              ((vname (if (= (type-of (nth bindings (* pair-idx 2))) "symbol") (symbol-name (nth bindings (* pair-idx 2))) (nth bindings (* pair-idx 2))))
                (val-expr (nth bindings (inc (* pair-idx 2)))))
              (append! names vname)
              (append! val-exprs val-expr)
              (env-bind! local vname nil)))
          nil
          (range 0 (/ (len bindings) 2))))
      (let
        ((values (map (fn (e) (trampoline (eval-expr e local))) val-exprs)))
        (for-each
          (fn (pair) (env-bind! local (first pair) (nth pair 1)))
          (zip names values))
        (for-each
          (fn
            (val)
            (when
              (lambda? val)
              (for-each
                (fn
                  (n)
                  (env-bind! (lambda-closure val) n (env-get local n)))
                names)))
          values))
      (for-each
        (fn (e) (trampoline (eval-expr e local)))
        (slice body 0 (dec (len body))))
      (make-thunk (last body) local))))

;; CEK step for letrec continuation frame
(define
  step-sf-letrec
  (fn
    (args env kont)
    (let
      ((thk (sf-letrec args env)))
      (make-cek-state (thunk-expr thk) (thunk-env thk) kont))))

;; Handle dynamic-wind: before/body/after with guaranteed cleanup
(define
  sf-dynamic-wind
  (fn
    ((args :as list) (env :as dict))
    (let
      ((before (trampoline (eval-expr (first args) env)))
        (body (trampoline (eval-expr (nth args 1) env)))
        (after (trampoline (eval-expr (nth args 2) env))))
      (dynamic-wind-call before body after env))))

;; Handle scope special form: push/pop named scope
(define
  sf-scope
  (fn
    ((args :as list) (env :as dict))
    (let
      ((name (trampoline (eval-expr (first args) env)))
        (rest (slice args 1))
        (val nil)
        (body-exprs nil))
      (if
        (and
          (>= (len rest) 2)
          (= (type-of (first rest)) "keyword")
          (= (keyword-name (first rest)) "value"))
        (do
          (set! val (trampoline (eval-expr (nth rest 1) env)))
          (set! body-exprs (slice rest 2)))
        (set! body-exprs rest))
      (scope-push! name val)
      (let
        ((result nil))
        (for-each
          (fn (e) (set! result (trampoline (eval-expr e env))))
          body-exprs)
        (scope-pop! name)
        result))))

;; Handle provide: scope with a downward-propagating value
(define
  sf-provide
  (fn
    ((args :as list) (env :as dict))
    (let
      ((name (trampoline (eval-expr (first args) env)))
        (val (trampoline (eval-expr (nth args 1) env)))
        (body-exprs (slice args 2))
        (result nil))
      (scope-push! name val)
      (for-each
        (fn (e) (set! result (trampoline (eval-expr e env))))
        body-exprs)
      (scope-pop! name)
      result)))

;; Expand a macro call: bind args, evaluate transformer body
(define
  expand-macro
  (fn
    ((mac :as macro) (raw-args :as list) (env :as dict))
    (let
      ((local (env-merge (macro-closure mac) env)))
      (for-each
        (fn
          (pair)
          (env-bind!
            local
            (first pair)
            (if
              (< (nth pair 1) (len raw-args))
              (nth raw-args (nth pair 1))
              nil)))
        (map-indexed (fn (i p) (list p i)) (macro-params mac)))
      (when
        (macro-rest-param mac)
        (env-bind!
          local
          (macro-rest-param mac)
          (slice raw-args (len (macro-params mac)))))
      (trampoline (eval-expr (macro-body mac) local)))))

;; Run the CEK machine to completion, returning final value
(define
  cek-run
  (fn
    (state)
    (if (cek-terminal? state) (cek-value state) (cek-run (cek-step state)))))

;; Single CEK machine step: eval or continue
(define
  cek-step
  (fn
    (state)
    (if
      (= (cek-phase state) "eval")
      (step-eval state)
      (step-continue state))))

;; Eval phase: dispatch on expression type (literal, symbol, list, dict)
(define
  step-eval
  (fn
    (state)
    (let
      ((expr (cek-control state))
        (env (cek-env state))
        (kont (cek-kont state)))
      (case
        (type-of expr)
        "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"
        (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)))))
            (when
              (and (nil? val) (starts-with? name "~"))
              (debug-log "Component not found:" name))
            (make-cek-value val env kont)))
        "keyword"
        (make-cek-value (keyword-name expr) env kont)
        "dict"
        (let
          ((ks (keys expr)))
          (if
            (empty? ks)
            (make-cek-value (dict) env kont)
            (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))
                    env)
                  kont)))))
        "list"
        (if
          (empty? expr)
          (make-cek-value (list) env kont)
          (step-eval-list expr env kont))
        :else (make-cek-value expr env kont)))))

;; Eval a list expression: check for special forms, macros, then call
(define
  step-eval-list
  (fn
    (expr env kont)
    (let
      ((head (first expr)) (args (rest expr)))
      (if
        (not
          (or
            (= (type-of head) "symbol")
            (= (type-of head) "lambda")
            (= (type-of head) "list")))
        (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)))
        (if
          (= (type-of head) "symbol")
          (let
            ((name (symbol-name head)))
            (match
              name
              ("if" (step-sf-if args env kont))
              ("when" (step-sf-when args env kont))
              ("cond" (step-sf-cond args env kont))
              ("case" (step-sf-case args env kont))
              ("and" (step-sf-and args env kont))
              ("or" (step-sf-or args env kont))
              ("let" (step-sf-let args env kont))
              ("let*" (step-sf-let args env kont))
              ("lambda" (step-sf-lambda args env kont))
              ("fn" (step-sf-lambda args env kont))
              ("define" (step-sf-define args env kont))
              ("defcomp" (make-cek-value (sf-defcomp args env) env kont))
              ("defisland" (make-cek-value (sf-defisland args env) env kont))
              ("defmacro" (make-cek-value (sf-defmacro args env) env kont))
              ("begin" (step-sf-begin args env kont))
              ("do" (step-sf-begin args env kont))
              ("quote"
                (make-cek-value
                  (if (empty? args) nil (first args))
                  env
                  kont))
              ("quasiquote"
                (make-cek-value (qq-expand (first args) env) env kont))
              ("->" (step-sf-thread-first args env kont))
              ("set!" (step-sf-set! args env kont))
              ("letrec" (step-sf-letrec args env kont))
              ("reset" (step-sf-reset args env kont))
              ("shift" (step-sf-shift args env kont))
              ("deref" (step-sf-deref args env kont))
              ("scope" (step-sf-scope 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))
              ("handler-bind" (step-sf-handler-bind args env kont))
              ("restart-case" (step-sf-restart-case args env kont))
              ("signal-condition" (step-sf-signal args env kont))
              ("invoke-restart" (step-sf-invoke-restart args env kont))
              ("match" (step-sf-match args env kont))
              ("dynamic-wind"
                (make-cek-value (sf-dynamic-wind args env) env kont))
              ("map" (step-ho-map args env kont))
              ("map-indexed" (step-ho-map-indexed args env kont))
              ("filter" (step-ho-filter args env kont))
              ("reduce" (step-ho-reduce args env kont))
              ("some" (step-ho-some args env kont))
              ("every?" (step-ho-every args env kont))
              ("for-each" (step-ho-for-each args env kont))
              (_
                (cond
                  (has-key? *custom-special-forms* name)
                  (make-cek-value
                    ((get *custom-special-forms* name) args env)
                    env
                    kont)
                  (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))
                  (and *render-check* (*render-check* expr env))
                  (make-cek-value (*render-fn* expr env) env kont)
                  :else (step-eval-call head args env kont)))))
          (step-eval-call head args env kont))))))

;; Find matching clause in a match expression
(define
  match-find-clause
  (fn
    (val clauses env)
    (if
      (empty? clauses)
      nil
      (let
        ((clause (first clauses))
          (pattern (first clause))
          (body (nth clause 1))
          (local (env-extend env)))
        (if
          (match-pattern pattern val local)
          (list local body)
          (match-find-clause val (rest clauses) env))))))

;; Match a value against a pattern, returning bindings or nil
(define
  match-pattern
  (fn
    (pattern value env)
    (cond
      (= pattern (quote _))
      true
      (and
        (list? pattern)
        (= (len pattern) 2)
        (= (first pattern) (quote ?)))
      (let
        ((pred (trampoline (eval-expr (nth pattern 1) env))))
        (cek-call pred (list value)))
      (and
        (list? pattern)
        (not (empty? pattern))
        (= (first pattern) (quote quote)))
      (= value (nth pattern 1))
      (symbol? pattern)
      (do (env-bind! env (symbol-name pattern) value) true)
      (and (list? pattern) (list? value))
      (if
        (not (= (len pattern) (len value)))
        false
        (let
          ((pairs (zip pattern value)))
          (every?
            (fn (pair) (match-pattern (first pair) (nth pair 1) env))
            pairs)))
      :else (= pattern value))))

;; CEK step for match special form
(define
  step-sf-match
  (fn
    (args env kont)
    (let
      ((val (trampoline (eval-expr (first args) env)))
        (clauses (rest args)))
      (let
        ((result (match-find-clause val clauses env)))
        (if
          (nil? result)
          (error (str "match: no clause matched " (inspect val)))
          (make-cek-state (nth result 1) (first result) kont))))))

;; CEK step for handler-bind (condition system)
(define
  step-sf-handler-bind
  (fn
    (args env kont)
    (let
      ((handler-specs (first args))
        (body (rest args))
        (handlers
          (map
            (fn
              (spec)
              (list
                (trampoline (eval-expr (first spec) env))
                (trampoline (eval-expr (nth spec 1) env))))
            handler-specs)))
      (if
        (empty? body)
        (make-cek-value nil env kont)
        (make-cek-state
          (first body)
          env
          (kont-push (make-handler-frame handlers (rest body) env) kont))))))

;; CEK step for restart-case (condition system)
(define
  step-sf-restart-case
  (fn
    (args env kont)
    (let
      ((body (first args))
        (restart-specs (rest args))
        (restarts
          (map
            (fn
              (spec)
              (list
                (if
                  (symbol? (first spec))
                  (symbol-name (first spec))
                  (first spec))
                (nth spec 1)
                (nth spec 2)))
            restart-specs)))
      (make-cek-state
        body
        env
        (kont-push (make-restart-frame restarts (list) env) kont)))))

;; CEK step for signal (raise a condition)
(define
  step-sf-signal
  (fn
    (args env kont)
    (let
      ((condition (trampoline (eval-expr (first args) env)))
        (handler-fn (kont-find-handler kont condition)))
      (if
        (nil? handler-fn)
        (error (str "Unhandled condition: " (inspect condition)))
        (continue-with-call
          handler-fn
          (list condition)
          env
          (list condition)
          (kont-push (make-signal-return-frame env kont) kont))))))

;; CEK step for invoke-restart (jump to named restart)
(define
  step-sf-invoke-restart
  (fn
    (args env kont)
    (let
      ((restart-name (let ((rn (if (symbol? (first args)) (symbol-name (first args)) (trampoline (eval-expr (first args) env))))) (if (symbol? rn) (symbol-name rn) rn)))
        (restart-arg
          (if
            (>= (len args) 2)
            (trampoline (eval-expr (nth args 1) env))
            nil))
        (found (kont-find-restart kont restart-name)))
      (if
        (nil? found)
        (error (str "No restart named: " (inspect restart-name)))
        (let
          ((entry (first found))
            (restart-frame (nth found 1))
            (rest-kont (nth found 2)))
          (let
            ((params (nth entry 1))
              (body (nth entry 2))
              (restart-env (env-extend (get restart-frame "env"))))
            (when
              (not (empty? params))
              (env-bind! restart-env (first params) restart-arg))
            (make-cek-state body restart-env rest-kont)))))))

;; CEK step for if: push if-frame, evaluate test
(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))))

;; CEK step for when: push when-frame, evaluate test
(define
  step-sf-when
  (fn
    (args env kont)
    (make-cek-state
      (first args)
      env
      (kont-push (make-when-frame (rest args) env) kont))))

;; CEK step for begin/do: evaluate forms sequentially
(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))))))

;; CEK step for let: evaluate first binding value
(define
  step-sf-let
  (fn
    (args env kont)
    (if
      (= (type-of (first args)) "symbol")
      (make-cek-value (sf-named-let args env) env kont)
      (let
        ((bindings (first args))
          (body (rest args))
          (local (env-extend env)))
        (if
          (empty? bindings)
          (step-sf-begin body local kont)
          (let
            ((first-binding (if (and (= (type-of (first bindings)) "list") (= (len (first bindings)) 2)) (first bindings) (list (first bindings) (nth bindings 1))))
              (rest-bindings
                (if
                  (and
                    (= (type-of (first bindings)) "list")
                    (= (len (first bindings)) 2))
                  (rest bindings)
                  (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)))))))))

;; CEK step for define: evaluate value, bind in env
(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)))))

;; CEK step for set!: evaluate value, mutate existing binding
(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))))

;; CEK step for and: short-circuit on falsy
(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)))))

;; CEK step for or: short-circuit on truthy
(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)))))

;; CEK step for cond: evaluate first test
(define
  step-sf-cond
  (fn
    (args env kont)
    (let
      ((scheme? (cond-scheme? args)))
      (if
        scheme?
        (if
          (empty? args)
          (make-cek-value nil env kont)
          (let
            ((clause (first args)) (test (first clause)))
            (if
              (is-else-clause? test)
              (make-cek-state (nth clause 1) env kont)
              (make-cek-state
                test
                env
                (kont-push (make-cond-frame args env true) kont)))))
        (if
          (< (len args) 2)
          (make-cek-value nil env kont)
          (let
            ((test (first args)))
            (if
              (is-else-clause? test)
              (make-cek-state (nth args 1) env kont)
              (make-cek-state
                test
                env
                (kont-push (make-cond-frame args env false) kont)))))))))

;; CEK step for 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))))

;; CEK step for ->: thread value through forms
(define
  step-sf-thread-first
  (fn
    (args env kont)
    (make-cek-state
      (first args)
      env
      (kont-push (make-thread-frame (rest args) env) kont))))

;; CEK step for lambda/fn: capture closure
(define
  step-sf-lambda
  (fn (args env kont) (make-cek-value (sf-lambda args env) env kont)))

;; CEK step for scope: push scope, evaluate body
(define
  step-sf-scope
  (fn
    (args env kont)
    (let
      ((name (trampoline (eval-expr (first args) env)))
        (rest-args (slice args 1))
        (val nil)
        (body nil))
      (if
        (and
          (>= (len rest-args) 2)
          (= (type-of (first rest-args)) "keyword")
          (= (keyword-name (first rest-args)) "value"))
        (do
          (set! val (trampoline (eval-expr (nth rest-args 1) env)))
          (set! body (slice rest-args 2)))
        (set! body rest-args))
      (if
        (empty? body)
        (make-cek-value nil env kont)
        (make-cek-state
          (first body)
          env
          (kont-push (make-scope-acc-frame name val (rest body) env) kont))))))

;; CEK step for provide: push scoped value, evaluate body
(define
  step-sf-provide
  (fn
    (args env kont)
    (let
      ((name (trampoline (eval-expr (first args) env)))
        (val (trampoline (eval-expr (nth args 1) env)))
        (body (slice args 2)))
      (if
        (empty? body)
        (make-cek-value nil env kont)
        (make-cek-state
          (first body)
          env
          (kont-push (make-provide-frame name val (rest body) env) kont))))))

;; CEK step for context: read value from nearest enclosing scope
(define
  step-sf-context
  (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 (nil? frame) default-val (get frame "value"))
        env
        kont))))

;; CEK step for emit!: append value to scope accumulator
(define
  step-sf-emit
  (fn
    (args env kont)
    (let
      ((name (trampoline (eval-expr (first args) env)))
        (val (trampoline (eval-expr (nth args 1) env)))
        (frame (kont-find-scope-acc kont name)))
      (when
        frame
        (dict-set!
          frame
          "emitted"
          (append (get frame "emitted") (list val))))
      (make-cek-value nil env kont))))

;; CEK step for emitted: read accumulated values from scope
(define
  step-sf-emitted
  (fn
    (args env kont)
    (let
      ((name (trampoline (eval-expr (first args) env)))
        (frame (kont-find-scope-acc kont name)))
      (make-cek-value
        (if (nil? frame) (list) (get frame "emitted"))
        env
        kont))))

;; CEK step for reset: push delimiter frame, evaluate body
(define
  step-sf-reset
  (fn
    (args env kont)
    (make-cek-state
      (first args)
      env
      (kont-push (make-reset-frame env) kont))))

;; CEK step for shift: capture continuation to reset, call handler
(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)))
      (let
        ((k (make-cek-continuation captured rest-kont)))
        (let
          ((shift-env (env-extend env)))
          (env-bind! shift-env k-name k)
          (make-cek-state body shift-env rest-kont))))))

;; CEK step for deref: resolve signal with dependency tracking
(define
  step-sf-deref
  (fn
    (args env kont)
    (make-cek-state
      (first args)
      env
      (kont-push (make-deref-frame env) kont))))

;; Dispatch a function call: native fn, lambda, component, or macro
(define
  cek-call
  (fn
    (f args)
    (let
      ((a (if (nil? args) (list) args)))
      (cond
        (nil? f)
        nil
        (or (lambda? f) (callable? f))
        (cek-run (continue-with-call f a (make-env) a (list)))
        :else nil))))

;; Deref inside reactive context: capture deps via shift
(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")))
      (let
        ((sub-disposers (list)))
        (let
          ((subscriber (fn () (for-each (fn (d) (cek-call d nil)) sub-disposers) (set! sub-disposers (list)) (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))))))))
          (signal-add-sub! sig subscriber)
          (register-in-scope
            (fn
              ()
              (signal-remove-sub! sig subscriber)
              (for-each (fn (d) (cek-call d nil)) sub-disposers)))
          (let
            ((initial-kont (concat captured-frames (list reset-frame) remaining-kont)))
            (make-cek-value (signal-value sig) env initial-kont)))))))

;; Evaluate function position, set up arg evaluation frames
(define
  step-eval-call
  (fn
    (head args env kont)
    (let
      ((hname (if (= (type-of head) "symbol") (symbol-name head) nil)))
      (make-cek-state
        head
        env
        (kont-push (make-arg-frame nil (list) args env args hname) kont)))))

;; True if name is a higher-order form (map, filter, reduce, etc.)
(define
  ho-form-name?
  (fn
    (name)
    (or
      (= name "map")
      (= name "map-indexed")
      (= name "filter")
      (= name "reduce")
      (= name "some")
      (= name "every?")
      (= name "for-each"))))

;; True if a value is a function (lambda or native callable)
(define ho-fn? (fn (v) (or (callable? v) (lambda? v))))

;; Auto-detect data-first vs fn-first arg order for HO forms
(define
  ho-swap-args
  (fn
    (ho-type evaled)
    (if
      (= ho-type "reduce")
      (let
        ((a (first evaled)) (b (nth evaled 1)))
        (if
          (and (not (ho-fn? a)) (ho-fn? b))
          (list b (nth evaled 2) a)
          evaled))
      (let
        ((a (first evaled)) (b (nth evaled 1)))
        (if (and (not (ho-fn? a)) (ho-fn? b)) (list b a) evaled)))))

;; Dispatch a higher-order form after args are evaluated
(define
  ho-setup-dispatch
  (fn
    (ho-type evaled env kont)
    (let
      ((ordered (ho-swap-args ho-type evaled)))
      (let
        ((f (first ordered)))
        (match
          ho-type
          ("map"
            (let
              ((coll (nth ordered 1)))
              (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)))))
          ("map-indexed"
            (let
              ((coll (nth ordered 1)))
              (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)))))
          ("filter"
            (let
              ((coll (nth ordered 1)))
              (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)))))
          ("reduce"
            (let
              ((init (nth ordered 1)) (coll (nth ordered 2)))
              (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)))))
          ("some"
            (let
              ((coll (nth ordered 1)))
              (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)))))
          ("every"
            (let
              ((coll (nth ordered 1)))
              (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)))))
          ("for-each"
            (let
              ((coll (nth ordered 1)))
              (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)))))
          (_ (error (str "Unknown HO type: " ho-type))))))))

;; CEK step for map: apply fn to next item, accumulate
(define
  step-ho-map
  (fn
    (args env kont)
    (make-cek-state
      (first args)
      env
      (kont-push (make-ho-setup-frame "map" (rest args) (list) env) kont))))

;; CEK step for map-indexed: like map with index arg
(define
  step-ho-map-indexed
  (fn
    (args env kont)
    (make-cek-state
      (first args)
      env
      (kont-push
        (make-ho-setup-frame "map-indexed" (rest args) (list) env)
        kont))))

;; CEK step for filter: test next item, keep if truthy
(define
  step-ho-filter
  (fn
    (args env kont)
    (make-cek-state
      (first args)
      env
      (kont-push (make-ho-setup-frame "filter" (rest args) (list) env) kont))))

;; CEK step for reduce: apply fn to accumulator and next item
(define
  step-ho-reduce
  (fn
    (args env kont)
    (make-cek-state
      (first args)
      env
      (kont-push (make-ho-setup-frame "reduce" (rest args) (list) env) kont))))

;; CEK step for some: return first truthy result
(define
  step-ho-some
  (fn
    (args env kont)
    (make-cek-state
      (first args)
      env
      (kont-push (make-ho-setup-frame "some" (rest args) (list) env) kont))))

;; CEK step for every?: return false on first falsy
(define
  step-ho-every
  (fn
    (args env kont)
    (make-cek-state
      (first args)
      env
      (kont-push (make-ho-setup-frame "every" (rest args) (list) env) kont))))

;; CEK step for for-each: apply fn for side effects
(define
  step-ho-for-each
  (fn
    (args env kont)
    (make-cek-state
      (first args)
      env
      (kont-push
        (make-ho-setup-frame "for-each" (rest args) (list) env)
        kont))))

;; Continue phase: pop frame, dispatch on frame type
(define
  step-continue
  (fn
    (state)
    (let
      ((value (cek-value state))
        (env (cek-env state))
        (kont (cek-kont state)))
      (if
        (kont-empty? kont)
        state
        (let
          ((frame (kont-top kont))
            (rest-k (kont-pop kont))
            (ft (frame-type frame)))
          (match
            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))))
            ("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)))
            ("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))))))
            ("let"
              (let
                ((name (get frame "name"))
                  (remaining (get frame "remaining"))
                  (body (get frame "body"))
                  (local (get frame "env")))
                (env-bind! local name value)
                (if
                  (empty? remaining)
                  (step-sf-begin body local rest-k)
                  (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))))))
            ("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-bind! fenv name value)
                (when
                  has-effects
                  (let
                    ((effect-names (map (fn (e) (if (= (type-of e) "symbol") (symbol-name e) e)) effect-list))
                      (effect-anns
                        (if
                          (env-has? fenv "*effect-annotations*")
                          (env-get fenv "*effect-annotations*")
                          (dict))))
                    (dict-set! effect-anns name effect-names)
                    (env-bind! fenv "*effect-annotations*" effect-anns)))
                (make-cek-value value fenv rest-k)))
            ("set"
              (let
                ((name (get frame "name")) (fenv (get frame "env")))
                (env-set! fenv name value)
                (make-cek-value value env rest-k)))
            ("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)))))))
            ("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)))))))
            ("cond"
              (let
                ((remaining (get frame "remaining"))
                  (fenv (get frame "env"))
                  (scheme? (get frame "scheme")))
                (if
                  scheme?
                  (if
                    value
                    (make-cek-state (nth (first remaining) 1) fenv rest-k)
                    (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
                            (is-else-clause? next-test)
                            (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)))))))
                  (if
                    value
                    (make-cek-state (nth remaining 1) fenv rest-k)
                    (let
                      ((next (slice remaining 2 (len remaining))))
                      (if
                        (< (len next) 2)
                        (make-cek-value nil fenv rest-k)
                        (let
                          ((next-test (first next)))
                          (if
                            (is-else-clause? next-test)
                            (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))))))))))
            ("case"
              (let
                ((match-val (get frame "match-val"))
                  (remaining (get frame "remaining"))
                  (fenv (get frame "env")))
                (if
                  (nil? match-val)
                  (sf-case-step-loop value remaining fenv rest-k)
                  (sf-case-step-loop match-val remaining fenv rest-k))))
            ("thread"
              (let
                ((remaining (get frame "remaining"))
                  (fenv (get frame "env")))
                (if
                  (empty? remaining)
                  (make-cek-value value fenv rest-k)
                  (let
                    ((form (first remaining))
                      (rest-forms (rest remaining))
                      (new-kont
                        (if
                          (empty? (rest remaining))
                          rest-k
                          (kont-push
                            (make-thread-frame (rest remaining) fenv)
                            rest-k))))
                    (if
                      (and
                        (= (type-of form) "list")
                        (not (empty? form))
                        (= (type-of (first form)) "symbol")
                        (ho-form-name? (symbol-name (first form))))
                      (make-cek-state
                        (cons
                          (first form)
                          (cons (list (quote quote) value) (rest form)))
                        fenv
                        new-kont)
                      (let
                        ((result (thread-insert-arg form value fenv)))
                        (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)))))))))
            ("arg"
              (let
                ((f (get frame "f"))
                  (evaled (get frame "evaled"))
                  (remaining (get frame "remaining"))
                  (fenv (get frame "env"))
                  (raw-args (get frame "raw-args"))
                  (hname (get frame "head-name")))
                (if
                  (nil? f)
                  (do
                    (when
                      (and *strict* hname)
                      (strict-check-args hname (list)))
                    (if
                      (empty? remaining)
                      (continue-with-call value (list) fenv raw-args rest-k)
                      (make-cek-state
                        (first remaining)
                        fenv
                        (kont-push
                          (make-arg-frame
                            value
                            (list)
                            (rest remaining)
                            fenv
                            raw-args
                            hname)
                          rest-k))))
                  (let
                    ((new-evaled (append evaled (list value))))
                    (if
                      (empty? remaining)
                      (do
                        (when
                          (and *strict* hname)
                          (strict-check-args hname new-evaled))
                        (continue-with-call f new-evaled fenv raw-args rest-k))
                      (make-cek-state
                        (first remaining)
                        fenv
                        (kont-push
                          (make-arg-frame
                            f
                            new-evaled
                            (rest remaining)
                            fenv
                            raw-args
                            hname)
                          rest-k)))))))
            ("dict"
              (let
                ((remaining (get frame "remaining"))
                  (results (get frame "results"))
                  (fenv (get frame "env")))
                (let
                  ((last-result (last results))
                    (completed
                      (append
                        (slice results 0 (dec (len results)))
                        (list (list (first last-result) value)))))
                  (if
                    (empty? remaining)
                    (let
                      ((d (dict)))
                      (for-each
                        (fn (pair) (dict-set! d (first pair) (nth pair 1)))
                        completed)
                      (make-cek-value d fenv rest-k))
                    (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)))))))
            ("ho-setup"
              (let
                ((ho-type (get frame "ho-type"))
                  (remaining (get frame "remaining"))
                  (evaled (append (get frame "evaled") (list value)))
                  (fenv (get frame "env")))
                (if
                  (empty? remaining)
                  (ho-setup-dispatch ho-type evaled fenv rest-k)
                  (make-cek-state
                    (first remaining)
                    fenv
                    (kont-push
                      (make-ho-setup-frame
                        ho-type
                        (rest remaining)
                        evaled
                        fenv)
                      rest-k)))))
            ("reset" (make-cek-value value env rest-k))
            ("deref"
              (let
                ((val value) (fenv (get frame "env")))
                (if
                  (not (signal? val))
                  (make-cek-value val fenv rest-k)
                  (if
                    (has-reactive-reset-frame? rest-k)
                    (reactive-shift-deref val fenv rest-k)
                    (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))))))
            ("reactive-reset"
              (let
                ((update-fn (get frame "update-fn"))
                  (first? (get frame "first-render")))
                (when
                  (and update-fn (not first?))
                  (cek-call update-fn (list value)))
                (make-cek-value value env rest-k)))
            ("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)))))
            ("provide"
              (let
                ((remaining (get frame "remaining"))
                  (fenv (get frame "env")))
                (if
                  (empty? remaining)
                  (make-cek-value value fenv rest-k)
                  (make-cek-state
                    (first remaining)
                    fenv
                    (kont-push
                      (make-provide-frame
                        (get frame "name")
                        (get frame "value")
                        (rest remaining)
                        fenv)
                      rest-k)))))
            ("scope-acc"
              (let
                ((remaining (get frame "remaining"))
                  (fenv (get frame "env")))
                (if
                  (empty? remaining)
                  (make-cek-value value fenv rest-k)
                  (make-cek-state
                    (first remaining)
                    fenv
                    (kont-push
                      (let
                        ((new-frame (make-scope-acc-frame (get frame "name") (get frame "value") (rest remaining) fenv)))
                        (dict-set! new-frame "emitted" (get frame "emitted"))
                        new-frame)
                      rest-k)))))
            ("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)))))))
            ("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))))))
            ("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)))))
            ("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)))))
            ("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))))))
            ("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))))))
            ("handler"
              (let
                ((remaining (get frame "remaining"))
                  (fenv (get frame "env")))
                (if
                  (empty? remaining)
                  (make-cek-value value fenv rest-k)
                  (make-cek-state
                    (first remaining)
                    fenv
                    (kont-push
                      (make-handler-frame
                        (get frame "f")
                        (rest remaining)
                        fenv)
                      rest-k)))))
            ("restart" (make-cek-value value env rest-k))
            ("signal-return"
              (let
                ((saved-kont (get frame "saved-kont")))
                (make-cek-value value (get frame "env") saved-kont)))
            ("comp-trace" (make-cek-value value env rest-k))
            (_ (error (str "Unknown frame type: " ft)))))))))

;; Continue with a function call after args are evaluated
(define
  continue-with-call
  (fn
    (f args env raw-args kont)
    (cond
      (continuation? f)
      (let
        ((arg (if (empty? args) nil (first args)))
          (cont-data (continuation-data f)))
        (let
          ((captured (get cont-data "captured")))
          (let
            ((result (cek-run (make-cek-value arg env captured))))
            (make-cek-value result env kont))))
      (and
        (callable? f)
        (not (lambda? f))
        (not (component? f))
        (not (island? f)))
      (make-cek-value (apply f args) env kont)
      (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-bind! local (first pair) (nth pair 1)))
              (zip params args))
            (for-each
              (fn (p) (env-bind! local p nil))
              (slice params (len args)))
            (make-cek-state (lambda-body f) local kont))))
      (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-bind! local p (or (dict-get kwargs p) nil)))
          (component-params f))
        (when
          (component-has-children? f)
          (env-bind! local "children" children))
        (make-cek-state
          (component-body f)
          local
          (kont-push
            (make-comp-trace-frame (component-name f) (component-file f))
            kont)))
      :else (error (str "Not callable: " (inspect f))))))

;; Case dispatch: iterate clauses matching against value
(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
          (is-else-clause? test)
          (make-cek-state body env kont)
          (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))))))))

;; Full CEK evaluation: create initial state, run to completion
(define
  eval-expr-cek
  (fn (expr env) (cek-run (make-cek-state expr env (list)))))

;; Trampoline wrapper for CEK: handles thunks from eval-expr-cek
(define
  trampoline-cek
  (fn
    (val)
    (if (thunk? val) (eval-expr-cek (thunk-expr val) (thunk-env val)) val)))

;; Evaluate an expression in an environment (CEK entry point)
(define
  eval-expr
  (fn (expr (env :as dict)) (cek-run (make-cek-state expr env (list)))))

;; Trampoline: repeatedly evaluate thunks until a non-thunk value
(define
  trampoline
  (fn
    (val)
    (if (thunk? val) (eval-expr (thunk-expr val) (thunk-env val)) val)))