;; ═══════════════════════════════════════════════════════════════
;; Part 1: CEK State
;;
;; The CEK machine state is a 5-tuple: {control, env, kont, value, phase}.
;; In "eval" phase, control holds the expression to evaluate.
;; In "continue" phase, value holds the result and kont is unwound.
;; ═══════════════════════════════════════════════════════════════
(define make-cek-state (fn (control env kont) {:control control :env env :kont kont :value nil :phase "eval"}))

(define make-cek-value (fn (value env kont) {:control nil :env env :kont kont :value value :phase "continue"}))

(define make-cek-suspended (fn (request env kont) {:env env :kont kont :phase "io-suspended" :request request}))

(define
  cek-terminal?
  (fn
    (state)
    (and (= (get state "phase") "continue") (empty? (get state "kont")))))

(define cek-suspended? (fn (state) (= (get state "phase") "io-suspended")))

(define cek-control (fn (s) (get s "control")))

(define cek-env (fn (s) (get s "env")))

(define cek-kont (fn (s) (get s "kont")))

(define cek-phase (fn (s) (get s "phase")))

(define cek-io-request (fn (s) (get s "request")))

;; ═══════════════════════════════════════════════════════════════
;; Part 2: Continuation Frames
;;
;; Each frame type represents a pending computation — what to do
;; when the current sub-expression finishes evaluating. The kont
;; (continuation) is a list of frames, forming a reified call stack.
;; ═══════════════════════════════════════════════════════════════
(define cek-value (fn (s) (get s "value")))

(define make-if-frame (fn (then-expr else-expr env) {:else else-expr :env env :type "if" :then then-expr}))

(define make-when-frame (fn (body-exprs env) {:body body-exprs :env env :type "when"}))

(define make-begin-frame (fn (remaining env) {:env env :type "begin" :remaining remaining}))

(define make-let-frame (fn (name remaining body local) {:body body :env local :type "let" :remaining remaining :name name}))

(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}))

;; Function call frames: accumulate evaluated args, then dispatch
(define make-define-foreign-frame (fn (name spec env) {:spec spec :env env :type "define-foreign" :name name}))

(define make-set-frame (fn (name env) {:env env :type "set" :name name}))

(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}))

(define make-call-frame (fn (f args env) {:args args :env env :type "call" :f f}))

(define make-cond-frame (fn (remaining env scheme?) {:scheme scheme? :env env :type "cond" :remaining remaining}))

(define make-cond-arrow-frame (fn (test-value env) {:env env :match-val test-value :type "cond-arrow"}))

(define make-case-frame (fn (match-val remaining env) {:match-val match-val :env env :type "case" :remaining remaining}))

;; Higher-order iteration frames
(define make-thread-frame (fn (remaining env mode name) {:env env :type "thread" :extra mode :remaining remaining :name name}))

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

(define
  thread-insert-arg-last
  (fn
    (form value fenv)
    (if
      (= (type-of form) "list")
      (eval-expr (append form (list (list (quote quote) value))) fenv)
      (eval-expr (list form (list (quote quote) value)) fenv))))

(define make-map-frame (fn (f remaining results env) {:indexed false :env env :results results :type "map" :f f :remaining remaining}))

(define make-map-indexed-frame (fn (f remaining results env) {:indexed true :env env :results results :type "map" :f f :remaining remaining}))

(define make-multi-map-frame (fn (f remaining-lists results env) {:env env :results results :type "multi-map" :f f :remaining remaining-lists}))

(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}))

(define make-reduce-frame (fn (f remaining env) {:env env :type "reduce" :f f :remaining remaining}))

;; Scope/provide/context — downward data passing without env threading
(define make-for-each-frame (fn (f remaining env) {:env env :type "for-each" :f f :remaining remaining}))

(define make-some-frame (fn (f remaining env) {:env env :type "some" :f f :remaining remaining}))

(define make-every-frame (fn (f remaining env) {:env env :type "every" :f f :remaining remaining}))

;; Delimited continuations (shift/reset)
(define make-scope-frame (fn (name remaining env) {:env env :type "scope" :remaining remaining :name name}))

(define make-provide-frame (fn (name value remaining env) {:subscribers (list) :env env :value value :type "provide" :remaining remaining :name name}))

(define make-bind-frame (fn (body env prev-tracking) {:body body :env env :type "bind" :prev-tracking prev-tracking}))

(define make-provide-set-frame (fn (name env) {:env env :type "provide-set" :name name}))

;; Dynamic wind + reactive signals
(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}))

(define make-reset-frame (fn (env) {:env env :type "reset"}))

;; Undelimited continuations (call/cc)
(define make-dict-frame (fn (remaining results env) {:env env :results results :type "dict" :remaining remaining}))

(define make-and-frame (fn (remaining env) {:env env :type "and" :remaining remaining}))

;; HO setup: staged argument evaluation for map/filter/etc.
;; Evaluates args one at a time, then dispatches to the correct
;; HO frame (map, filter, reduce) once all args are ready.
(define make-or-frame (fn (remaining env) {:env env :type "or" :remaining remaining}))

(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}))

(define
  make-reactive-reset-frame
  (fn (env update-fn first-render?) {:first-render first-render? :update-fn update-fn :env env :type "reactive-reset"}))

;; Condition system frames (handler-bind, restart-case, signal)
(define make-callcc-frame (fn (env) {:env env :type "callcc"}))

(define make-wind-after-frame (fn (after-thunk winders-len env) {:winders-len winders-len :env env :after-thunk after-thunk :type "wind-after"}))

(define make-wind-return-frame (fn (body-result env) {:body-result body-result :env env :type "wind-return"}))

(define make-deref-frame (fn (env) {:env env :type "deref"}))

(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}))

;; R7RS exception frames (raise, guard)
(define make-comp-trace-frame (fn (name file) {:env file :type "comp-trace" :name name}))

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

;; ═══════════════════════════════════════════════════════════════
;; Part 3: Continuation Stack Operations
;;
;; Searching and manipulating the kont list — finding handlers,
;; restarts, scope accumulators, and capturing delimited slices.
;; ═══════════════════════════════════════════════════════════════
(define make-handler-frame (fn (handlers remaining env) {:env env :type "handler" :f handlers :remaining remaining}))

(define make-restart-frame (fn (restarts remaining env) {:env env :type "restart" :f restarts :remaining remaining}))

(define make-signal-return-frame (fn (env saved-kont) {:env env :type "signal-return" :f saved-kont}))

(define make-raise-eval-frame (fn (env continuable?) {:scheme continuable? :env env :type "raise-eval"}))

;; Basic kont operations
(define make-raise-guard-frame (fn (env saved-kont) {:env env :type "raise-guard" :remaining saved-kont}))

(define make-perform-frame (fn (env) {:env env :type "perform"}))

(define make-vm-resume-frame (fn (resume-fn env) {:env env :type "vm-resume" :f resume-fn}))

(define make-import-frame (fn (import-set remaining-sets env) {:args import-set :env env :type "import" :remaining remaining-sets}))

(define
  make-parameterize-frame
  (fn (remaining current-param results body env) {:env env :body body :results results :type "parameterize" :f current-param :remaining remaining}))

;; Capture frames up to a reset boundary — used by shift
(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)))))))

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

(define
  kont-unwind-to-handler
  (fn
    (kont condition)
    (if
      (empty? kont)
      {:handler nil :kont kont}
      (let
        ((frame (first kont)) (rest-k (rest kont)))
        (cond
          (= (frame-type frame) "handler")
          (let
            ((match (find-matching-handler (get frame "f") condition)))
            (if
              (nil? match)
              (kont-unwind-to-handler rest-k condition)
              {:handler match :kont kont}))
          (= (frame-type frame) "wind-after")
          (do
            (when
              (> (len *winders*) (get frame "winders-len"))
              (set! *winders* (rest *winders*)))
            (cek-call (get frame "after-thunk") (list))
            (kont-unwind-to-handler rest-k condition))
          :else (kont-unwind-to-handler rest-k condition))))))

(define
  wind-escape-to
  (fn
    (target-len)
    (when
      (> (len *winders*) target-len)
      (let
        ((after-thunk (first *winders*)))
        (set! *winders* (rest *winders*))
        (cek-call after-thunk (list))
        (wind-escape-to target-len)))))

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

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

(define frame-type (fn (f) (get f "type")))

;; ═══════════════════════════════════════════════════════════════
;; Part 4: Extension Points & Mutable State
;;
;; Custom special forms registry, render hooks, strict mode.
;; Mutable globals use set! — the transpiler emits OCaml refs.
;; ═══════════════════════════════════════════════════════════════
(define kont-push (fn (frame kont) (cons frame kont)))

(define kont-top (fn (kont) (first kont)))

(define kont-pop (fn (kont) (rest kont)))

(define kont-empty? (fn (kont) (empty? kont)))

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

(define
  kont-push-provides
  (fn
    (pairs env kont)
    (if
      (empty? pairs)
      kont
      (let
        ((pair (first pairs)))
        (kont-push-provides
          (rest pairs)
          env
          (cons
            (make-provide-frame
              (first pair)
              (nth pair 1)
              (list)
              env)
            kont))))))

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

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

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

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

(define *custom-special-forms* (dict))

;; ═══════════════════════════════════════════════════════════════
;; Part 5: Evaluation Utilities
;;
;; Forward-declared eval-expr, lambda/component calling, keyword
;; arg parsing, special form constructors (lambda, defcomp,
;; defmacro, quasiquote), and macro expansion.
;; ═══════════════════════════════════════════════════════════════
;; Forward declaration — redefined at end of file as CEK entry point
(define
  register-special-form!
  (fn
    ((name :as string) handler)
    (dict-set! *custom-special-forms* name handler)))

;; Shared param binding for lambda/component calls.
;; Handles &rest collection — used by both call-lambda and continue-with-call.
(define *render-check* nil)

(define *render-fn* nil)

;; Component calls: parse keyword args, bind params, TCO thunk
(define *bind-tracking* nil)

(define *provide-batch-depth* 0)

;; Cond/case helpers
(define *provide-batch-queue* (list))

(define *provide-subscribers* (dict))

;; Special form constructors — build state for CEK evaluation
(define *winders* (list))

(define *library-registry* (dict))

(define
  library-name-key
  (fn
    (spec)
    (join
      "."
      (map (fn (s) (if (symbol? s) (symbol-name s) (str s))) spec))))

(define
  library-loaded?
  (fn (spec) (has-key? *library-registry* (library-name-key spec))))

(define
  library-exports
  (fn
    (spec)
    (let
      ((entry (get *library-registry* (library-name-key spec))))
      (if entry (get entry "exports") (dict)))))

(define
  register-library
  (fn
    (spec exports)
    (dict-set! *library-registry* (library-name-key spec) {:exports exports})))

(define *io-registry* (dict))

(define io-register! (fn (name spec) (dict-set! *io-registry* name spec)))

(define io-registered? (fn (name) (has-key? *io-registry* name)))

;; Quasiquote expansion
(define io-lookup (fn (name) (get *io-registry* name)))

(define io-names (fn () (keys *io-registry*)))

(define *foreign-registry* (dict))

(define
  foreign-register!
  (fn (name spec) (dict-set! *foreign-registry* name spec)))

(define foreign-registered? (fn (name) (has-key? *foreign-registry* name)))

(define foreign-lookup (fn (name) (get *foreign-registry* name)))

;; Macro expansion — expand then re-evaluate the result
(define foreign-names (fn () (keys *foreign-registry*)))

;; ═══════════════════════════════════════════════════════════════
;; Part 6: CEK Machine Core
;;
;; cek-run: trampoline loop — steps until terminal.
;; cek-step: single step — dispatches on phase (eval vs continue).
;; step-eval: evaluates control expression, pushes frames.
;; step-continue: pops a frame, processes result.
;; ═══════════════════════════════════════════════════════════════
(define
  foreign-parse-params
  (fn
    (param-list)
    (let
      ((result (list))
        (i 0)
        (items (if (list? param-list) param-list (list))))
      (foreign-parse-params-loop items result))))

(define
  foreign-parse-kwargs!
  (fn
    (spec remaining)
    (when
      (and
        (not (empty? remaining))
        (>= (len remaining) 2)
        (keyword? (first remaining)))
      (dict-set!
        spec
        (keyword-name (first remaining))
        (let
          ((v (nth remaining 1)))
          (if (keyword? v) (keyword-name v) v)))
      (foreign-parse-kwargs! spec (rest (rest remaining))))))

(define
  foreign-resolve-binding
  (fn
    (binding-str)
    (let
      ((parts (split binding-str ".")))
      (if
        (<= (len parts) 1)
        {:method binding-str :object nil}
        (let
          ((method (last parts))
            (obj (join "." (reverse (rest (reverse parts))))))
          {:method method :object obj})))))

;; ═══════════════════════════════════════════════════════════════
;; Part 7: Special Form Step Functions
;;
;; Each step-sf-* handles one special form in the eval phase.
;; They push frames and return new CEK states — never recurse.
;; ═══════════════════════════════════════════════════════════════
(define
  foreign-check-args
  (fn
    (name params args)
    (when
      (and (not (empty? params)) (< (len args) (len params)))
      (error
        (str
          "foreign "
          name
          ": expected "
          (len params)
          " args, got "
          (len args))))
    (for-each
      (fn
        (i)
        (let
          ((spec (nth params i))
            (val (nth args i))
            (expected (get spec "type")))
          (when
            (and
              (not (= expected "any"))
              (not (value-matches-type? val expected)))
            (error
              (str
                "foreign "
                name
                ": arg '"
                (get spec "name")
                "' expected "
                expected
                ", got "
                (type-of val))))))
      (range 0 (min (len params) (len args))))))

;; R7RS guard: desugars to call/cc + handler-bind with sentinel re-raise
(define
  foreign-build-lambda
  (fn
    (spec)
    (let
      ((name (get spec "name"))
        (mode
          (if
            (has-key? spec "returns")
            (let
              ((r (get spec "returns")))
              (if (= r "promise") "async" "sync"))
            "sync")))
      (if
        (= mode "async")
        (list
          (quote fn)
          (list (quote &rest) (quote __ffi-args__))
          (list
            (quote perform)
            (list
              (quote foreign-dispatch)
              (list (quote quote) name)
              (quote __ffi-args__))))
        (list
          (quote fn)
          (list (quote &rest) (quote __ffi-args__))
          (list
            (quote foreign-dispatch)
            (list (quote quote) name)
            (quote __ffi-args__)))))))

;; List evaluation — dispatches on head: special forms, macros,
;; higher-order forms, or function calls. This is the main
;; expression dispatcher for the CEK machine.
(define
  sf-define-foreign
  (fn
    (args env)
    (let
      ((name (if (symbol? (first args)) (symbol-name (first args)) (first args)))
        (param-list (nth args 1))
        (spec (dict)))
      (dict-set! spec "name" name)
      (dict-set! spec "params" (foreign-parse-params param-list))
      (foreign-parse-kwargs! spec (rest (rest args)))
      (foreign-register! name spec)
      spec)))

;; call/cc: capture entire kont as undelimited escape continuation
(define
  step-sf-define-foreign
  (fn
    (args env kont)
    (let
      ((spec (sf-define-foreign args env))
        (name
          (if
            (symbol? (first args))
            (symbol-name (first args))
            (first args)))
        (lambda-expr (foreign-build-lambda spec)))
      (make-cek-state
        lambda-expr
        env
        (kont-push (make-define-foreign-frame name spec env) kont)))))

(define
  foreign-dispatch
  (fn
    (name args)
    (let
      ((spec (foreign-lookup name)))
      (when
        (nil? spec)
        (error (str "foreign-dispatch: unknown foreign function '" name "'")))
      (let
        ((params (get spec "params")) (binding (get spec "js")))
        (foreign-check-args name (if (nil? params) (list) params) args)
        (if
          (nil? binding)
          (error (str "foreign " name ": no binding for current platform"))
          (let
            ((resolved (foreign-resolve-binding binding))
              (obj-name (get resolved "object"))
              (method (get resolved "method")))
            (if
              (primitive? "host-call")
              (if
                (nil? obj-name)
                (apply
                  (get-primitive "host-call")
                  (concat (list nil method) args))
                (let
                  ((obj ((get-primitive "host-global") obj-name)))
                  (apply
                    (get-primitive "host-call")
                    (concat (list obj method) args))))
              (error
                (str
                  "foreign "
                  name
                  ": host-call not available on this platform")))))))))

(define
  foreign-parse-params-loop
  (fn
    (items acc)
    (if
      (empty? items)
      acc
      (let
        ((item (first items)) (rest-items (rest items)))
        (if
          (and
            (not (empty? rest-items))
            (keyword? (first rest-items))
            (= (keyword-name (first rest-items)) "as")
            (>= (len rest-items) 2))
          (foreign-parse-params-loop
            (rest (rest rest-items))
            (append acc (list {:type (let ((t (nth rest-items 1))) (if (keyword? t) (keyword-name t) (str t))) :name (if (symbol? item) (symbol-name item) (str item))})))
          (foreign-parse-params-loop
            rest-items
            (append acc (list {:type "any" :name (if (symbol? item) (symbol-name item) (str item))}))))))))

;; Pattern matching (match form)
(define
  step-sf-io
  (fn
    (args env kont)
    (let
      ((name (first args)) (io-args (rest args)))
      (when
        (not (io-registered? name))
        (error
          (str "io: unknown operation '" name "' — not in *io-registry*")))
      (make-cek-state (cons (quote perform) (list {:args io-args :op name})) env kont))))

;; Condition system special forms
(define
  trampoline
  (fn
    ((val :as any))
    (let
      ((result val))
      (do
        (if
          (thunk? result)
          (trampoline (eval-expr (thunk-expr result) (thunk-env result)))
          result)))))

(define *strict* false)

(define set-strict! (fn (val) (set! *strict* val)))

(define *prim-param-types* nil)

(define set-prim-param-types! (fn (types) (set! *prim-param-types* types)))

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

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

(define eval-expr (fn (expr (env :as dict)) nil))

(define
  bind-lambda-params
  (fn
    (params args local)
    (let
      ((rest-idx (index-of params "&rest")))
      (if
        (and (number? rest-idx) (< rest-idx (len params)))
        (let
          ((positional (slice params 0 rest-idx))
            (rest-name (nth params (+ rest-idx 1))))
          (do
            (for-each-indexed
              (fn
                (i p)
                (env-bind! local p (if (< i (len args)) (nth args i) nil)))
              positional)
            (env-bind!
              local
              rest-name
              (if (> (len args) rest-idx) (slice args rest-idx) (quote ())))
            true))
        false))))

(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)))
      (when
        (not (bind-lambda-params params args local))
        (when
          (> (len args) (len params))
          (error
            (str
              (or (lambda-name f) "lambda")
              " expects "
              (len params)
              " args, got "
              (len args))))
        (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))))

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

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

(define
  cond-scheme?
  (fn
    ((clauses :as list))
    (every?
      (fn
        (c)
        (and
          (= (type-of c) "list")
          (or
            (= (len c) 2)
            (and
              (= (len c) 3)
              (= (type-of (nth c 1)) "symbol")
              (= (symbol-name (nth c 1)) "=>")))))
      clauses)))

(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"))))))

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

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

;; Scope/provide/context — structured downward data passing
(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))))

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

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

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

;; ═══════════════════════════════════════════════════════════════
;; R7RS syntax-rules / define-syntax
;;
;; syntax-rules creates a macro transformer via pattern matching.
;; define-syntax binds the transformer as a macro (reuses define).
;; Pattern language: _ (wildcard), literals (exact match),
;; pattern variables (bind), ... (ellipsis/repetition).
;; ═══════════════════════════════════════════════════════════════

;; Match a syntax-rules pattern against a form.
;; Returns a dict of bindings on success, nil on failure.
;; literals is a list of symbol name strings that must match exactly.
(define
  defio-parse-kwargs!
  (fn
    (spec remaining)
    (when
      (and
        (not (empty? remaining))
        (>= (len remaining) 2)
        (keyword? (first remaining)))
      (dict-set!
        spec
        (keyword-name (first remaining))
        (nth remaining 1))
      (defio-parse-kwargs! spec (rest (rest remaining))))))

;; Match a list pattern against a form list, handling ellipsis at any position.
;; pi = pattern index, fi = form index.
(define
  sf-defio
  (fn
    (args env)
    (let
      ((name (first args)) (spec (dict)))
      (dict-set! spec "name" name)
      (defio-parse-kwargs! spec (rest args))
      (io-register! name spec)
      spec)))

;; Find which pattern variable in a template drives an ellipsis.
;; Returns the variable name (string) whose binding is a list, or nil.
(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))))

;; Find ALL ellipsis-bound pattern variables in a template.
;; Returns a list of variable name strings.
(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))))

;; Instantiate a template with pattern variable bindings.
;; Handles ellipsis repetition and recursive substitution.
(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)))))))

;; Walk a template list, handling ellipsis at any position.
;; When element at i is followed by ... at i+1, expand the element
;; for each value of its ellipsis variables (all cycled in parallel).
(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))))

;; Try each syntax-rules clause against a form.
;; Returns the instantiated template for the first matching rule, or errors.
;; form is the raw args (without macro name). We prepend a dummy _ symbol
;; because syntax-rules patterns include the keyword as the first element.
(define
  call-with-values
  (fn
    (producer consumer)
    (let
      ((result (apply producer (list))))
      (if
        (and (dict? result) (get result :_values false))
        (apply consumer (get result :_list))
        (apply consumer (list result))))))

(define
  sf-let-values
  (fn
    (args env)
    (let
      ((clauses (first args))
        (body (rest args))
        (local (env-extend env)))
      (for-each
        (fn
          (clause)
          (let
            ((names (first clause)) (val-expr (nth clause 1)))
            (let
              ((result (trampoline (eval-expr val-expr local))))
              (let
                ((vs (if (and (dict? result) (get result :_values false)) (get result :_list) (list result))))
                (for-each-indexed
                  (fn
                    (idx name)
                    (env-bind! local (symbol-name name) (nth vs idx)))
                  names)))))
        clauses)
      (let
        ((last-val nil))
        (for-each
          (fn (e) (set! last-val (trampoline (eval-expr e local))))
          body)
        last-val))))

;; Special form: (syntax-rules (literal ...) (pattern template) ...)
;; Creates a Macro with rules/literals stored in closure env.
;; Body is a marker symbol; expand-macro detects it and calls
;; the pattern matcher directly.
(define
  sf-define-values
  (fn
    (args env)
    (let
      ((names (first args)) (val-expr (nth args 1)))
      (let
        ((result (trampoline (eval-expr val-expr env))))
        (let
          ((vs (if (and (dict? result) (get result :_values false)) (get result :_list) (list result))))
          (for-each-indexed
            (fn (idx name) (env-bind! env (symbol-name name) (nth vs idx)))
            names)
          nil)))))

(register-special-form! "define-values" sf-define-values)

;; R7RS records (SRFI-9)
;;
;; (define-record-type <point>
;;   (make-point x y)
;;   point?
;;   (x point-x)
;;   (y point-y set-point-y!))
;;
;; Creates: constructor, predicate, accessors, optional mutators.
;; Opaque — only accessible through generated functions.
;; Generative — each call creates a unique type.
(register-special-form! "let-values" sf-let-values)

;; Delimited continuations
(define
  step-sf-letrec
  (fn
    (args env kont)
    (let
      ((thk (sf-letrec args env)))
      (make-cek-state (thunk-expr thk) (thunk-env thk) kont))))

(define
  step-sf-dynamic-wind
  (fn
    (args env kont)
    (let
      ((before (trampoline (eval-expr (first args) env)))
        (body (trampoline (eval-expr (nth args 1) env)))
        (after (trampoline (eval-expr (nth args 2) env))))
      (do
        (cek-call before (list))
        (let
          ((winders-len (len *winders*)))
          (set! *winders* (cons after *winders*))
          (continue-with-call
            body
            (list)
            env
            (list)
            (kont-push (make-wind-after-frame after winders-len env) kont)))))))

;; Signal dereferencing with reactive dependency tracking
(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))))

;; ═══════════════════════════════════════════════════════════════
;; Part 8: Call Dispatch
;;
;; cek-call: invoke a function from native code (runs a nested
;; trampoline). step-eval-call: CEK-native call dispatch for
;; lambda, component, native fn, and continuations.
;; ═══════════════════════════════════════════════════════════════
(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)))

;; Reactive signal tracking — captures dependency continuation for re-render
(define
  expand-macro
  (fn
    ((mac :as macro) (raw-args :as list) (env :as dict))
    (let
      ((body (macro-body mac)))
      (if
        (and (symbol? body) (= (symbol-name body) "__syntax-rules-body__"))
        (let
          ((closure (macro-closure mac)))
          (syntax-rules-expand
            (env-get closure "__sr-literals")
            (env-get closure "__sr-rules")
            raw-args))
        (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)))))))

(define
  cek-step-loop
  (fn
    (state)
    (if
      (or (cek-terminal? state) (cek-suspended? state))
      state
      (cek-step-loop (cek-step state)))))

;; ═══════════════════════════════════════════════════════════════
;; Part 9: Higher-Order Form Machinery
;;
;; Data-first HO forms: (map coll fn) and (map fn coll) both work.
;; ho-swap-args auto-detects argument order. HoSetupFrame stages
;; argument evaluation, then dispatches to the appropriate step-ho-*.
;; ═══════════════════════════════════════════════════════════════
(define
  cek-run
  (fn
    (state)
    (let
      ((final (cek-step-loop state)))
      (if
        (cek-suspended? final)
        (error "IO suspension in non-IO context")
        (cek-value final)))))

(define
  cek-resume
  (fn
    (suspended-state result)
    (cek-step-loop
      (make-cek-value
        result
        (cek-env suspended-state)
        (cek-kont suspended-state)))))

(define
  cek-step
  (fn
    (state)
    (if
      (= (cek-phase state) "eval")
      (step-eval state)
      (step-continue state))))

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

(define
  step-sf-raise
  (fn
    (args env kont)
    (make-cek-state
      (first args)
      env
      (kont-push (make-raise-eval-frame env false) kont))))

(define
  step-sf-guard
  (fn
    (args env kont)
    (let
      ((var-clauses (first args))
        (body (rest args))
        (var (first var-clauses))
        (clauses (rest var-clauses))
        (sentinel (make-symbol "__guard-reraise__")))
      (step-eval-list
        (list
          (quote let)
          (list
            (list
              (quote __guard-result)
              (cons
                (quote call/cc)
                (list
                  (cons
                    (quote fn)
                    (cons
                      (quote (__guard-k))
                      (list
                        (cons
                          (quote handler-bind)
                          (cons
                            (list
                              (list
                                (cons
                                  (quote fn)
                                  (cons (quote (_)) (quote (true))))
                                (cons
                                  (quote fn)
                                  (cons
                                    (list var)
                                    (list
                                      (list
                                        (quote __guard-k)
                                        (cons
                                          (quote cond)
                                          (append
                                            clauses
                                            (list
                                              (list
                                                (quote else)
                                                (list
                                                  (quote list)
                                                  (list
                                                    (quote quote)
                                                    sentinel)
                                                  var)))))))))))
                            (list
                              (list
                                (quote __guard-k)
                                (cons (quote begin) body))))))))))))
          (list
            (quote if)
            (list
              (quote and)
              (list (quote list?) (quote __guard-result))
              (list
                (quote =)
                (list (quote len) (quote __guard-result))
                2)
              (list
                (quote =)
                (list (quote first) (quote __guard-result))
                (list (quote quote) sentinel)))
            (list
              (quote raise)
              (list (quote nth) (quote __guard-result) 1))
            (quote __guard-result)))
        env
        kont))))

(define
  step-sf-callcc
  (fn
    (args env kont)
    (make-cek-state
      (first args)
      env
      (kont-push (make-callcc-frame env) kont))))

(define
  step-sf-case
  (fn
    (args env kont)
    (make-cek-state
      (first args)
      env
      (kont-push (make-case-frame nil (rest args) env) kont))))

(define
  step-sf-let-match
  (fn
    (args env kont)
    (let
      ((pattern (first args))
        (expr (nth args 1))
        (body (rest (rest args))))
      (step-sf-match
        (list expr (list pattern (cons (quote begin) body)))
        env
        kont))))

(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))
              ("defio" (make-cek-value (sf-defio args env) env kont))
              ("define-foreign" (step-sf-define-foreign args env kont))
              ("io" (step-sf-io args env kont))
              ("begin" (step-sf-begin args env kont))
              ("do"
                (if
                  (and
                    (not (empty? args))
                    (list? (first args))
                    (not (empty? (first args)))
                    (list? (first (first args))))
                  (let
                    ((bindings (first args))
                      (test-clause (nth args 1))
                      (body (rest (rest args)))
                      (vars (map (fn (b) (first b)) bindings))
                      (inits (map (fn (b) (nth b 1)) bindings))
                      (steps
                        (map
                          (fn
                            (b)
                            (if
                              (> (len b) 2)
                              (nth b 2)
                              (first b)))
                          bindings))
                      (test (first test-clause))
                      (result (rest test-clause)))
                    (step-eval-list
                      (cons
                        (quote let)
                        (cons
                          (quote __do-loop)
                          (cons
                            (map
                              (fn (b) (list (first b) (nth b 1)))
                              bindings)
                            (list
                              (cons
                                (quote if)
                                (cons
                                  test
                                  (cons
                                    (if
                                      (empty? result)
                                      nil
                                      (cons (quote begin) result))
                                    (list
                                      (cons
                                        (quote begin)
                                        (append
                                          body
                                          (list
                                            (cons (quote __do-loop) steps))))))))))))
                      env
                      kont))
                  (step-sf-begin args env kont)))
              ("guard" (step-sf-guard 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))
              ("->>" (step-sf-thread-last args env kont))
              ("|>" (step-sf-thread-last args env kont))
              ("as->" (step-sf-thread-as 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))
              ("peek" (step-sf-peek args env kont))
              ("provide!" (step-sf-provide! args env kont))
              ("context" (step-sf-context args env kont))
              ("bind" (step-sf-bind 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))
              ("let-match" (step-sf-let-match args env kont))
              ("dynamic-wind" (step-sf-dynamic-wind args 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))
              ("raise" (step-sf-raise args env kont))
              ("raise-continuable"
                (make-cek-state
                  (first args)
                  env
                  (kont-push (make-raise-eval-frame env true) kont)))
              ("call/cc" (step-sf-callcc args env kont))
              ("call-with-current-continuation"
                (step-sf-callcc args env kont))
              ("perform" (step-sf-perform args env kont))
              ("define-library" (step-sf-define-library args env kont))
              ("import" (step-sf-import args env kont))
              ("define-record-type"
                (make-cek-value (sf-define-record-type args env) env kont))
              ("define-protocol"
                (make-cek-value (sf-define-protocol args env) env kont))
              ("implement" (make-cek-value (sf-implement args env) env kont))
              ("parameterize" (step-sf-parameterize args env kont))
              ("syntax-rules"
                (make-cek-value (sf-syntax-rules args env) env kont))
              ("define-syntax" (step-sf-define args env kont))
              (_
                (cond
                  (and
                    (has-key? *custom-special-forms* name)
                    (not (env-has? env 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*
                    (not (env-has? env name))
                    (*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))))))

(define
  sf-define-type
  (fn
    (args env)
    (let
      ((type-sym (first args)) (ctor-specs (rest args)))
      (let
        ((type-name (symbol-name type-sym))
          (ctor-names
            (map (fn (spec) (symbol-name (first spec))) ctor-specs)))
        (when
          (not (env-has? env "*adt-registry*"))
          (env-bind! env "*adt-registry*" {}))
        (dict-set! (env-get env "*adt-registry*") type-name ctor-names)
        (env-bind!
          env
          (str type-name "?")
          (fn
            (v)
            (and (dict? v) (get v :_adt) (= (get v :_type) type-name))))
        (for-each
          (fn
            (spec)
            (let
              ((cn (symbol-name (first spec)))
                (field-names (map (fn (f) (symbol-name f)) (rest spec)))
                (arity (len (rest spec))))
              (env-bind!
                env
                cn
                (fn
                  (&rest ctor-args)
                  (if
                    (not (= (len ctor-args) arity))
                    (error
                      (str
                        cn
                        ": expected "
                        arity
                        " args, got "
                        (len ctor-args)))
                    {:_ctor cn :_type type-name :_adt true :_fields ctor-args})))
              (env-bind!
                env
                (str cn "?")
                (fn
                  (v)
                  (and (dict? v) (get v :_adt) (= (get v :_ctor) cn))))
              (for-each-indexed
                (fn
                  (idx field-name)
                  (env-bind!
                    env
                    (str cn "-" field-name)
                    (fn (v) (nth (get v :_fields) idx))))
                field-names)))
          ctor-specs)
        nil))))

;; ═══════════════════════════════════════════════════════════════
;; Part 10: Continue Phase — Frame Dispatch
;;
;; When phase="continue", pop the top frame and process the value.
;; Each frame type has its own handling: if frames check truthiness,
;; let frames bind the value, arg frames accumulate it, etc.
;; continue-with-call handles the final function/component dispatch.
;; ═══════════════════════════════════════════════════════════════
(define
  sf-delay
  (fn
    (args env)
    (let ((thunk (make-lambda (list) (first args) env))) {:forced false :value nil :thunk thunk :_promise true})))

;; Final call dispatch from arg frame — all args evaluated, invoke function.
;; Handles: lambda (bind params + TCO), component (keyword args + TCO),
;; native fn (direct call), continuation (resume), callcc continuation (escape).
(define
  sf-delay-force
  (fn
    (args env)
    (let ((thunk (make-lambda (list) (first args) env))) {:_iterative true :forced false :value nil :thunk thunk :_promise true})))

(define promise? (fn (v) (and (dict? v) (get v :_promise false))))

;; ═══════════════════════════════════════════════════════════════
;; Part 11: Entry Points
;;
;; eval-expr-cek / trampoline-cek: CEK evaluation entry points.
;; eval-expr / trampoline: top-level bindings that override the
;; forward declarations from Part 5.
;; ═══════════════════════════════════════════════════════════════
(define make-promise (fn (v) {:forced true :value v :_promise true}))

(define
  force
  (fn
    (p)
    (if
      (not (promise? p))
      p
      (if
        (get p :forced false)
        (get p :value nil)
        (let
          ((result (apply (get p :thunk nil) (list))))
          (let
            ((final (if (and (get p :_iterative false) (promise? result)) (force result) result)))
            (dict-set! p :forced true)
            (dict-set! p :value final)
            final))))))

(register-special-form! "delay" sf-delay)

(register-special-form! "delay-force" sf-delay-force)

(define
  values
  (fn (&rest vs) (if (= (len vs) 1) (first vs) {:_values true :_list vs})))

(register-special-form! "define-type" sf-define-type)

(define
  kont-extract-provides
  (fn
    (kont)
    (if
      (empty? kont)
      (list)
      (let
        ((frame (first kont))
          (rest-frames (kont-extract-provides (rest kont))))
        (if
          (= (frame-type frame) "provide")
          (cons {:subscribers (list) :env (get frame "env") :value (get frame "value") :type "provide" :remaining (list) :name (get frame "name")} rest-frames)
          rest-frames)))))

(define
  fire-provide-subscribers
  (fn
    (frame kont)
    (let
      ((subs (get frame "subscribers")))
      (when
        (not (empty? subs))
        (if
          (> *provide-batch-depth* 0)
          (for-each
            (fn
              (sub)
              (when
                (not (contains? *provide-batch-queue* sub))
                (append! *provide-batch-queue* sub)))
            subs)
          (for-each (fn (sub) (cek-call sub (list kont))) subs))))))

(define
  fire-provide-subscribers
  (fn
    (name)
    (let
      ((subs (get *provide-subscribers* name)))
      (when
        (and subs (not (empty? subs)))
        (if
          (> *provide-batch-depth* 0)
          (for-each
            (fn
              (sub)
              (when
                (not (contains? *provide-batch-queue* sub))
                (append! *provide-batch-queue* sub)))
            subs)
          (for-each (fn (sub) (cek-call sub (list nil))) subs))))))

(define
  batch-begin!
  (fn () (set! *provide-batch-depth* (+ *provide-batch-depth* 1))))

(define
  batch-end!
  (fn
    ()
    (set! *provide-batch-depth* (- *provide-batch-depth* 1))
    (when
      (= *provide-batch-depth* 0)
      (let
        ((queue *provide-batch-queue*))
        (set! *provide-batch-queue* (list))
        (for-each (fn (sub) (cek-call sub (list nil))) queue)))))

(define
  step-sf-bind
  (fn
    (args env kont)
    (let
      ((body (first args)) (prev *bind-tracking*))
      (set! *bind-tracking* (list))
      (make-cek-state
        body
        env
        (kont-push (make-bind-frame body env prev) kont)))))

(define
  step-sf-parameterize
  (fn
    (args env kont)
    (let
      ((bindings (first args)) (body (rest args)))
      (if
        (or (nil? bindings) (empty? bindings))
        (step-sf-begin body env kont)
        (let
          ((first-pair (first bindings)))
          (make-cek-state
            (first first-pair)
            env
            (kont-push
              (make-parameterize-frame bindings nil (list) body env)
              kont)))))))

(define
  syntax-rules-match
  (fn
    (pattern form literals)
    (cond
      (and (symbol? pattern) (= (symbol-name pattern) "_"))
      (dict)
      (and (symbol? pattern) (contains? literals (symbol-name pattern)))
      (if
        (and (symbol? form) (= (symbol-name pattern) (symbol-name form)))
        (dict)
        nil)
      (symbol? pattern)
      (let ((d (dict))) (dict-set! d (symbol-name pattern) form) d)
      (and (list? pattern) (empty? pattern))
      (if (and (list? form) (empty? form)) (dict) nil)
      (and (list? pattern) (list? form))
      (syntax-rules-match-list pattern 0 form 0 literals)
      :else (if (= pattern form) (dict) nil))))

(define
  syntax-rules-match-list
  (fn
    (pattern pi form fi literals)
    (let
      ((plen (len pattern)) (flen (len form)))
      (cond
        (and (>= pi plen) (>= fi flen))
        (dict)
        (>= pi plen)
        nil
        (and
          (< (+ pi 1) plen)
          (symbol? (nth pattern (+ pi 1)))
          (= (symbol-name (nth pattern (+ pi 1))) "..."))
        (let
          ((sub-pat (nth pattern pi))
            (rest-pat-count (- plen (+ pi 2)))
            (available (- flen fi))
            (n-ellipsis (- (- flen fi) (- plen (+ pi 2)))))
          (if
            (< n-ellipsis 0)
            nil
            (let
              ((ellipsis-forms (slice form fi (+ fi n-ellipsis)))
                (sub-bindings
                  (map
                    (fn (f) (syntax-rules-match sub-pat f literals))
                    (slice form fi (+ fi n-ellipsis)))))
              (if
                (contains? sub-bindings nil)
                nil
                (let
                  ((rest-result (syntax-rules-match-list pattern (+ pi 2) form (+ fi n-ellipsis) literals)))
                  (if
                    (nil? rest-result)
                    nil
                    (let
                      ((merged (dict)))
                      (for-each
                        (fn
                          (b)
                          (for-each
                            (fn
                              (key)
                              (let
                                ((existing (dict-get merged key)))
                                (if
                                  (nil? existing)
                                  (dict-set! merged key (list (get b key)))
                                  (dict-set!
                                    merged
                                    key
                                    (append existing (list (get b key)))))))
                            (keys b)))
                        sub-bindings)
                      (for-each
                        (fn
                          (key)
                          (dict-set! merged key (get rest-result key)))
                        (keys rest-result))
                      merged)))))))
        (>= fi flen)
        nil
        :else (let
          ((sub-result (syntax-rules-match (nth pattern pi) (nth form fi) literals)))
          (if
            (nil? sub-result)
            nil
            (let
              ((rest-result (syntax-rules-match-list pattern (+ pi 1) form (+ fi 1) literals)))
              (if
                (nil? rest-result)
                nil
                (do
                  (for-each
                    (fn
                      (key)
                      (dict-set! rest-result key (get sub-result key)))
                    (keys sub-result))
                  rest-result)))))))))

(define
  syntax-rules-find-var
  (fn
    (template bindings)
    (cond
      (and
        (symbol? template)
        (has-key? bindings (symbol-name template))
        (list? (get bindings (symbol-name template))))
      (symbol-name template)
      (list? template)
      (reduce
        (fn
          (found t)
          (if (nil? found) (syntax-rules-find-var t bindings) found))
        nil
        template)
      :else nil)))

(define
  syntax-rules-find-all-vars
  (fn
    (template bindings)
    (cond
      (and
        (symbol? template)
        (has-key? bindings (symbol-name template))
        (list? (get bindings (symbol-name template))))
      (list (symbol-name template))
      (list? template)
      (reduce
        (fn (acc t) (append acc (syntax-rules-find-all-vars t bindings)))
        (list)
        template)
      :else (list))))

(define
  syntax-rules-instantiate
  (fn
    (template bindings)
    (cond
      (and (symbol? template) (has-key? bindings (symbol-name template)))
      (get bindings (symbol-name template))
      (not (list? template))
      template
      (empty? template)
      template
      :else (syntax-rules-instantiate-list template 0 bindings))))

(define
  syntax-rules-instantiate-list
  (fn
    (template i bindings)
    (if
      (>= i (len template))
      (list)
      (let
        ((elem (nth template i))
          (has-ellipsis
            (and
              (< (+ i 1) (len template))
              (symbol? (nth template (+ i 1)))
              (= (symbol-name (nth template (+ i 1))) "..."))))
        (if
          has-ellipsis
          (let
            ((all-vars (syntax-rules-find-all-vars elem bindings)))
            (if
              (empty? all-vars)
              (syntax-rules-instantiate-list
                template
                (+ i 2)
                bindings)
              (let
                ((count (len (get bindings (first all-vars))))
                  (expanded
                    (map
                      (fn
                        (idx)
                        (let
                          ((b (dict)))
                          (for-each
                            (fn (key) (dict-set! b key (get bindings key)))
                            (keys bindings))
                          (for-each
                            (fn
                              (var-name)
                              (dict-set!
                                b
                                var-name
                                (nth (get bindings var-name) idx)))
                            all-vars)
                          (syntax-rules-instantiate elem b)))
                      (range count)))
                  (rest-result
                    (syntax-rules-instantiate-list
                      template
                      (+ i 2)
                      bindings)))
                (append expanded rest-result))))
          (cons
            (syntax-rules-instantiate elem bindings)
            (syntax-rules-instantiate-list template (+ i 1) bindings)))))))

(define
  syntax-rules-expand
  (fn
    (literals rules form)
    (let
      ((full-form (cons (make-symbol "_") form)))
      (syntax-rules-try-rules literals rules full-form))))

(define
  syntax-rules-try-rules
  (fn
    (literals rules full-form)
    (if
      (empty? rules)
      (error
        (str "syntax-rules: no pattern matched for " (inspect full-form)))
      (let
        ((rule (first rules))
          (pattern (first rule))
          (template (nth rule 1)))
        (let
          ((bindings (syntax-rules-match pattern full-form literals)))
          (if
            (not (nil? bindings))
            (syntax-rules-instantiate template bindings)
            (syntax-rules-try-rules literals (rest rules) full-form)))))))

(define
  sf-syntax-rules
  (fn
    (args env)
    (let
      ((literals (if (list? (first args)) (map (fn (s) (if (symbol? s) (symbol-name s) (str s))) (first args)) (list)))
        (rules (rest args)))
      (let
        ((closure (env-extend env)))
        (env-bind! closure "__sr-literals" literals)
        (env-bind! closure "__sr-rules" rules)
        (make-macro
          (list)
          "__sr-form"
          (quote __syntax-rules-body__)
          closure
          "syntax-rules")))))

(define
  step-sf-define-library
  (fn
    (args env kont)
    (let
      ((lib-spec (first args)) (decls (rest args)))
      (let
        ((lib-env (env-extend env)) (exports (list)) (body-forms (list)))
        (for-each
          (fn
            (decl)
            (when
              (and
                (list? decl)
                (not (empty? decl))
                (symbol? (first decl)))
              (let
                ((kind (symbol-name (first decl))))
                (cond
                  (= kind "export")
                  (set!
                    exports
                    (append
                      exports
                      (map
                        (fn (s) (if (symbol? s) (symbol-name s) (str s)))
                        (rest decl))))
                  (= kind "import")
                  (for-each
                    (fn (import-set) (bind-import-set import-set lib-env))
                    (rest decl))
                  (= kind "begin")
                  (set! body-forms (append body-forms (rest decl)))
                  :else nil))))
          decls)
        (for-each (fn (form) (eval-expr form lib-env)) body-forms)
        (let
          ((export-dict (dict)))
          (for-each
            (fn
              (name)
              (when
                (env-has? lib-env name)
                (dict-set! export-dict name (env-get lib-env name))))
            exports)
          (register-library lib-spec export-dict)
          (make-cek-value nil env kont))))))

(define
  bind-import-set
  (fn
    (import-set env)
    (let
      ((head (if (and (list? import-set) (not (empty? import-set)) (symbol? (first import-set))) (symbol-name (first import-set)) nil)))
      (let
        ((lib-spec (if (or (= head "only") (= head "except") (= head "prefix") (= head "rename")) (nth import-set 1) import-set)))
        (let
          ((exports (library-exports lib-spec)))
          (cond
            (= head "only")
            (for-each
              (fn
                (s)
                (let
                  ((id (if (symbol? s) (symbol-name s) (str s))))
                  (when
                    (has-key? exports id)
                    (env-bind! env id (get exports id)))))
              (rest (rest import-set)))
            (= head "prefix")
            (let
              ((pfx (str (nth import-set 2))))
              (for-each
                (fn (key) (env-bind! env (str pfx key) (get exports key)))
                (keys exports)))
            :else (for-each
              (fn (key) (env-bind! env key (get exports key)))
              (keys exports))))))))

(define
  step-sf-import
  (fn
    (args env kont)
    (if
      (empty? args)
      (make-cek-value nil env kont)
      (let
        ((import-set (first args)) (rest-sets (rest args)))
        (let
          ((lib-spec (let ((head (if (and (list? import-set) (not (empty? import-set)) (symbol? (first import-set))) (symbol-name (first import-set)) nil))) (if (or (= head "only") (= head "except") (= head "prefix") (= head "rename")) (nth import-set 1) import-set))))
          (if
            (library-loaded? lib-spec)
            (do
              (bind-import-set import-set env)
              (if
                (empty? rest-sets)
                (make-cek-value nil env kont)
                (step-sf-import rest-sets env kont)))
            (make-cek-suspended
              {:library lib-spec :op "import"}
              env
              (kont-push (make-import-frame import-set rest-sets env) kont))))))))

(define
  step-sf-perform
  (fn
    (args env kont)
    (if
      (empty? args)
      (error "perform requires an IO request argument")
      (make-cek-state
        (first args)
        env
        (kont-push (make-perform-frame env) kont)))))

(define *protocol-registry* (dict))

(define
  sf-define-record-type
  (fn
    (args env)
    (let
      ((type-sym (first args))
        (ctor-spec (nth args 1))
        (pred-sym (nth args 2))
        (field-specs (slice args 3)))
      (let
        ((raw-name (symbol-name type-sym)))
        (let
          ((type-name (if (and (starts-with? raw-name "<") (ends-with? raw-name ">")) (slice raw-name 1 (- (len raw-name) 1)) raw-name))
            (ctor-name (symbol-name (first ctor-spec)))
            (ctor-params (map (fn (s) (symbol-name s)) (rest ctor-spec)))
            (pred-name (symbol-name pred-sym))
            (field-names
              (map (fn (fs) (symbol-name (first fs))) field-specs)))
          (let
            ((rtd-uid (make-rtd type-name field-names ctor-params)))
            (env-bind! env ctor-name (make-record-constructor rtd-uid))
            (env-bind! env pred-name (make-record-predicate rtd-uid))
            (for-each-indexed
              (fn
                (idx fs)
                (let
                  ((accessor-name (symbol-name (nth fs 1))))
                  (env-bind! env accessor-name (make-record-accessor idx))
                  (when
                    (>= (len fs) 3)
                    (let
                      ((mutator-name (symbol-name (nth fs 2))))
                      (env-bind! env mutator-name (make-record-mutator idx))))))
              field-specs)
            nil))))))

(define
  sf-define-protocol
  (fn
    (args env)
    (let
      ((proto-name (symbol-name (first args))) (method-specs (rest args)))
      (do
        (env-bind! env "*protocol-registry*" *protocol-registry*)
        (env-bind! env "satisfies?" (fn (pname val) (satisfies? pname val))))
      (dict-set! *protocol-registry* proto-name {:impls (dict) :methods (map (fn (spec) {:arity (len spec) :name (symbol-name (first spec))}) method-specs) :name proto-name})
      (for-each
        (fn
          (spec)
          (let
            ((method-name (symbol-name (first spec)))
              (params (rest spec))
              (pname proto-name))
            (let
              ((self-sym (first params))
                (lookup-expr
                  (list
                    (quote get)
                    (list
                      (quote get)
                      (list
                        (quote get)
                        (list (quote get) (quote *protocol-registry*) pname)
                        "impls")
                      (list (quote type-of) self-sym))
                    method-name)))
              (env-bind!
                env
                method-name
                (eval-expr
                  (list
                    (quote fn)
                    params
                    (list
                      (quote let)
                      (list (list (quote _impl) lookup-expr))
                      (list
                        (quote if)
                        (list (quote nil?) (quote _impl))
                        (list
                          (quote error)
                          (str
                            pname
                            "."
                            method-name
                            ": not implemented for this type"))
                        (cons (quote _impl) params))))
                  env)))))
        method-specs)
      nil)))

(define
  check-match-exhaustiveness
  (fn
    (clauses)
    (let
      ((warnings (list))
        (patterns (map first clauses))
        (has-wildcard
          (some
            (fn
              (p)
              (or
                (= p (quote _))
                (and
                  (symbol? p)
                  (not (= p (quote true)))
                  (not (= p (quote false))))))
            patterns))
        (has-else (some (fn (p) (= p :else)) patterns))
        (has-true (some (fn (p) (= p true)) patterns))
        (has-false (some (fn (p) (= p false)) patterns))
        (has-nil (some (fn (p) (= p nil)) patterns))
        (has-predicate
          (some
            (fn (p) (and (list? p) (= (first p) (quote ?))))
            patterns)))
      (when
        (and (not has-wildcard) (not has-else))
        (set!
          warnings
          (append
            warnings
            (list "match may be non-exhaustive (no wildcard or :else pattern)"))))
      (when
        (and
          (or has-true has-false)
          (not (and has-true has-false))
          (not has-wildcard)
          (not has-else))
        (set!
          warnings
          (append
            warnings
            (list
              (if
                has-true
                "match on boolean missing false case"
                "match on boolean missing true case")))))
      (when
        (and
          has-nil
          (not has-wildcard)
          (not has-else)
          (= (len patterns) 1))
        (set!
          warnings
          (append
            warnings
            (list "match checks nil but has no non-nil pattern"))))
      warnings)))

(define
  sf-implement
  (fn
    (args env)
    (let
      ((proto-name (symbol-name (first args)))
        (raw-type-name (symbol-name (nth args 1)))
        (type-name
          (slice raw-type-name 1 (- (len raw-type-name) 1)))
        (method-defs (rest (rest args))))
      (let
        ((proto (get *protocol-registry* proto-name)))
        (if
          (nil? proto)
          (error (str "Unknown protocol: " proto-name))
          (let
            ((impls (get proto "impls"))
              (type-impls (or (get impls type-name) (dict))))
            (for-each
              (fn
                (method-def)
                (let
                  ((mname (symbol-name (first method-def)))
                    (proto-method
                      (first
                        (filter
                          (fn (m) (= (get m "name") mname))
                          (get proto "methods")))))
                  (if
                    (nil? proto-method)
                    (error
                      (str "Unknown method " mname " in protocol " proto-name))
                    (let
                      ((arity (get proto-method "arity"))
                        (params (slice method-def 1 arity))
                        (body
                          (if
                            (= (len method-def) (+ arity 1))
                            (nth method-def arity)
                            (cons (quote begin) (slice method-def arity)))))
                      (dict-set!
                        type-impls
                        mname
                        (eval-expr (list (quote fn) params body) env))))))
              method-defs)
            (dict-set! impls type-name type-impls)
            nil))))))

(define
  satisfies?
  (fn
    (proto-name value)
    (if
      (not (record? value))
      false
      (let
        ((proto (get *protocol-registry* (if (symbol? proto-name) (symbol-name proto-name) proto-name))))
        (if
          (nil? proto)
          false
          (not (nil? (get (get proto "impls") (type-of value)))))))))

(define
  check-match-exhaustiveness
  (fn
    (clauses)
    (let
      ((warnings (list))
        (patterns (map (fn (c) (first c)) clauses))
        (has-wildcard
          (some
            (fn
              (p)
              (and (symbol? p) (not (= p true)) (not (= p false))))
            patterns))
        (has-else (some (fn (p) (= p :else)) patterns))
        (has-true (some (fn (p) (= p true)) patterns))
        (has-false (some (fn (p) (= p false)) patterns)))
      (when
        (and (not has-wildcard) (not has-else))
        (set!
          warnings
          (append
            warnings
            (list "match may be non-exhaustive (no wildcard or :else pattern)"))))
      (when
        (and
          (or has-true has-false)
          (not (and has-true has-false))
          (not has-wildcard)
          (not has-else))
        (set!
          warnings
          (append
            warnings
            (list
              (if
                has-true
                "match on boolean missing false case"
                "match on boolean missing true case")))))
      warnings)))

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

(define
  match-pattern
  (fn
    (pattern value env)
    (cond
      (= pattern (quote _))
      true
      (and
        (list? pattern)
        (= (len pattern) 2)
        (= (first pattern) (quote ?)))
      (let
        ((pred (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)
        (not (empty? pattern))
        (symbol? (first pattern))
        (dict? value)
        (get value :_adt))
      (let
        ((ctor-name (symbol-name (first pattern)))
          (field-patterns (rest pattern))
          (fields (get value :_fields)))
        (and
          (= (get value :_ctor) ctor-name)
          (= (len field-patterns) (len fields))
          (every?
            (fn
              (pair)
              (match-pattern (first pair) (nth pair 1) env))
            (zip field-patterns fields))))
      (and (dict? pattern) (dict? value))
      (every?
        (fn (k) (match-pattern (get pattern k) (get value k) env))
        (keys pattern))
      (and (list? pattern) (list? value) (contains? pattern (quote &rest)))
      (let
        ((rest-idx (index-of pattern (quote &rest))))
        (and
          (>= (len value) rest-idx)
          (every?
            (fn
              (pair)
              (match-pattern (first pair) (nth pair 1) env))
            (zip
              (slice pattern 0 rest-idx)
              (slice value 0 rest-idx)))
          (let
            ((rest-name (nth pattern (+ rest-idx 1))))
            (env-bind! env (symbol-name rest-name) (slice value rest-idx))
            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))))

(define
  match-clause-is-else?
  (fn
    (clause)
    (let
      ((p (first clause)))
      (or
        (= p (quote _))
        (= p (quote else))
        (= p :else)))))

(define
  match-clause-ctor-name
  (fn
    (clause)
    (let
      ((p (first clause)))
      (cond
        (and (list? p) (not (empty? p)) (symbol? (first p)))
        (symbol-name (first p))
        (and (symbol? p) (not (= p (quote _))) (not (= p (quote else))))
        nil
        :else nil))))

(define
  match-warn-non-exhaustive
  (fn
    (env type-name registered clause-ctors)
    (let
      ((missing
        (filter (fn (c) (not (contains? clause-ctors c))) registered)))
      (when
        (not (empty? missing))
        (do
          (when
            (not (env-has? env "*adt-warned*"))
            (env-bind! env "*adt-warned*" (dict)))
          (let
            ((warned (env-get env "*adt-warned*"))
              (key (str type-name "|" (join "," missing))))
            (when
              (not (get warned key))
              (do
                (dict-set! warned key true)
                (host-warn
                  (str
                    "[sx] match: non-exhaustive — "
                    type-name
                    ": missing "
                    (join ", " missing))))))))
      nil)))

(define
  match-check-exhaustiveness
  (fn
    (val clauses env)
    (when
      (and (dict? val) (get val :_adt))
      (let
        ((type-name (get val :_type)))
        (when
          (and (env-has? env "*adt-registry*") type-name)
          (let
            ((registered
              (get (env-get env "*adt-registry*") type-name)))
            (when
              (and registered (not (some match-clause-is-else? clauses)))
              (let
                ((clause-ctors
                  (filter
                    (fn (n) (not (nil? n)))
                    (map match-clause-ctor-name clauses))))
                (match-warn-non-exhaustive
                  env type-name registered clause-ctors)))))))))

(define
  step-sf-match
  (fn
    (args env kont)
    (let
      ((val (trampoline (eval-expr (first args) env)))
        (clauses (rest args)))
      (do
        (match-check-exhaustiveness val clauses env)
        (let
          ((result (match-find-clause val clauses env)))
          (if
            (nil? result)
            (make-cek-value
              (str "match: no clause matched " (inspect val))
              env
              (kont-push (make-raise-eval-frame env false) kont))
            (make-cek-state (nth result 1) (first result) kont)))))))

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

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

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

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

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

(define
  step-sf-when
  (fn
    (args env kont)
    (make-cek-state
      (first args)
      env
      (kont-push (make-when-frame (rest args) env) kont))))

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

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

(define
  step-sf-define
  (fn
    (args env kont)
    (let
      ((resolved-args (if (= (type-of (first args)) "list") (let ((fn-name (first (first args))) (params (rest (first args))) (body-parts (rest args))) (list fn-name (concat (list (make-symbol "fn")) (list params) body-parts))) args)))
      (let
        ((name-sym (first resolved-args))
          (has-effects
            (and
              (>= (len resolved-args) 4)
              (= (type-of (nth resolved-args 1)) "keyword")
              (= (keyword-name (nth resolved-args 1)) "effects")))
          (val-idx
            (if
              (and
                (>= (len resolved-args) 4)
                (= (type-of (nth resolved-args 1)) "keyword")
                (= (keyword-name (nth resolved-args 1)) "effects"))
              3
              1))
          (effect-list
            (if
              (and
                (>= (len resolved-args) 4)
                (= (type-of (nth resolved-args 1)) "keyword")
                (= (keyword-name (nth resolved-args 1)) "effects"))
              (nth resolved-args 2)
              nil)))
        (make-cek-state
          (nth resolved-args val-idx)
          env
          (kont-push
            (make-define-frame
              (symbol-name name-sym)
              env
              has-effects
              effect-list)
            kont))))))

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

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

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

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

(define
  step-sf-thread-first
  (fn
    (args env kont)
    (make-cek-state
      (first args)
      env
      (kont-push (make-thread-frame (rest args) env "first" nil) kont))))

(define
  step-sf-thread-last
  (fn
    (args env kont)
    (make-cek-state
      (first args)
      env
      (kont-push (make-thread-frame (rest args) env "last" nil) kont))))

(define
  step-sf-thread-as
  (fn
    (args env kont)
    (let
      ((init (first args))
        (name (nth args 1))
        (forms (rest (rest args))))
      (make-cek-state
        init
        env
        (kont-push (make-thread-frame forms env "as" name) kont)))))

(define
  step-sf-lambda
  (fn (args env kont) (make-cek-value (sf-lambda args env) env kont)))

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

(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)))
      (scope-push! name val)
      (if
        (empty? body)
        (do (scope-pop! name) (make-cek-value nil env kont))
        (make-cek-state
          (first body)
          env
          (kont-push (make-provide-frame name val (rest body) env) kont))))))

(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)))
      (when
        *bind-tracking*
        (when
          (not (contains? *bind-tracking* name))
          (append! *bind-tracking* name)))
      (make-cek-value
        (let
          ((sv (scope-peek name)))
          (if (nil? sv) (if frame (get frame "value") default-val) sv))
        env
        kont))))

(define
  step-sf-peek
  (fn
    (args env kont)
    (let
      ((name (trampoline (eval-expr (first args) env)))
        (default-val
          (if
            (>= (len args) 2)
            (trampoline (eval-expr (nth args 1) env))
            nil))
        (frame (kont-find-provide kont name)))
      (make-cek-value
        (if
          frame
          (get frame "value")
          (if
            (env-has? env "peek")
            (apply (env-get env "peek") (list name default-val))
            default-val))
        env
        kont))))

(define
  step-sf-provide!
  (fn
    (args env kont)
    (let
      ((name (trampoline (eval-expr (first args) env))))
      (make-cek-state
        (nth args 1)
        env
        (kont-push (make-provide-set-frame name env) kont)))))

(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)))
      (if
        frame
        (do
          (dict-set!
            frame
            "emitted"
            (append (get frame "emitted") (list val)))
          (make-cek-value nil env kont))
        (do
          (when
            (env-has? env "scope-emit!")
            (apply (env-get env "scope-emit!") (list name val)))
          (make-cek-value nil env kont))))))

(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
          frame
          (get frame "emitted")
          (if
            (env-has? env "emitted")
            (apply (env-get env "emitted") (list name))
            (list)))
        env
        kont))))

(define
  step-sf-reset
  (fn
    (args env kont)
    (make-cek-state
      (first args)
      env
      (kont-push (make-reset-frame env) kont))))

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

(define
  step-sf-deref
  (fn
    (args env kont)
    (make-cek-state
      (first args)
      env
      (kont-push (make-deref-frame env) kont))))

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

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

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

(define
  ho-form-name?
  (fn
    (name)
    (or
      (= name "map")
      (= name "map-indexed")
      (= name "filter")
      (= name "reduce")
      (= name "some")
      (= name "every?")
      (= name "for-each"))))

(define ho-fn? (fn (v) (or (callable? v) (lambda? v))))

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

(define
  seq-to-list
  (fn
    (x)
    (cond
      ((= x nil) (list))
      ((list? x) x)
      ((vector? x) (vector->list x))
      ((string? x)
        (let
          ((n (len x)))
          (define
            loop
            (fn
              (i acc)
              (if
                (< i 0)
                acc
                (loop
                  (- i 1)
                  (cons (slice x i (+ i 1)) acc)))))
          (loop (- n 1) (list))))
      (else x))))

(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"
            (if
              (> (len ordered) 2)
              (let
                ((colls (rest ordered)))
                (if
                  (some (fn (c) (empty? c)) colls)
                  (make-cek-value (list) env kont)
                  (let
                    ((heads (map (fn (c) (first c)) colls))
                      (tails (map (fn (c) (rest c)) colls)))
                    (continue-with-call
                      f
                      heads
                      env
                      (list)
                      (kont-push
                        (make-multi-map-frame f tails (list) env)
                        kont)))))
              (let
                ((coll (seq-to-list (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 (seq-to-list (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 (seq-to-list (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 (seq-to-list (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 (seq-to-list (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 (seq-to-list (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 (seq-to-list (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))))))))

(define sequence-to-list (fn (s) (seq-to-list s)))

(define sequence-to-vector (fn (s) (list->vector (seq-to-list s))))

(define
  sequence-length
  (fn
    (s)
    (cond
      ((= s nil) 0)
      ((list? s) (len s))
      ((vector? s) (vector-length s))
      ((string? s) (len s))
      (else (len (seq-to-list s))))))

(define
  sequence-ref
  (fn
    (s i)
    (cond
      ((or (= s nil) (list? s)) (nth s i))
      ((vector? s) (vector-ref s i))
      ((string? s) (slice s i (+ i 1)))
      (else (nth (seq-to-list s) i)))))

(define
  sequence-append
  (fn
    (s1 s2)
    (cond
      ((and (vector? s1) (vector? s2))
        (list->vector (concat (vector->list s1) (vector->list s2))))
      ((and (string? s1) (string? s2)) (str s1 s2))
      (else (concat (seq-to-list s1) (seq-to-list s2))))))

(define
  build-range
  (fn
    (i end step acc)
    (if
      (if (> step 0) (>= i end) (<= i end))
      (reverse acc)
      (build-range (+ i step) end step (cons i acc)))))

(define
  in-range
  (fn
    (a &rest rest)
    (let
      ((end (if (empty? rest) a (first rest)))
        (step
          (if (>= (len rest) 2) (nth rest 1) 1))
        (real-start (if (empty? rest) 0 a)))
      (if
        (= step 0)
        (error "in-range: step cannot be zero")
        (build-range real-start end step (list))))))

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

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

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

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

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

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

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

(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)))
            ("define-foreign"
              (let
                ((name (get frame "name")) (fenv (get frame "env")))
                (when
                  (and (lambda? value) (nil? (lambda-name value)))
                  (set-lambda-name! value name))
                (env-bind! fenv name value)
                (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
                    (let
                      ((clause (first remaining)))
                      (if
                        (and
                          (> (len clause) 2)
                          (= (type-of (nth clause 1)) "symbol")
                          (= (symbol-name (nth clause 1)) "=>"))
                        (make-cek-state
                          (nth clause 2)
                          fenv
                          (kont-push
                            (make-cond-arrow-frame value fenv)
                            rest-k))
                        (make-cek-state (nth clause 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"))
                  (mode (get frame "extra"))
                  (bind-name (get frame "name")))
                (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
                              mode
                              bind-name)
                            rest-k))))
                    (cond
                      (= mode "as")
                      (let
                        ((new-env (env-extend fenv)))
                        (env-bind! new-env (symbol-name bind-name) value)
                        (make-cek-state form new-env new-kont))
                      (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)
                      (= mode "last")
                      (let
                        ((result (thread-insert-arg-last 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
                                mode
                                bind-name)
                              rest-k))))
                      :else (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
                                mode
                                bind-name)
                              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)
                  (do
                    (scope-pop! (get frame "name"))
                    (make-cek-value value fenv rest-k))
                  (let
                    ((new-frame (make-provide-frame (get frame "name") (get frame "value") (rest remaining) fenv)))
                    (dict-set!
                      new-frame
                      "subscribers"
                      (get frame "subscribers"))
                    (make-cek-state
                      (first remaining)
                      fenv
                      (kont-push new-frame rest-k))))))
            ("bind"
              (let
                ((tracked *bind-tracking*)
                  (body (get frame "body"))
                  (fenv (get frame "env"))
                  (prev (get frame "prev-tracking")))
                (set! *bind-tracking* prev)
                (let
                  ((subscriber (fn (fire-kont) (cek-run (make-cek-state body fenv (list))))))
                  (for-each
                    (fn
                      (name)
                      (let
                        ((existing (get *provide-subscribers* name)))
                        (dict-set!
                          *provide-subscribers*
                          name
                          (append
                            (if existing existing (list))
                            (list subscriber)))))
                    tracked))
                (make-cek-value value fenv rest-k)))
            ("provide-set"
              (let
                ((name (get frame "name"))
                  (fenv (get frame "env"))
                  (target (kont-find-provide rest-k name)))
                (let
                  ((old-val (if target (get target "value") (scope-peek name))))
                  (when target (dict-set! target "value" value))
                  (scope-pop! name)
                  (scope-push! name value)
                  (when
                    (not (= old-val value))
                    (fire-provide-subscribers name))
                  (make-cek-value value 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))
            ("cond-arrow"
              (let
                ((test-value (get frame "match-val"))
                  (fenv (get frame "env")))
                (continue-with-call
                  value
                  (list test-value)
                  fenv
                  (list test-value)
                  rest-k)))
            ("wind-after"
              (let
                ((after-thunk (get frame "after-thunk"))
                  (winders-len (get frame "winders-len"))
                  (body-result value)
                  (fenv (get frame "env")))
                (do
                  (when
                    (> (len *winders*) winders-len)
                    (set! *winders* (rest *winders*)))
                  (continue-with-call
                    after-thunk
                    (list)
                    fenv
                    (list)
                    (kont-push
                      (make-wind-return-frame body-result fenv)
                      rest-k)))))
            ("wind-return"
              (make-cek-value
                (get frame "body-result")
                (get frame "env")
                rest-k))
            ("raise-eval"
              (let
                ((condition value)
                  (fenv (get frame "env"))
                  (continuable? (get frame "scheme"))
                  (unwind-result (kont-unwind-to-handler rest-k condition))
                  (handler-fn (get unwind-result "handler"))
                  (unwound-k (get unwind-result "kont")))
                (if
                  (nil? handler-fn)
                  (do
                    (set! *last-error-kont* unwound-k)
                    (host-error
                      (str "Unhandled exception: " (inspect condition))))
                  (continue-with-call
                    handler-fn
                    (list condition)
                    fenv
                    (list condition)
                    (if
                      continuable?
                      (kont-push
                        (make-signal-return-frame fenv unwound-k)
                        unwound-k)
                      (kont-push
                        (make-raise-guard-frame fenv unwound-k)
                        unwound-k))))))
            ("raise-guard"
              (do
                (set! *last-error-kont* rest-k)
                (host-error
                  "exception handler returned from non-continuable raise")))
            ("multi-map"
              (let
                ((f (get frame "f"))
                  (remaining (get frame "remaining"))
                  (new-results (append (get frame "results") (list value)))
                  (fenv (get frame "env")))
                (if
                  (some (fn (c) (empty? c)) remaining)
                  (make-cek-value new-results fenv rest-k)
                  (let
                    ((heads (map (fn (c) (first c)) remaining))
                      (tails (map (fn (c) (rest c)) remaining)))
                    (continue-with-call
                      f
                      heads
                      fenv
                      (list)
                      (kont-push
                        (make-multi-map-frame f tails new-results fenv)
                        rest-k))))))
            ("callcc"
              (let
                ((k (make-callcc-continuation rest-k (len *winders*))))
                (continue-with-call
                  value
                  (list k)
                  (get frame "env")
                  (list k)
                  rest-k)))
            ("vm-resume"
              (let
                ((resume-fn (get frame "f")))
                (let
                  ((result (apply resume-fn (list value))))
                  (if
                    (and (dict? result) (get result "__vm_suspended"))
                    (make-cek-suspended
                      (get result "request")
                      (get frame "env")
                      (kont-push
                        (make-vm-resume-frame
                          (get result "resume")
                          (get frame "env"))
                        rest-k))
                    (make-cek-value result (get frame "env") rest-k)))))
            ("perform" (make-cek-suspended value (get frame "env") rest-k))
            ("import"
              (let
                ((import-set (get frame "args"))
                  (remaining-sets (get frame "remaining"))
                  (fenv (get frame "env")))
                (do
                  (bind-import-set import-set fenv)
                  (if
                    (empty? remaining-sets)
                    (make-cek-value nil fenv rest-k)
                    (step-sf-import remaining-sets fenv rest-k)))))
            ("parameterize"
              (let
                ((remaining (get frame "remaining"))
                  (current-param (get frame "f"))
                  (results (get frame "results"))
                  (body (get frame "body"))
                  (fenv (get frame "env")))
                (if
                  (nil? current-param)
                  (let
                    ((param-obj value)
                      (val-expr (nth (first remaining) 1)))
                    (make-cek-state
                      val-expr
                      fenv
                      (kont-push
                        (make-parameterize-frame
                          remaining
                          param-obj
                          results
                          body
                          fenv)
                        rest-k)))
                  (let
                    ((converted-val value)
                      (new-results
                        (append
                          results
                          (list
                            (list (parameter-uid current-param) converted-val))))
                      (rest-bindings (rest remaining)))
                    (if
                      (empty? rest-bindings)
                      (let
                        ((body-expr (if (= (len body) 1) (first body) (cons (quote begin) body)))
                          (provide-kont
                            (kont-push-provides new-results fenv rest-k)))
                        (make-cek-state body-expr fenv provide-kont))
                      (make-cek-state
                        (first (first rest-bindings))
                        fenv
                        (kont-push
                          (make-parameterize-frame
                            rest-bindings
                            nil
                            new-results
                            body
                            fenv)
                          rest-k)))))))
            (_
              (do
                (set! *last-error-kont* rest-k)
                (error (str "Unknown frame type: " ft))))))))))

(define
  continue-with-call
  (fn
    (f args env raw-args kont)
    (cond
      (parameter? f)
      (let
        ((uid (parameter-uid f)) (frame (kont-find-provide kont uid)))
        (make-cek-value
          (if frame (get frame "value") (parameter-default f))
          env
          kont))
      (callcc-continuation? f)
      (let
        ((arg (if (empty? args) nil (first args)))
          (captured (callcc-continuation-data f))
          (w-len (callcc-continuation-winders-len f)))
        (do (wind-escape-to w-len) (make-cek-value arg env captured)))
      (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)))
      (let
        ((result (sx-apply-cek f args)))
        (cond
          (eval-error? result)
          (make-cek-value
            (get result "message")
            env
            (kont-push (make-raise-eval-frame env false) kont))
          (and (dict? result) (get result "__vm_suspended"))
          (make-cek-suspended
            (get result "request")
            env
            (kont-push (make-vm-resume-frame (get result "resume") env) kont))
          :else (make-cek-value result env kont)))
      (lambda? f)
      (let
        ((params (lambda-params f))
          (local (env-merge (lambda-closure f) env)))
        (when
          (not (bind-lambda-params params args local))
          (when
            (> (len args) (len params))
            (error
              (str
                (or (lambda-name f) "lambda")
                " expects "
                (len params)
                " args, got "
                (len args))))
          (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))))
        (let
          ((jit-result (jit-try-call f args)))
          (cond
            (jit-skip? jit-result)
            (make-cek-state (lambda-body f) local kont)
            (and (dict? jit-result) (get jit-result "__vm_suspended"))
            (make-cek-suspended
              (get jit-result "request")
              env
              (kont-push
                (make-vm-resume-frame (get jit-result "resume") env)
                kont))
            :else (make-cek-value jit-result 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))))))

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

(define
  eval-expr-cek
  (fn (expr env) (cek-run (make-cek-state expr env (list)))))

(define
  trampoline-cek
  (fn
    (val)
    (if (thunk? val) (eval-expr-cek (thunk-expr val) (thunk-env val)) val)))

(define make-coroutine (fn (thunk) {:suspension nil :thunk thunk :type "coroutine" :state "ready"}))

(define
  eval-expr
  (fn (expr (env :as dict)) (cek-run (make-cek-state expr env (list)))))

(define
  trampoline
  (fn
    (val)
    (if (thunk? val) (eval-expr (thunk-expr val) (thunk-env val)) val)))

;; Phase 12: gensym + symbol interning

(define *gensym-counter* 0)

(define
  gensym
  (fn
    (&rest args)
    (let
      ((prefix (if (empty? args) "g" (str (first args)))))
      (do
        (set! *gensym-counter* (+ *gensym-counter* 1))
        (make-symbol (str prefix *gensym-counter*))))))

(define string->symbol (fn (s) (make-symbol s)))

(define symbol->string (fn (sym) (symbol-name sym)))

(define intern (fn (s) (make-symbol s)))

(define symbol-interned? (fn (sym) true))

(define integer->char make-char)
