diff --git a/hosts/ocaml/bin/dune b/hosts/ocaml/bin/dune
new file mode 100644
index 0000000..b9f922b
--- /dev/null
+++ b/hosts/ocaml/bin/dune
@@ -0,0 +1,3 @@
+(executable
+ (name run_tests)
+ (libraries sx))
diff --git a/hosts/ocaml/bin/run_tests.ml b/hosts/ocaml/bin/run_tests.ml
new file mode 100644
index 0000000..40ddce2
--- /dev/null
+++ b/hosts/ocaml/bin/run_tests.ml
@@ -0,0 +1,177 @@
+(** Minimal test runner — verifies the OCaml foundation (types, parser, primitives).
+
+    Eventually this will load test-framework.sx and run the full spec test
+    suite against the transpiled evaluator. For now it exercises the parser
+    and primitives directly. *)
+
+open Sx.Sx_types
+open Sx.Sx_parser
+open Sx.Sx_primitives
+
+let pass_count = ref 0
+let fail_count = ref 0
+
+let assert_eq name expected actual =
+  if expected = actual then begin
+    incr pass_count;
+    Printf.printf "  PASS: %s\n" name
+  end else begin
+    incr fail_count;
+    Printf.printf "  FAIL: %s — expected %s, got %s\n" name (inspect expected) (inspect actual)
+  end
+
+let assert_true name v =
+  if sx_truthy v then begin
+    incr pass_count;
+    Printf.printf "  PASS: %s\n" name
+  end else begin
+    incr fail_count;
+    Printf.printf "  FAIL: %s — expected truthy, got %s\n" name (inspect v)
+  end
+
+let call name args =
+  match Hashtbl.find_opt primitives name with
+  | Some f -> f args
+  | None -> failwith ("Unknown primitive: " ^ name)
+
+let () =
+  Printf.printf "=== SX OCaml Foundation Tests ===\n\n";
+
+  (* --- Parser tests --- *)
+  Printf.printf "Suite: parser\n";
+
+  let exprs = parse_all "42" in
+  assert_eq "number" (Number 42.0) (List.hd exprs);
+
+  let exprs = parse_all "\"hello\"" in
+  assert_eq "string" (String "hello") (List.hd exprs);
+
+  let exprs = parse_all "true" in
+  assert_eq "bool true" (Bool true) (List.hd exprs);
+
+  let exprs = parse_all "nil" in
+  assert_eq "nil" Nil (List.hd exprs);
+
+  let exprs = parse_all ":class" in
+  assert_eq "keyword" (Keyword "class") (List.hd exprs);
+
+  let exprs = parse_all "foo" in
+  assert_eq "symbol" (Symbol "foo") (List.hd exprs);
+
+  let exprs = parse_all "(+ 1 2)" in
+  assert_eq "list" (List [Symbol "+"; Number 1.0; Number 2.0]) (List.hd exprs);
+
+  let exprs = parse_all "(div :class \"card\" (p \"hi\"))" in
+  (match List.hd exprs with
+   | List [Symbol "div"; Keyword "class"; String "card"; List [Symbol "p"; String "hi"]] ->
+     incr pass_count; Printf.printf "  PASS: nested list\n"
+   | v -> incr fail_count; Printf.printf "  FAIL: nested list — got %s\n" (inspect v));
+
+  let exprs = parse_all "'(1 2 3)" in
+  (match List.hd exprs with
+   | List [Symbol "quote"; List [Number 1.0; Number 2.0; Number 3.0]] ->
+     incr pass_count; Printf.printf "  PASS: quote sugar\n"
+   | v -> incr fail_count; Printf.printf "  FAIL: quote sugar — got %s\n" (inspect v));
+
+  let exprs = parse_all "{:a 1 :b 2}" in
+  (match List.hd exprs with
+   | Dict d when dict_has d "a" && dict_has d "b" ->
+     incr pass_count; Printf.printf "  PASS: dict literal\n"
+   | v -> incr fail_count; Printf.printf "  FAIL: dict literal — got %s\n" (inspect v));
+
+  let exprs = parse_all ";; comment\n42" in
+  assert_eq "comment" (Number 42.0) (List.hd exprs);
+
+  let exprs = parse_all "(fn (x) (+ x 1))" in
+  (match List.hd exprs with
+   | List [Symbol "fn"; List [Symbol "x"]; List [Symbol "+"; Symbol "x"; Number 1.0]] ->
+     incr pass_count; Printf.printf "  PASS: fn form\n"
+   | v -> incr fail_count; Printf.printf "  FAIL: fn form — got %s\n" (inspect v));
+
+  let exprs = parse_all "\"hello\\nworld\"" in
+  assert_eq "string escape" (String "hello\nworld") (List.hd exprs);
+
+  let exprs = parse_all "(1 2 3) (4 5)" in
+  assert_eq "multiple exprs" (Number 2.0) (Number (float_of_int (List.length exprs)));
+
+  Printf.printf "\nSuite: primitives\n";
+
+  (* --- Primitive tests --- *)
+  assert_eq "+" (Number 6.0) (call "+" [Number 1.0; Number 2.0; Number 3.0]);
+  assert_eq "-" (Number 3.0) (call "-" [Number 5.0; Number 2.0]);
+  assert_eq "*" (Number 12.0) (call "*" [Number 3.0; Number 4.0]);
+  assert_eq "/" (Number 2.5) (call "/" [Number 5.0; Number 2.0]);
+  assert_eq "mod" (Number 1.0) (call "mod" [Number 5.0; Number 2.0]);
+  assert_eq "inc" (Number 6.0) (call "inc" [Number 5.0]);
+  assert_eq "abs" (Number 5.0) (call "abs" [Number (-5.0)]);
+
+  assert_true "=" (call "=" [Number 1.0; Number 1.0]);
+  assert_true "!=" (call "!=" [Number 1.0; Number 2.0]);
+  assert_true "<" (call "<" [Number 1.0; Number 2.0]);
+  assert_true ">" (call ">" [Number 2.0; Number 1.0]);
+
+  assert_true "nil?" (call "nil?" [Nil]);
+  assert_true "number?" (call "number?" [Number 1.0]);
+  assert_true "string?" (call "string?" [String "hi"]);
+  assert_true "list?" (call "list?" [List [Number 1.0]]);
+  assert_true "empty? list" (call "empty?" [List []]);
+  assert_true "empty? string" (call "empty?" [String ""]);
+
+  assert_eq "str" (String "hello42") (call "str" [String "hello"; Number 42.0]);
+  assert_eq "upper" (String "HI") (call "upper" [String "hi"]);
+  assert_eq "trim" (String "hi") (call "trim" [String "  hi  "]);
+  assert_eq "join" (String "a,b,c") (call "join" [String ","; List [String "a"; String "b"; String "c"]]);
+  assert_true "starts-with?" (call "starts-with?" [String "hello"; String "hel"]);
+  assert_true "contains?" (call "contains?" [List [Number 1.0; Number 2.0; Number 3.0]; Number 2.0]);
+
+  assert_eq "list" (List [Number 1.0; Number 2.0]) (call "list" [Number 1.0; Number 2.0]);
+  assert_eq "len" (Number 3.0) (call "len" [List [Number 1.0; Number 2.0; Number 3.0]]);
+  assert_eq "first" (Number 1.0) (call "first" [List [Number 1.0; Number 2.0]]);
+  assert_eq "rest" (List [Number 2.0; Number 3.0]) (call "rest" [List [Number 1.0; Number 2.0; Number 3.0]]);
+  assert_eq "nth" (Number 2.0) (call "nth" [List [Number 1.0; Number 2.0]; Number 1.0]);
+  assert_eq "cons" (List [Number 0.0; Number 1.0]) (call "cons" [Number 0.0; List [Number 1.0]]);
+  assert_eq "append" (List [Number 1.0; Number 2.0; Number 3.0])
+    (call "append" [List [Number 1.0]; List [Number 2.0; Number 3.0]]);
+  assert_eq "reverse" (List [Number 3.0; Number 2.0; Number 1.0])
+    (call "reverse" [List [Number 1.0; Number 2.0; Number 3.0]]);
+  assert_eq "range" (List [Number 0.0; Number 1.0; Number 2.0]) (call "range" [Number 3.0]);
+  assert_eq "slice" (List [Number 2.0; Number 3.0]) (call "slice" [List [Number 1.0; Number 2.0; Number 3.0]; Number 1.0]);
+
+  assert_eq "type-of" (String "number") (call "type-of" [Number 1.0]);
+  assert_eq "type-of nil" (String "nil") (call "type-of" [Nil]);
+
+  Printf.printf "\nSuite: env\n";
+
+  (* --- Environment tests --- *)
+  let e = make_env () in
+  ignore (env_bind e "x" (Number 42.0));
+  assert_eq "env-bind + get" (Number 42.0) (env_get e "x");
+  assert_true "env-has" (Bool (env_has e "x"));
+
+  let child = env_extend e in
+  ignore (env_bind child "y" (Number 10.0));
+  assert_eq "child sees parent" (Number 42.0) (env_get child "x");
+  assert_eq "child own binding" (Number 10.0) (env_get child "y");
+
+  ignore (env_set child "x" (Number 99.0));
+  assert_eq "set! walks chain" (Number 99.0) (env_get e "x");
+
+  Printf.printf "\nSuite: types\n";
+
+  (* --- Type tests --- *)
+  assert_true "sx_truthy true" (Bool (sx_truthy (Bool true)));
+  assert_true "sx_truthy 0" (Bool (sx_truthy (Number 0.0)));
+  assert_true "sx_truthy \"\"" (Bool (sx_truthy (String "")));
+  assert_eq "not truthy nil" (Bool false) (Bool (sx_truthy Nil));
+  assert_eq "not truthy false" (Bool false) (Bool (sx_truthy (Bool false)));
+
+  let l = { l_params = ["x"]; l_body = Symbol "x"; l_closure = make_env (); l_name = None } in
+  assert_true "is_lambda" (Bool (is_lambda (Lambda l)));
+  ignore (Sx.Sx_types.set_lambda_name (Lambda l) "my-fn");
+  assert_eq "lambda name mutated" (String "my-fn") (lambda_name (Lambda l));
+
+  (* --- Summary --- *)
+  Printf.printf "\n============================================================\n";
+  Printf.printf "Results: %d passed, %d failed\n" !pass_count !fail_count;
+  Printf.printf "============================================================\n";
+  if !fail_count > 0 then exit 1
diff --git a/hosts/ocaml/bootstrap.py b/hosts/ocaml/bootstrap.py
new file mode 100644
index 0000000..89d5bbf
--- /dev/null
+++ b/hosts/ocaml/bootstrap.py
@@ -0,0 +1,150 @@
+#!/usr/bin/env python3
+"""
+Bootstrap compiler: SX spec -> OCaml.
+
+Loads the SX-to-OCaml transpiler (transpiler.sx), feeds it the spec files,
+and produces sx_ref.ml — the transpiled evaluator as native OCaml.
+
+Usage:
+    python3 hosts/ocaml/bootstrap.py --output hosts/ocaml/lib/sx_ref.ml
+"""
+from __future__ import annotations
+
+import os
+import sys
+
+_HERE = os.path.dirname(os.path.abspath(__file__))
+_PROJECT = os.path.abspath(os.path.join(_HERE, "..", ".."))
+sys.path.insert(0, _PROJECT)
+
+from shared.sx.parser import parse_all
+from shared.sx.types import Symbol
+
+
+def extract_defines(source: str) -> list[tuple[str, list]]:
+    """Parse .sx source, return list of (name, define-expr) for top-level defines."""
+    exprs = parse_all(source)
+    defines = []
+    for expr in exprs:
+        if isinstance(expr, list) and expr and isinstance(expr[0], Symbol):
+            if expr[0].name == "define":
+                name = expr[1].name if isinstance(expr[1], Symbol) else str(expr[1])
+                defines.append((name, expr))
+    return defines
+
+
+# OCaml preamble — opens and runtime helpers
+PREAMBLE = """\
+(* sx_ref.ml — Auto-generated from SX spec by hosts/ocaml/bootstrap.py *)
+(* Do not edit — regenerate with: python3 hosts/ocaml/bootstrap.py *)
+
+[@@@warning "-26-27"]
+
+open Sx_types
+open Sx_runtime
+
+(* Trampoline — evaluates thunks via the CEK machine.
+   eval_expr is defined in the transpiled block below. *)
+let trampoline v = v  (* CEK machine doesn't produce thunks *)
+
+"""
+
+
+# OCaml fixups — override iterative CEK run
+FIXUPS = """\
+
+(* Override recursive cek_run with iterative loop *)
+let cek_run_iterative state =
+  let s = ref state in
+  while not (match cek_terminal_p !s with Bool true -> true | _ -> false) do
+    s := cek_step !s
+  done;
+  cek_value !s
+
+"""
+
+
+def compile_spec_to_ml(spec_dir: str | None = None) -> str:
+    """Compile the SX spec to OCaml source."""
+    from shared.sx.ref.sx_ref import eval_expr, trampoline, make_env, sx_parse
+
+    if spec_dir is None:
+        spec_dir = os.path.join(_PROJECT, "spec")
+
+    # Load the transpiler
+    env = make_env()
+    transpiler_path = os.path.join(_HERE, "transpiler.sx")
+    with open(transpiler_path) as f:
+        transpiler_src = f.read()
+    for expr in sx_parse(transpiler_src):
+        trampoline(eval_expr(expr, env))
+
+    # Spec files to transpile (in dependency order)
+    sx_files = [
+        ("evaluator.sx", "evaluator (frames + eval + CEK)"),
+    ]
+
+    parts = [PREAMBLE]
+
+    for filename, label in sx_files:
+        filepath = os.path.join(spec_dir, filename)
+        if not os.path.exists(filepath):
+            print(f"Warning: {filepath} not found, skipping", file=sys.stderr)
+            continue
+
+        with open(filepath) as f:
+            src = f.read()
+        defines = extract_defines(src)
+
+        # Skip defines provided by preamble or fixups
+        skip = {"trampoline"}
+        defines = [(n, e) for n, e in defines if n not in skip]
+
+        # Deduplicate — keep last definition for each name (CEK overrides tree-walk)
+        seen = {}
+        for i, (n, e) in enumerate(defines):
+            seen[n] = i
+        defines = [(n, e) for i, (n, e) in enumerate(defines) if seen[n] == i]
+
+        # Build the defines list for the transpiler
+        defines_list = [[name, expr] for name, expr in defines]
+        env["_defines"] = defines_list
+
+        # Pass known define names so the transpiler can distinguish
+        # static (OCaml fn) calls from dynamic (SX value) calls
+        env["_known_defines"] = [name for name, _ in defines]
+
+        # Call ml-translate-file — emits as single let rec block
+        translate_expr = sx_parse("(ml-translate-file _defines)")[0]
+        result = trampoline(eval_expr(translate_expr, env))
+
+        parts.append(f"\n(* === Transpiled from {label} === *)\n")
+        parts.append(result)
+
+    parts.append(FIXUPS)
+    return "\n".join(parts)
+
+
+def main():
+    import argparse
+    parser = argparse.ArgumentParser(description="Bootstrap SX spec -> OCaml")
+    parser.add_argument(
+        "--output", "-o",
+        default=None,
+        help="Output file (default: stdout)",
+    )
+    args = parser.parse_args()
+
+    result = compile_spec_to_ml()
+
+    if args.output:
+        with open(args.output, "w") as f:
+            f.write(result)
+        size = os.path.getsize(args.output)
+        print(f"Wrote {args.output} ({size} bytes)", file=sys.stderr)
+    else:
+        print(result)
+
+
+if __name__ == "__main__":
+    main()
diff --git a/hosts/ocaml/dune-project b/hosts/ocaml/dune-project
new file mode 100644
index 0000000..50354e0
--- /dev/null
+++ b/hosts/ocaml/dune-project
@@ -0,0 +1,2 @@
+(lang dune 3.0)
+(name sx)
diff --git a/hosts/ocaml/lib/dune b/hosts/ocaml/lib/dune
new file mode 100644
index 0000000..be36fed
--- /dev/null
+++ b/hosts/ocaml/lib/dune
@@ -0,0 +1,2 @@
+(library
+ (name sx))
diff --git a/hosts/ocaml/lib/sx_parser.ml b/hosts/ocaml/lib/sx_parser.ml
new file mode 100644
index 0000000..a44d012
--- /dev/null
+++ b/hosts/ocaml/lib/sx_parser.ml
@@ -0,0 +1,181 @@
+(** S-expression parser.
+
+    Recursive descent over a string, producing [Sx_types.value list].
+    Supports: lists, dicts, symbols, keywords, strings (with escapes),
+    numbers, booleans, nil, comments, quote/quasiquote/unquote sugar. *)
+
+open Sx_types
+
+type state = {
+  src : string;
+  len : int;
+  mutable pos : int;
+}
+
+let make_state src = { src; len = String.length src; pos = 0 }
+
+let peek s = if s.pos < s.len then Some s.src.[s.pos] else None
+let advance s = s.pos <- s.pos + 1
+let at_end s = s.pos >= s.len
+
+let skip_whitespace_and_comments s =
+  let rec go () =
+    if at_end s then ()
+    else match s.src.[s.pos] with
+    | ' ' | '\t' | '\n' | '\r' | ',' -> advance s; go ()
+    | ';' ->
+      while s.pos < s.len && s.src.[s.pos] <> '\n' do advance s done;
+      if s.pos < s.len then advance s;
+      go ()
+    | _ -> ()
+  in go ()
+
+let is_symbol_char = function
+  | '(' | ')' | '[' | ']' | '{' | '}' | '"' | '\'' | '`'
+  | ' ' | '\t' | '\n' | '\r' | ',' | ';' -> false
+  | _ -> true
+
+let read_string s =
+  (* s.pos is on the opening quote *)
+  advance s;
+  let buf = Buffer.create 64 in
+  let rec go () =
+    if at_end s then raise (Parse_error "Unterminated string");
+    let c = s.src.[s.pos] in
+    advance s;
+    if c = '"' then Buffer.contents buf
+    else if c = '\\' then begin
+      if at_end s then raise (Parse_error "Unterminated string escape");
+      let esc = s.src.[s.pos] in
+      advance s;
+      (match esc with
+       | 'n' -> Buffer.add_char buf '\n'
+       | 't' -> Buffer.add_char buf '\t'
+       | 'r' -> Buffer.add_char buf '\r'
+       | '"' -> Buffer.add_char buf '"'
+       | '\\' -> Buffer.add_char buf '\\'
+       | 'u' ->
+         (* \uXXXX — read 4 hex digits, encode as UTF-8 *)
+         if s.pos + 4 > s.len then raise (Parse_error "Incomplete \\u escape");
+         let hex = String.sub s.src s.pos 4 in
+         s.pos <- s.pos + 4;
+         let code = int_of_string ("0x" ^ hex) in
+         let ubuf = Buffer.create 4 in
+         Buffer.add_utf_8_uchar ubuf (Uchar.of_int code);
+         Buffer.add_string buf (Buffer.contents ubuf)
+       | _ -> Buffer.add_char buf '\\'; Buffer.add_char buf esc);
+      go ()
+    end else begin
+      Buffer.add_char buf c;
+      go ()
+    end
+  in go ()
+
+let read_symbol s =
+  let start = s.pos in
+  while s.pos < s.len && is_symbol_char s.src.[s.pos] do advance s done;
+  String.sub s.src start (s.pos - start)
+
+let try_number str =
+  match float_of_string_opt str with
+  | Some n -> Some (Number n)
+  | None -> None
+
+let rec read_value s : value =
+  skip_whitespace_and_comments s;
+  if at_end s then raise (Parse_error "Unexpected end of input");
+  match s.src.[s.pos] with
+  | '(' -> read_list s ')'
+  | '[' -> read_list s ']'
+  | '{' -> read_dict s
+  | '"' -> String (read_string s)
+  | '\'' -> advance s; List [Symbol "quote"; read_value s]
+  | '`' -> advance s; List [Symbol "quasiquote"; read_value s]
+  | '~' when s.pos + 1 < s.len && s.src.[s.pos + 1] = '@' ->
+    advance s; advance s; (* skip ~@ *)
+    List [Symbol "splice-unquote"; read_value s]
+  | _ ->
+    (* Check for unquote: , followed by non-whitespace *)
+    if s.src.[s.pos] = ',' && s.pos + 1 < s.len &&
+       s.src.[s.pos + 1] <> ' ' && s.src.[s.pos + 1] <> '\n' then begin
+      advance s;
+      if s.pos < s.len && s.src.[s.pos] = '@' then begin
+        advance s;
+        List [Symbol "splice-unquote"; read_value s]
+      end else
+        List [Symbol "unquote"; read_value s]
+    end else begin
+      (* Symbol, keyword, number, or boolean *)
+      let token = read_symbol s in
+      if token = "" then raise (Parse_error ("Unexpected char: " ^ String.make 1 s.src.[s.pos]));
+      match token with
+      | "true" -> Bool true
+      | "false" -> Bool false
+      | "nil" -> Nil
+      | _ when token.[0] = ':' ->
+        Keyword (String.sub token 1 (String.length token - 1))
+      | _ ->
+        match try_number token with
+        | Some n -> n
+        | None -> Symbol token
+    end
+
+and read_list s close_char =
+  advance s; (* skip opening paren/bracket *)
+  let items = ref [] in
+  let rec go () =
+    skip_whitespace_and_comments s;
+    if at_end s then raise (Parse_error "Unterminated list");
+    if s.src.[s.pos] = close_char then begin
+      advance s;
+      List (List.rev !items)
+    end else begin
+      items := read_value s :: !items;
+      go ()
+    end
+  in go ()
+
+and read_dict s =
+  advance s; (* skip { *)
+  let d = make_dict () in
+  let rec go () =
+    skip_whitespace_and_comments s;
+    if at_end s then raise (Parse_error "Unterminated dict");
+    if s.src.[s.pos] = '}' then begin
+      advance s;
+      Dict d
+    end else begin
+      let key = read_value s in
+      let key_str = match key with
+        | Keyword k -> k
+        | String k -> k
+        | Symbol k -> k
+        | _ -> raise (Parse_error "Dict key must be keyword, string, or symbol")
+      in
+      let v = read_value s in
+      dict_set d key_str v;
+      go ()
+    end
+  in go ()
+
+
+(** Parse a string into a list of SX values. *)
+let parse_all src =
+  let s = make_state src in
+  let results = ref [] in
+  let rec go () =
+    skip_whitespace_and_comments s;
+    if at_end s then List.rev !results
+    else begin
+      results := read_value s :: !results;
+      go ()
+    end
+  in go ()
+
+(** Parse a file into a list of SX values. *)
+let parse_file path =
+  let ic = open_in path in
+  let n = in_channel_length ic in
+  let src = really_input_string ic n in
+  close_in ic;
+  parse_all src
diff --git a/hosts/ocaml/lib/sx_primitives.ml b/hosts/ocaml/lib/sx_primitives.ml
new file mode 100644
index 0000000..39df158
--- /dev/null
+++ b/hosts/ocaml/lib/sx_primitives.ml
@@ -0,0 +1,524 @@
+(** Built-in primitive functions (~80 pure functions).
+
+    Registered in a global table; the evaluator checks this table
+    when a symbol isn't found in the lexical environment. *)
+
+open Sx_types
+
+let primitives : (string, value list -> value) Hashtbl.t = Hashtbl.create 128
+
+let register name fn = Hashtbl.replace primitives name fn
+
+let is_primitive name = Hashtbl.mem primitives name
+
+let get_primitive name =
+  match Hashtbl.find_opt primitives name with
+  | Some fn -> NativeFn (name, fn)
+  | None -> raise (Eval_error ("Unknown primitive: " ^ name))
+
+(* --- Helpers --- *)
+
+let as_number = function
+  | Number n -> n
+  | v -> raise (Eval_error ("Expected number, got " ^ type_of v))
+
+let as_string = function
+  | String s -> s
+  | v -> raise (Eval_error ("Expected string, got " ^ type_of v))
+
+let as_list = function
+  | List l -> l
+  | v -> raise (Eval_error ("Expected list, got " ^ type_of v))
+
+let as_bool = function
+  | Bool b -> b
+  | v -> sx_truthy v
+
+let to_string = function
+  | String s -> s
+  | Number n ->
+    if Float.is_integer n then string_of_int (int_of_float n)
+    else Printf.sprintf "%g" n
+  | Bool true -> "true"
+  | Bool false -> "false"
+  | Nil -> ""
+  | Symbol s -> s
+  | Keyword k -> k
+  | v -> inspect v
+
+let () =
+  (* === Arithmetic === *)
+  register "+" (fun args ->
+    Number (List.fold_left (fun acc a -> acc +. as_number a) 0.0 args));
+  register "-" (fun args ->
+    match args with
+    | [] -> Number 0.0
+    | [a] -> Number (-. (as_number a))
+    | a :: rest -> Number (List.fold_left (fun acc x -> acc -. as_number x) (as_number a) rest));
+  register "*" (fun args ->
+    Number (List.fold_left (fun acc a -> acc *. as_number a) 1.0 args));
+  register "/" (fun args ->
+    match args with
+    | [a; b] -> Number (as_number a /. as_number b)
+    | _ -> raise (Eval_error "/: expected 2 args"));
+  register "mod" (fun args ->
+    match args with
+    | [a; b] -> Number (Float.rem (as_number a) (as_number b))
+    | _ -> raise (Eval_error "mod: expected 2 args"));
+  register "inc" (fun args ->
+    match args with [a] -> Number (as_number a +. 1.0) | _ -> raise (Eval_error "inc: 1 arg"));
+  register "dec" (fun args ->
+    match args with [a] -> Number (as_number a -. 1.0) | _ -> raise (Eval_error "dec: 1 arg"));
+  register "abs" (fun args ->
+    match args with [a] -> Number (Float.abs (as_number a)) | _ -> raise (Eval_error "abs: 1 arg"));
+  register "floor" (fun args ->
+    match args with [a] -> Number (Float.of_int (int_of_float (Float.round (as_number a -. 0.5))))
+    | _ -> raise (Eval_error "floor: 1 arg"));
+  register "ceil" (fun args ->
+    match args with [a] -> Number (Float.of_int (int_of_float (Float.round (as_number a +. 0.5))))
+    | _ -> raise (Eval_error "ceil: 1 arg"));
+  register "round" (fun args ->
+    match args with
+    | [a] -> Number (Float.round (as_number a))
+    | [a; b] ->
+      let n = as_number a and places = int_of_float (as_number b) in
+      let factor = 10.0 ** float_of_int places in
+      Number (Float.round (n *. factor) /. factor)
+    | _ -> raise (Eval_error "round: 1-2 args"));
+  register "min" (fun args ->
+    match args with
+    | [] -> raise (Eval_error "min: at least 1 arg")
+    | _ -> Number (List.fold_left (fun acc a -> Float.min acc (as_number a)) Float.infinity args));
+  register "max" (fun args ->
+    match args with
+    | [] -> raise (Eval_error "max: at least 1 arg")
+    | _ -> Number (List.fold_left (fun acc a -> Float.max acc (as_number a)) Float.neg_infinity args));
+  register "sqrt" (fun args ->
+    match args with [a] -> Number (Float.sqrt (as_number a)) | _ -> raise (Eval_error "sqrt: 1 arg"));
+  register "pow" (fun args ->
+    match args with [a; b] -> Number (as_number a ** as_number b)
+    | _ -> raise (Eval_error "pow: 2 args"));
+  register "clamp" (fun args ->
+    match args with
+    | [x; lo; hi] ->
+      let x = as_number x and lo = as_number lo and hi = as_number hi in
+      Number (Float.max lo (Float.min hi x))
+    | _ -> raise (Eval_error "clamp: 3 args"));
+  register "parse-int" (fun args ->
+    match args with
+    | [String s] -> (match int_of_string_opt s with Some n -> Number (float_of_int n) | None -> Nil)
+    | [Number n] -> Number (float_of_int (int_of_float n))
+    | _ -> Nil);
+  register "parse-float" (fun args ->
+    match args with
+    | [String s] -> (match float_of_string_opt s with Some n -> Number n | None -> Nil)
+    | [Number n] -> Number n
+    | _ -> Nil);
+
+  (* === Comparison === *)
+  register "=" (fun args ->
+    match args with [a; b] -> Bool (a = b) | _ -> raise (Eval_error "=: 2 args"));
+  register "!=" (fun args ->
+    match args with [a; b] -> Bool (a <> b) | _ -> raise (Eval_error "!=: 2 args"));
+  register "<" (fun args ->
+    match args with [a; b] -> Bool (as_number a < as_number b) | _ -> raise (Eval_error "<: 2 args"));
+  register ">" (fun args ->
+    match args with [a; b] -> Bool (as_number a > as_number b) | _ -> raise (Eval_error ">: 2 args"));
+  register "<=" (fun args ->
+    match args with [a; b] -> Bool (as_number a <= as_number b) | _ -> raise (Eval_error "<=: 2 args"));
+  register ">=" (fun args ->
+    match args with [a; b] -> Bool (as_number a >= as_number b) | _ -> raise (Eval_error ">=: 2 args"));
+
+  (* === Logic === *)
+  register "not" (fun args ->
+    match args with [a] -> Bool (not (sx_truthy a)) | _ -> raise (Eval_error "not: 1 arg"));
+
+  (* === Predicates === *)
+  register "nil?" (fun args ->
+    match args with [a] -> Bool (is_nil a) | _ -> raise (Eval_error "nil?: 1 arg"));
+  register "number?" (fun args ->
+    match args with [Number _] -> Bool true | [_] -> Bool false | _ -> raise (Eval_error "number?: 1 arg"));
+  register "string?" (fun args ->
+    match args with [String _] -> Bool true | [_] -> Bool false | _ -> raise (Eval_error "string?: 1 arg"));
+  register "boolean?" (fun args ->
+    match args with [Bool _] -> Bool true | [_] -> Bool false | _ -> raise (Eval_error "boolean?: 1 arg"));
+  register "list?" (fun args ->
+    match args with [List _] -> Bool true | [_] -> Bool false | _ -> raise (Eval_error "list?: 1 arg"));
+  register "dict?" (fun args ->
+    match args with [Dict _] -> Bool true | [_] -> Bool false | _ -> raise (Eval_error "dict?: 1 arg"));
+  register "symbol?" (fun args ->
+    match args with [Symbol _] -> Bool true | [_] -> Bool false | _ -> raise (Eval_error "symbol?: 1 arg"));
+  register "keyword?" (fun args ->
+    match args with [Keyword _] -> Bool true | [_] -> Bool false | _ -> raise (Eval_error "keyword?: 1 arg"));
+  register "empty?" (fun args ->
+    match args with
+    | [List []] -> Bool true | [List _] -> Bool false
+    | [String ""] -> Bool true | [String _] -> Bool false
+    | [Dict d] -> Bool (Hashtbl.length d = 0)
+    | [Nil] -> Bool true
+    | [_] -> Bool false
+    | _ -> raise (Eval_error "empty?: 1 arg"));
+  register "odd?" (fun args ->
+    match args with [a] -> Bool (int_of_float (as_number a) mod 2 <> 0) | _ -> raise (Eval_error "odd?: 1 arg"));
+  register "even?" (fun args ->
+    match args with [a] -> Bool (int_of_float (as_number a) mod 2 = 0) | _ -> raise (Eval_error "even?: 1 arg"));
+  register "zero?" (fun args ->
+    match args with [a] -> Bool (as_number a = 0.0) | _ -> raise (Eval_error "zero?: 1 arg"));
+
+  (* === Strings === *)
+  register "str" (fun args -> String (String.concat "" (List.map to_string args)));
+  register "upper" (fun args ->
+    match args with [a] -> String (String.uppercase_ascii (as_string a)) | _ -> raise (Eval_error "upper: 1 arg"));
+  register "upcase" (fun args ->
+    match args with [a] -> String (String.uppercase_ascii (as_string a)) | _ -> raise (Eval_error "upcase: 1 arg"));
+  register "lower" (fun args ->
+    match args with [a] -> String (String.lowercase_ascii (as_string a)) | _ -> raise (Eval_error "lower: 1 arg"));
+  register "downcase" (fun args ->
+    match args with [a] -> String (String.lowercase_ascii (as_string a)) | _ -> raise (Eval_error "downcase: 1 arg"));
+  register "trim" (fun args ->
+    match args with [a] -> String (String.trim (as_string a)) | _ -> raise (Eval_error "trim: 1 arg"));
+  register "string-length" (fun args ->
+    match args with [a] -> Number (float_of_int (String.length (as_string a)))
+    | _ -> raise (Eval_error "string-length: 1 arg"));
+  register "string-contains?" (fun args ->
+    match args with
+    | [String haystack; String needle] ->
+      let rec find i =
+        if i + String.length needle > String.length haystack then false
+        else if String.sub haystack i (String.length needle) = needle then true
+        else find (i + 1)
+      in Bool (find 0)
+    | _ -> raise (Eval_error "string-contains?: 2 string args"));
+  register "starts-with?" (fun args ->
+    match args with
+    | [String s; String prefix] ->
+      Bool (String.length s >= String.length prefix &&
+            String.sub s 0 (String.length prefix) = prefix)
+    | _ -> raise (Eval_error "starts-with?: 2 string args"));
+  register "ends-with?" (fun args ->
+    match args with
+    | [String s; String suffix] ->
+      let sl = String.length s and xl = String.length suffix in
+      Bool (sl >= xl && String.sub s (sl - xl) xl = suffix)
+    | _ -> raise (Eval_error "ends-with?: 2 string args"));
+  register "index-of" (fun args ->
+    match args with
+    | [String haystack; String needle] ->
+      let nl = String.length needle and hl = String.length haystack in
+      let rec find i =
+        if i + nl > hl then Number (-1.0)
+        else if String.sub haystack i nl = needle then Number (float_of_int i)
+        else find (i + 1)
+      in find 0
+    | _ -> raise (Eval_error "index-of: 2 string args"));
+  register "substring" (fun args ->
+    match args with
+    | [String s; Number start; Number end_] ->
+      let i = int_of_float start and j = int_of_float end_ in
+      let len = String.length s in
+      let i = max 0 (min i len) and j = max 0 (min j len) in
+      String (String.sub s i (max 0 (j - i)))
+    | _ -> raise (Eval_error "substring: 3 args"));
+  register "substr" (fun args ->
+    match args with
+    | [String s; Number start; Number len] ->
+      let i = int_of_float start and n = int_of_float len in
+      let sl = String.length s in
+      let i = max 0 (min i sl) in
+      let n = max 0 (min n (sl - i)) in
+      String (String.sub s i n)
+    | [String s; Number start] ->
+      let i = int_of_float start in
+      let sl = String.length s in
+      let i = max 0 (min i sl) in
+      String (String.sub s i (sl - i))
+    | _ -> raise (Eval_error "substr: 2-3 args"));
+  register "split" (fun args ->
+    match args with
+    | [String s; String sep] ->
+      List (List.map (fun p -> String p) (String.split_on_char sep.[0] s))
+    | _ -> raise (Eval_error "split: 2 args"));
+  register "join" (fun args ->
+    match args with
+    | [String sep; List items] -> String (String.concat sep (List.map to_string items))
+    | _ -> raise (Eval_error "join: 2 args"));
+  register "replace" (fun args ->
+    match args with
+    | [String s; String old_s; String new_s] ->
+      let ol = String.length old_s in
+      if ol = 0 then String s
+      else begin
+        let buf = Buffer.create (String.length s) in
+        let rec go i =
+          if i >= String.length s then ()
+          else if i + ol <= String.length s && String.sub s i ol = old_s then begin
+            Buffer.add_string buf new_s;
+            go (i + ol)
+          end else begin
+            Buffer.add_char buf s.[i];
+            go (i + 1)
+          end
+        in go 0;
+        String (Buffer.contents buf)
+      end
+    | _ -> raise (Eval_error "replace: 3 string args"));
+  register "char-from-code" (fun args ->
+    match args with
+    | [Number n] ->
+      let buf = Buffer.create 4 in
+      Buffer.add_utf_8_uchar buf (Uchar.of_int (int_of_float n));
+      String (Buffer.contents buf)
+    | _ -> raise (Eval_error "char-from-code: 1 arg"));
+
+  (* === Collections === *)
+  register "list" (fun args -> List args);
+  register "len" (fun args ->
+    match args with
+    | [List l] -> Number (float_of_int (List.length l))
+    | [String s] -> Number (float_of_int (String.length s))
+    | [Dict d] -> Number (float_of_int (Hashtbl.length d))
+    | _ -> raise (Eval_error "len: 1 arg"));
+  register "first" (fun args ->
+    match args with
+    | [List (x :: _)] -> x | [List []] -> Nil
+    | _ -> raise (Eval_error "first: 1 list arg"));
+  register "rest" (fun args ->
+    match args with
+    | [List (_ :: xs)] -> List xs | [List []] -> List []
+    | _ -> raise (Eval_error "rest: 1 list arg"));
+  register "last" (fun args ->
+    match args with
+    | [List l] -> (match List.rev l with x :: _ -> x | [] -> Nil)
+    | _ -> raise (Eval_error "last: 1 list arg"));
+  register "nth" (fun args ->
+    match args with
+    | [List l; Number n] -> (try List.nth l (int_of_float n) with _ -> Nil)
+    | _ -> raise (Eval_error "nth: list and number"));
+  register "cons" (fun args ->
+    match args with
+    | [x; List l] -> List (x :: l)
+    | _ -> raise (Eval_error "cons: value and list"));
+  register "append" (fun args ->
+    let all = List.concat_map (fun a -> as_list a) args in
+    List all);
+  register "reverse" (fun args ->
+    match args with [List l] -> List (List.rev l) | _ -> raise (Eval_error "reverse: 1 list"));
+  register "flatten" (fun args ->
+    let rec flat = function
+      | List items -> List.concat_map flat items
+      | x -> [x]
+    in
+    match args with [List l] -> List (List.concat_map flat l) | _ -> raise (Eval_error "flatten: 1 list"));
+  register "concat" (fun args -> List (List.concat_map as_list args));
+  register "contains?" (fun args ->
+    match args with
+    | [List l; item] -> Bool (List.mem item l)
+    | [String s; String sub] ->
+      let rec find i =
+        if i + String.length sub > String.length s then false
+        else if String.sub s i (String.length sub) = sub then true
+        else find (i + 1)
+      in Bool (find 0)
+    | _ -> raise (Eval_error "contains?: 2 args"));
+  register "range" (fun args ->
+    match args with
+    | [Number stop] ->
+      let n = int_of_float stop in
+      List (List.init (max 0 n) (fun i -> Number (float_of_int i)))
+    | [Number start; Number stop] ->
+      let s = int_of_float start and e = int_of_float stop in
+      let len = max 0 (e - s) in
+      List (List.init len (fun i -> Number (float_of_int (s + i))))
+    | _ -> raise (Eval_error "range: 1-2 args"));
+  register "slice" (fun args ->
+    match args with
+    | [List l; Number start] ->
+      let i = max 0 (int_of_float start) in
+      let rec drop n = function _ :: xs when n > 0 -> drop (n-1) xs | l -> l in
+      List (drop i l)
+    | [List l; Number start; Number end_] ->
+      let i = max 0 (int_of_float start) and j = int_of_float end_ in
+      let len = List.length l in
+      let j = min j len in
+      let rec take_range idx = function
+        | [] -> []
+        | x :: xs ->
+          if idx >= j then []
+          else if idx >= i then x :: take_range (idx+1) xs
+          else take_range (idx+1) xs
+      in List (take_range 0 l)
+    | [String s; Number start] ->
+      let i = max 0 (int_of_float start) in
+      String (String.sub s i (max 0 (String.length s - i)))
+    | [String s; Number start; Number end_] ->
+      let i = max 0 (int_of_float start) and j = int_of_float end_ in
+      let sl = String.length s in
+      let j = min j sl in
+      String (String.sub s i (max 0 (j - i)))
+    | _ -> raise (Eval_error "slice: 2-3 args"));
+  register "sort" (fun args ->
+    match args with
+    | [List l] -> List (List.sort compare l)
+    | _ -> raise (Eval_error "sort: 1 list"));
+  register "zip" (fun args ->
+    match args with
+    | [List a; List b] ->
+      let rec go l1 l2 acc = match l1, l2 with
+        | x :: xs, y :: ys -> go xs ys (List [x; y] :: acc)
+        | _ -> List.rev acc
+      in List (go a b [])
+    | _ -> raise (Eval_error "zip: 2 lists"));
+  register "zip-pairs" (fun args ->
+    match args with
+    | [List l] ->
+      let rec go = function
+        | a :: b :: rest -> List [a; b] :: go rest
+        | _ -> []
+      in List (go l)
+    | _ -> raise (Eval_error "zip-pairs: 1 list"));
+  register "take" (fun args ->
+    match args with
+    | [List l; Number n] ->
+      let rec take_n i = function
+        | x :: xs when i > 0 -> x :: take_n (i-1) xs
+        | _ -> []
+      in List (take_n (int_of_float n) l)
+    | _ -> raise (Eval_error "take: list and number"));
+  register "drop" (fun args ->
+    match args with
+    | [List l; Number n] ->
+      let rec drop_n i = function
+        | _ :: xs when i > 0 -> drop_n (i-1) xs
+        | l -> l
+      in List (drop_n (int_of_float n) l)
+    | _ -> raise (Eval_error "drop: list and number"));
+  register "chunk-every" (fun args ->
+    match args with
+    | [List l; Number n] ->
+      let size = int_of_float n in
+      let rec go = function
+        | [] -> []
+        | l ->
+          let rec take_n i = function
+            | x :: xs when i > 0 -> x :: take_n (i-1) xs
+            | _ -> []
+          in
+          let rec drop_n i = function
+            | _ :: xs when i > 0 -> drop_n (i-1) xs
+            | l -> l
+          in
+          List (take_n size l) :: go (drop_n size l)
+      in List (go l)
+    | _ -> raise (Eval_error "chunk-every: list and number"));
+  register "unique" (fun args ->
+    match args with
+    | [List l] ->
+      let seen = Hashtbl.create 16 in
+      let result = List.filter (fun x ->
+        let key = inspect x in
+        if Hashtbl.mem seen key then false
+        else (Hashtbl.replace seen key true; true)
+      ) l in
+      List result
+    | _ -> raise (Eval_error "unique: 1 list"));
+
+  (* === Dict === *)
+  register "dict" (fun args ->
+    let d = make_dict () in
+    let rec go = function
+      | [] -> Dict d
+      | Keyword k :: v :: rest -> dict_set d k v; go rest
+      | String k :: v :: rest -> dict_set d k v; go rest
+      | _ -> raise (Eval_error "dict: pairs of key value")
+    in go args);
+  register "get" (fun args ->
+    match args with
+    | [Dict d; String k] -> dict_get d k
+    | [Dict d; Keyword k] -> dict_get d k
+    | [List l; Number n] -> (try List.nth l (int_of_float n) with _ -> Nil)
+    | _ -> raise (Eval_error "get: dict+key or list+index"));
+  register "has-key?" (fun args ->
+    match args with
+    | [Dict d; String k] -> Bool (dict_has d k)
+    | [Dict d; Keyword k] -> Bool (dict_has d k)
+    | _ -> raise (Eval_error "has-key?: dict and key"));
+  register "assoc" (fun args ->
+    match args with
+    | Dict d :: rest ->
+      let d2 = Hashtbl.copy d in
+      let rec go = function
+        | [] -> Dict d2
+        | String k :: v :: rest -> Hashtbl.replace d2 k v; go rest
+        | Keyword k :: v :: rest -> Hashtbl.replace d2 k v; go rest
+        | _ -> raise (Eval_error "assoc: pairs")
+      in go rest
+    | _ -> raise (Eval_error "assoc: dict + pairs"));
+  register "dissoc" (fun args ->
+    match args with
+    | Dict d :: keys ->
+      let d2 = Hashtbl.copy d in
+      List.iter (fun k -> Hashtbl.remove d2 (to_string k)) keys;
+      Dict d2
+    | _ -> raise (Eval_error "dissoc: dict + keys"));
+  register "merge" (fun args ->
+    let d = make_dict () in
+    List.iter (function
+      | Dict src -> Hashtbl.iter (fun k v -> Hashtbl.replace d k v) src
+      | _ -> raise (Eval_error "merge: all args must be dicts")
+    ) args;
+    Dict d);
+  register "keys" (fun args ->
+    match args with [Dict d] -> List (dict_keys d) | _ -> raise (Eval_error "keys: 1 dict"));
+  register "vals" (fun args ->
+    match args with [Dict d] -> List (dict_vals d) | _ -> raise (Eval_error "vals: 1 dict"));
+  register "dict-set!" (fun args ->
+    match args with
+    | [Dict d; String k; v] -> dict_set d k v; v
+    | [Dict d; Keyword k; v] -> dict_set d k v; v
+    | _ -> raise (Eval_error "dict-set!: dict key val"));
+  register "dict-get" (fun args ->
+    match args with
+    | [Dict d; String k] -> dict_get d k
+    | [Dict d; Keyword k] -> dict_get d k
+    | _ -> raise (Eval_error "dict-get: dict and key"));
+  register "dict-has?" (fun args ->
+    match args with
+    | [Dict d; String k] -> Bool (dict_has d k)
+    | _ -> raise (Eval_error "dict-has?: dict and key"));
+  register "dict-delete!" (fun args ->
+    match args with
+    | [Dict d; String k] -> dict_delete d k; Nil
+    | _ -> raise (Eval_error "dict-delete!: dict and key"));
+
+  (* === Misc === *)
+  register "type-of" (fun args ->
+    match args with [a] -> String (type_of a) | _ -> raise (Eval_error "type-of: 1 arg"));
+  register "inspect" (fun args ->
+    match args with [a] -> String (inspect a) | _ -> raise (Eval_error "inspect: 1 arg"));
+  register "error" (fun args ->
+    match args with [String msg] -> raise (Eval_error msg)
+    | [a] -> raise (Eval_error (to_string a))
+    | _ -> raise (Eval_error "error: 1 arg"));
+  register "apply" (fun args ->
+    match args with
+    | [NativeFn (_, f); List a] -> f a
+    | _ -> raise (Eval_error "apply: function and list"));
+  register "identical?" (fun args ->
+    match args with [a; b] -> Bool (a == b) | _ -> raise (Eval_error "identical?: 2 args"));
+  register "make-spread" (fun args ->
+    match args with
+    | [Dict d] ->
+      let pairs = Hashtbl.fold (fun k v acc -> (k, v) :: acc) d [] in
+      Spread pairs
+    | _ -> raise (Eval_error "make-spread: 1 dict"));
+  register "spread?" (fun args ->
+    match args with [Spread _] -> Bool true | [_] -> Bool false
+    | _ -> raise (Eval_error "spread?: 1 arg"));
+  register "spread-attrs" (fun args ->
+    match args with
+    | [Spread pairs] ->
+      let d = make_dict () in
+      List.iter (fun (k, v) -> dict_set d k v) pairs;
+      Dict d
+    | _ -> raise (Eval_error "spread-attrs: 1 spread"));
+  ()
diff --git a/hosts/ocaml/lib/sx_ref.ml b/hosts/ocaml/lib/sx_ref.ml
new file mode 100644
index 0000000..9c63623
--- /dev/null
+++ b/hosts/ocaml/lib/sx_ref.ml
@@ -0,0 +1,565 @@
+(* sx_ref.ml — Auto-generated from SX spec by hosts/ocaml/bootstrap.py *)
+(* Do not edit — regenerate with: python3 hosts/ocaml/bootstrap.py *)
+
+[@@@warning "-26-27"]
+
+open Sx_types
+open Sx_runtime
+
+(* Trampoline — evaluates thunks via the CEK machine.
+   eval_expr is defined in the transpiled block below. *)
+let trampoline v = v  (* CEK machine doesn't produce thunks *)
+
+
+
+(* === Transpiled from evaluator (frames + eval + CEK) === *)
+
+(* make-cek-state *)
+let rec make_cek_state control env kont =
+  (let _d = Hashtbl.create 5 in Hashtbl.replace _d "control" control; Hashtbl.replace _d "env" env; Hashtbl.replace _d "kont" kont; Hashtbl.replace _d "phase" (String "eval"); Hashtbl.replace _d "value" Nil; Dict _d)
+
+(* make-cek-value *)
+and make_cek_value value env kont =
+  (let _d = Hashtbl.create 5 in Hashtbl.replace _d "control" Nil; Hashtbl.replace _d "env" env; Hashtbl.replace _d "kont" kont; Hashtbl.replace _d "phase" (String "continue"); Hashtbl.replace _d "value" value; Dict _d)
+
+(* cek-terminal? *)
+and cek_terminal_p state =
+  (let _and = (prim_call "=" [(get (state) ((String "phase"))); (String "continue")]) in if not (sx_truthy _and) then _and else (empty_p ((get (state) ((String "kont"))))))
+
+(* cek-control *)
+and cek_control s =
+  (get (s) ((String "control")))
+
+(* cek-env *)
+and cek_env s =
+  (get (s) ((String "env")))
+
+(* cek-kont *)
+and cek_kont s =
+  (get (s) ((String "kont")))
+
+(* cek-phase *)
+and cek_phase s =
+  (get (s) ((String "phase")))
+
+(* cek-value *)
+and cek_value s =
+  (get (s) ((String "value")))
+
+(* make-if-frame *)
+and make_if_frame then_expr else_expr env =
+  (let _d = Hashtbl.create 4 in Hashtbl.replace _d "type" (String "if"); Hashtbl.replace _d "then" then_expr; Hashtbl.replace _d "else" else_expr; Hashtbl.replace _d "env" env; Dict _d)
+
+(* make-when-frame *)
+and make_when_frame body_exprs env =
+  (let _d = Hashtbl.create 3 in Hashtbl.replace _d "type" (String "when"); Hashtbl.replace _d "body" body_exprs; Hashtbl.replace _d "env" env; Dict _d)
+
+(* make-begin-frame *)
+and make_begin_frame remaining env =
+  (let _d = Hashtbl.create 3 in Hashtbl.replace _d "type" (String "begin"); Hashtbl.replace _d "remaining" remaining; Hashtbl.replace _d "env" env; Dict _d)
+
+(* make-let-frame *)
+and make_let_frame name remaining body local =
+  (let _d = Hashtbl.create 5 in Hashtbl.replace _d "type" (String "let"); Hashtbl.replace _d "name" name; Hashtbl.replace _d "remaining" remaining; Hashtbl.replace _d "body" body; Hashtbl.replace _d "env" local; Dict _d)
+
+(* make-define-frame *)
+and make_define_frame name env has_effects effect_list =
+  (let _d = Hashtbl.create 5 in Hashtbl.replace _d "type" (String "define"); Hashtbl.replace _d "name" name; Hashtbl.replace _d "env" env; Hashtbl.replace _d "has-effects" has_effects; Hashtbl.replace _d "effect-list" effect_list; Dict _d)
+
+(* make-set-frame *)
+and make_set_frame name env =
+  (let _d = Hashtbl.create 3 in Hashtbl.replace _d "type" (String "set"); Hashtbl.replace _d "name" name; Hashtbl.replace _d "env" env; Dict _d)
+
+(* make-arg-frame *)
+and make_arg_frame f evaled remaining env raw_args head_name =
+  (let _d = Hashtbl.create 7 in Hashtbl.replace _d "type" (String "arg"); Hashtbl.replace _d "f" f; Hashtbl.replace _d "evaled" evaled; Hashtbl.replace _d "remaining" remaining; Hashtbl.replace _d "env" env; Hashtbl.replace _d "raw-args" raw_args; Hashtbl.replace _d "head-name" (let _or = head_name in if sx_truthy _or then _or else Nil); Dict _d)
+
+(* make-call-frame *)
+and make_call_frame f args env =
+  (let _d = Hashtbl.create 4 in Hashtbl.replace _d "type" (String "call"); Hashtbl.replace _d "f" f; Hashtbl.replace _d "args" args; Hashtbl.replace _d "env" env; Dict _d)
+
+(* make-cond-frame *)
+and make_cond_frame remaining env scheme_p =
+  (let _d = Hashtbl.create 4 in Hashtbl.replace _d "type" (String "cond"); Hashtbl.replace _d "remaining" remaining; Hashtbl.replace _d "env" env; Hashtbl.replace _d "scheme" scheme_p; Dict _d)
+
+(* make-case-frame *)
+and make_case_frame match_val remaining env =
+  (let _d = Hashtbl.create 4 in Hashtbl.replace _d "type" (String "case"); Hashtbl.replace _d "match-val" match_val; Hashtbl.replace _d "remaining" remaining; Hashtbl.replace _d "env" env; Dict _d)
+
+(* make-thread-frame *)
+and make_thread_frame remaining env =
+  (let _d = Hashtbl.create 3 in Hashtbl.replace _d "type" (String "thread"); Hashtbl.replace _d "remaining" remaining; Hashtbl.replace _d "env" env; Dict _d)
+
+(* make-map-frame *)
+and make_map_frame f remaining results env =
+  (let _d = Hashtbl.create 6 in Hashtbl.replace _d "type" (String "map"); Hashtbl.replace _d "f" f; Hashtbl.replace _d "remaining" remaining; Hashtbl.replace _d "results" results; Hashtbl.replace _d "env" env; Hashtbl.replace _d "indexed" (Bool false); Dict _d)
+
+(* make-map-indexed-frame *)
+and make_map_indexed_frame f remaining results env =
+  (let _d = Hashtbl.create 6 in Hashtbl.replace _d "type" (String "map"); Hashtbl.replace _d "f" f; Hashtbl.replace _d "remaining" remaining; Hashtbl.replace _d "results" results; Hashtbl.replace _d "env" env; Hashtbl.replace _d "indexed" (Bool true); Dict _d)
+
+(* make-filter-frame *)
+and make_filter_frame f remaining results current_item env =
+  (let _d = Hashtbl.create 6 in Hashtbl.replace _d "type" (String "filter"); Hashtbl.replace _d "f" f; Hashtbl.replace _d "remaining" remaining; Hashtbl.replace _d "results" results; Hashtbl.replace _d "current-item" current_item; Hashtbl.replace _d "env" env; Dict _d)
+
+(* make-reduce-frame *)
+and make_reduce_frame f remaining env =
+  (let _d = Hashtbl.create 4 in Hashtbl.replace _d "type" (String "reduce"); Hashtbl.replace _d "f" f; Hashtbl.replace _d "remaining" remaining; Hashtbl.replace _d "env" env; Dict _d)
+
+(* make-for-each-frame *)
+and make_for_each_frame f remaining env =
+  (let _d = Hashtbl.create 4 in Hashtbl.replace _d "type" (String "for-each"); Hashtbl.replace _d "f" f; Hashtbl.replace _d "remaining" remaining; Hashtbl.replace _d "env" env; Dict _d)
+
+(* make-some-frame *)
+and make_some_frame f remaining env =
+  (let _d = Hashtbl.create 4 in Hashtbl.replace _d "type" (String "some"); Hashtbl.replace _d "f" f; Hashtbl.replace _d "remaining" remaining; Hashtbl.replace _d "env" env; Dict _d)
+
+(* make-every-frame *)
+and make_every_frame f remaining env =
+  (let _d = Hashtbl.create 4 in Hashtbl.replace _d "type" (String "every"); Hashtbl.replace _d "f" f; Hashtbl.replace _d "remaining" remaining; Hashtbl.replace _d "env" env; Dict _d)
+
+(* make-scope-frame *)
+and make_scope_frame name remaining env =
+  (let _d = Hashtbl.create 4 in Hashtbl.replace _d "type" (String "scope"); Hashtbl.replace _d "name" name; Hashtbl.replace _d "remaining" remaining; Hashtbl.replace _d "env" env; Dict _d)
+
+(* make-provide-frame *)
+and make_provide_frame name value remaining env =
+  (let _d = Hashtbl.create 5 in Hashtbl.replace _d "type" (String "provide"); Hashtbl.replace _d "name" name; Hashtbl.replace _d "value" value; Hashtbl.replace _d "remaining" remaining; Hashtbl.replace _d "env" env; Dict _d)
+
+(* make-scope-acc-frame *)
+and make_scope_acc_frame name value remaining env =
+  (let _d = Hashtbl.create 6 in Hashtbl.replace _d "type" (String "scope-acc"); Hashtbl.replace _d "name" name; Hashtbl.replace _d "value" (let _or = value in if sx_truthy _or then _or else Nil); Hashtbl.replace _d "emitted" (List []); Hashtbl.replace _d "remaining" remaining; Hashtbl.replace _d "env" env; Dict _d)
+
+(* make-reset-frame *)
+and make_reset_frame env =
+  (let _d = Hashtbl.create 2 in Hashtbl.replace _d "type" (String "reset"); Hashtbl.replace _d "env" env; Dict _d)
+
+(* make-dict-frame *)
+and make_dict_frame remaining results env =
+  (let _d = Hashtbl.create 4 in Hashtbl.replace _d "type" (String "dict"); Hashtbl.replace _d "remaining" remaining; Hashtbl.replace _d "results" results; Hashtbl.replace _d "env" env; Dict _d)
+
+(* make-and-frame *)
+and make_and_frame remaining env =
+  (let _d = Hashtbl.create 3 in Hashtbl.replace _d "type" (String "and"); Hashtbl.replace _d "remaining" remaining; Hashtbl.replace _d "env" env; Dict _d)
+
+(* make-or-frame *)
+and make_or_frame remaining env =
+  (let _d = Hashtbl.create 3 in Hashtbl.replace _d "type" (String "or"); Hashtbl.replace _d "remaining" remaining; Hashtbl.replace _d "env" env; Dict _d)
+
+(* make-dynamic-wind-frame *)
+and make_dynamic_wind_frame phase body_thunk after_thunk env =
+  (let _d = Hashtbl.create 5 in Hashtbl.replace _d "type" (String "dynamic-wind"); Hashtbl.replace _d "phase" phase; Hashtbl.replace _d "body-thunk" body_thunk; Hashtbl.replace _d "after-thunk" after_thunk; Hashtbl.replace _d "env" env; Dict _d)
+
+(* make-reactive-reset-frame *)
+and make_reactive_reset_frame env update_fn first_render_p =
+  (let _d = Hashtbl.create 4 in Hashtbl.replace _d "type" (String "reactive-reset"); Hashtbl.replace _d "env" env; Hashtbl.replace _d "update-fn" update_fn; Hashtbl.replace _d "first-render" first_render_p; Dict _d)
+
+(* make-deref-frame *)
+and make_deref_frame env =
+  (let _d = Hashtbl.create 2 in Hashtbl.replace _d "type" (String "deref"); Hashtbl.replace _d "env" env; Dict _d)
+
+(* make-ho-setup-frame *)
+and make_ho_setup_frame ho_type remaining_args evaled_args env =
+  (let _d = Hashtbl.create 5 in Hashtbl.replace _d "type" (String "ho-setup"); Hashtbl.replace _d "ho-type" ho_type; Hashtbl.replace _d "remaining" remaining_args; Hashtbl.replace _d "evaled" evaled_args; Hashtbl.replace _d "env" env; Dict _d)
+
+(* frame-type *)
+and frame_type f =
+  (get (f) ((String "type")))
+
+(* kont-push *)
+and kont_push frame kont =
+  (cons (frame) (kont))
+
+(* kont-top *)
+and kont_top kont =
+  (first (kont))
+
+(* kont-pop *)
+and kont_pop kont =
+  (rest (kont))
+
+(* kont-empty? *)
+and kont_empty_p kont =
+  (empty_p (kont))
+
+(* kont-capture-to-reset *)
+and kont_capture_to_reset kont =
+  (let rec scan = (fun k captured -> (if sx_truthy ((empty_p (k))) then (raise (Eval_error (value_to_str (String "shift without enclosing reset")))) else (let frame = (first (k)) in (if sx_truthy ((let _or = (prim_call "=" [(frame_type (frame)); (String "reset")]) in if sx_truthy _or then _or else (prim_call "=" [(frame_type (frame)); (String "reactive-reset")]))) then (List [captured; (rest (k))]) else (scan ((rest (k))) ((prim_call "append" [captured; (List [frame])]))))))) in (scan (kont) ((List []))))
+
+(* kont-find-provide *)
+and kont_find_provide kont name =
+  (if sx_truthy ((empty_p (kont))) then Nil else (let frame = (first (kont)) in (if sx_truthy ((let _and = (prim_call "=" [(frame_type (frame)); (String "provide")]) in if not (sx_truthy _and) then _and else (prim_call "=" [(get (frame) ((String "name"))); name]))) then frame else (kont_find_provide ((rest (kont))) (name)))))
+
+(* kont-find-scope-acc *)
+and kont_find_scope_acc kont name =
+  (if sx_truthy ((empty_p (kont))) then Nil else (let frame = (first (kont)) in (if sx_truthy ((let _and = (prim_call "=" [(frame_type (frame)); (String "scope-acc")]) in if not (sx_truthy _and) then _and else (prim_call "=" [(get (frame) ((String "name"))); name]))) then frame else (kont_find_scope_acc ((rest (kont))) (name)))))
+
+(* has-reactive-reset-frame? *)
+and has_reactive_reset_frame_p kont =
+  (if sx_truthy ((empty_p (kont))) then (Bool false) else (if sx_truthy ((prim_call "=" [(frame_type ((first (kont)))); (String "reactive-reset")])) then (Bool true) else (has_reactive_reset_frame_p ((rest (kont))))))
+
+(* kont-capture-to-reactive-reset *)
+and kont_capture_to_reactive_reset kont =
+  (let rec scan = (fun k captured -> (if sx_truthy ((empty_p (k))) then (raise (Eval_error (value_to_str (String "reactive deref without enclosing reactive-reset")))) else (let frame = (first (k)) in (if sx_truthy ((prim_call "=" [(frame_type (frame)); (String "reactive-reset")])) then (List [captured; frame; (rest (k))]) else (scan ((rest (k))) ((prim_call "append" [captured; (List [frame])]))))))) in (scan (kont) ((List []))))
+
+(* *strict* *)
+and _strict_ =
+  (Bool false)
+
+(* set-strict! *)
+and set_strict_b val' =
+  let _strict_ = ref Nil in (_strict_ := val'; Nil)
+
+(* *prim-param-types* *)
+and _prim_param_types_ =
+  Nil
+
+(* set-prim-param-types! *)
+and set_prim_param_types_b types =
+  let _prim_param_types_ = ref Nil in (_prim_param_types_ := types; Nil)
+
+(* value-matches-type? *)
+and value_matches_type_p val' expected_type =
+  (if sx_truthy ((prim_call "=" [expected_type; (String "any")])) then (Bool true) else (if sx_truthy ((prim_call "=" [expected_type; (String "number")])) then (number_p (val')) else (if sx_truthy ((prim_call "=" [expected_type; (String "string")])) then (string_p (val')) else (if sx_truthy ((prim_call "=" [expected_type; (String "boolean")])) then (boolean_p (val')) else (if sx_truthy ((prim_call "=" [expected_type; (String "nil")])) then (is_nil (val')) else (if sx_truthy ((prim_call "=" [expected_type; (String "list")])) then (list_p (val')) else (if sx_truthy ((prim_call "=" [expected_type; (String "dict")])) then (dict_p (val')) else (if sx_truthy ((prim_call "=" [expected_type; (String "lambda")])) then (is_lambda (val')) else (if sx_truthy ((prim_call "=" [expected_type; (String "symbol")])) then (prim_call "=" [(type_of (val')); (String "symbol")]) else (if sx_truthy ((prim_call "=" [expected_type; (String "keyword")])) then (prim_call "=" [(type_of (val')); (String "keyword")]) else (if sx_truthy ((let _and = (string_p (expected_type)) in if not (sx_truthy _and) then _and else (prim_call "ends-with?" [expected_type; (String "?")]))) then (let _or = (is_nil (val')) in if sx_truthy _or then _or else (value_matches_type_p (val') ((prim_call "slice" [expected_type; (Number 0.0); (prim_call "-" [(prim_call "string-length" [expected_type]); (Number 1.0)])])))) else (Bool true))))))))))))
+
+(* strict-check-args *)
+and strict_check_args name args =
+  (if sx_truthy ((let _and = _strict_ in if not (sx_truthy _and) then _and else _prim_param_types_)) then (let spec = (get (_prim_param_types_) (name)) in (if sx_truthy (spec) then (let positional = (get (spec) ((String "positional"))) in let rest_type = (get (spec) ((String "rest-type"))) in (let () = ignore ((if sx_truthy (positional) then (List.iter (fun pair -> ignore ((let idx = (first (pair)) in let param = (nth (pair) ((Number 1.0))) in let p_name = (first (param)) in let p_type = (nth (param) ((Number 1.0))) in (if sx_truthy ((prim_call "<" [idx; (len (args))])) then (let val' = (nth (args) (idx)) in (if sx_truthy ((Bool (not (sx_truthy ((value_matches_type_p (val') (p_type))))))) then (raise (Eval_error (value_to_str (String (sx_str [(String "Type error: "); name; (String " expected "); p_type; (String " for param "); p_name; (String ", got "); (type_of (val')); (String " ("); (String (sx_str [val'])); (String ")")]))))) else Nil)) else Nil)))) (sx_to_list (List (List.mapi (fun i p -> let i = Number (float_of_int i) in (List [i; p])) (sx_to_list positional)))); Nil) else Nil)) in (if sx_truthy ((let _and = rest_type in if not (sx_truthy _and) then _and else (prim_call ">" [(len (args)); (len ((let _or = positional in if sx_truthy _or then _or else (List []))))]))) then (List.iter (fun pair -> ignore ((let idx = (first (pair)) in let val' = (nth (pair) ((Number 1.0))) in (if sx_truthy ((Bool (not (sx_truthy ((value_matches_type_p (val') (rest_type))))))) then (raise (Eval_error (value_to_str (String (sx_str [(String "Type error: "); name; (String " expected "); rest_type; (String " for rest arg "); idx; (String ", got "); (type_of (val')); (String " ("); (String (sx_str [val'])); (String ")")]))))) else Nil)))) (sx_to_list (List (List.mapi (fun i v -> let i = Number (float_of_int i) in (List [i; v])) (sx_to_list (prim_call "slice" [args; (len ((let _or = positional in if sx_truthy _or then _or else (List []))))]))))); Nil) else Nil))) else Nil)) else Nil)
+
+(* call-lambda *)
+and call_lambda f args caller_env =
+  (let params = (lambda_params (f)) in let local = (env_merge ((lambda_closure (f))) (caller_env)) in (if sx_truthy ((prim_call ">" [(len (args)); (len (params))])) then (raise (Eval_error (value_to_str (String (sx_str [(let _or = (lambda_name (f)) in if sx_truthy _or then _or else (String "lambda")); (String " expects "); (len (params)); (String " args, got "); (len (args))]))))) else (let () = ignore ((List.iter (fun pair -> ignore ((env_bind local (sx_to_string (first (pair))) (nth (pair) ((Number 1.0)))))) (sx_to_list (prim_call "zip" [params; args])); Nil)) in (let () = ignore ((List.iter (fun p -> ignore ((env_bind local (sx_to_string p) Nil))) (sx_to_list (prim_call "slice" [params; (len (args))])); Nil)) in (make_thunk ((lambda_body (f))) (local))))))
+
+(* call-component *)
+and call_component comp raw_args env =
+  (let parsed = (parse_keyword_args (raw_args) (env)) in let kwargs = (first (parsed)) in let children = (nth (parsed) ((Number 1.0))) in let local = (env_merge ((component_closure (comp))) (env)) in (let () = ignore ((List.iter (fun p -> ignore ((env_bind local (sx_to_string p) (let _or = (dict_get (kwargs) (p)) in if sx_truthy _or then _or else Nil)))) (sx_to_list (component_params (comp))); Nil)) in (let () = ignore ((if sx_truthy ((component_has_children (comp))) then (env_bind local (sx_to_string (String "children")) children) else Nil)) in (make_thunk ((component_body (comp))) (local)))))
+
+(* parse-keyword-args *)
+and parse_keyword_args raw_args env =
+  (let kwargs = (Dict (Hashtbl.create 0)) in let children = (List []) in let i = (Number 0.0) in (let () = ignore ((List.fold_left (fun state arg -> (let idx = (get (state) ((String "i"))) in let skip = (get (state) ((String "skip"))) in (if sx_truthy (skip) then (prim_call "assoc" [state; (String "skip"); (Bool false); (String "i"); (prim_call "inc" [idx])]) else (if sx_truthy ((let _and = (prim_call "=" [(type_of (arg)); (String "keyword")]) in if not (sx_truthy _and) then _and else (prim_call "<" [(prim_call "inc" [idx]); (len (raw_args))]))) then (let () = ignore ((sx_dict_set_b kwargs (keyword_name (arg)) (trampoline ((eval_expr ((nth (raw_args) ((prim_call "inc" [idx])))) (env)))))) in (prim_call "assoc" [state; (String "skip"); (Bool true); (String "i"); (prim_call "inc" [idx])])) else (let () = ignore ((sx_append_b children (trampoline ((eval_expr (arg) (env)))))) in (prim_call "assoc" [state; (String "i"); (prim_call "inc" [idx])])))))) (let _d = Hashtbl.create 2 in Hashtbl.replace _d (value_to_str (String "i")) (Number 0.0); Hashtbl.replace _d (value_to_str (String "skip")) (Bool false);  Dict _d) (sx_to_list raw_args))) in (List [kwargs; children])))
+
+(* cond-scheme? *)
+and cond_scheme_p clauses =
+  (Bool (List.for_all (fun c -> sx_truthy ((let _and = (prim_call "=" [(type_of (c)); (String "list")]) in if not (sx_truthy _and) then _and else (prim_call "=" [(len (c)); (Number 2.0)])))) (sx_to_list clauses)))
+
+(* sf-named-let *)
+and sf_named_let args env =
+  (let loop_name = (symbol_name ((first (args)))) in let bindings = (nth (args) ((Number 1.0))) in let body = (prim_call "slice" [args; (Number 2.0)]) in let params = (List []) in let inits = (List []) in (let () = ignore ((if sx_truthy ((let _and = (prim_call "=" [(type_of ((first (bindings)))); (String "list")]) in if not (sx_truthy _and) then _and else (prim_call "=" [(len ((first (bindings)))); (Number 2.0)]))) then (List.iter (fun binding -> ignore ((let () = ignore ((sx_append_b params (if sx_truthy ((prim_call "=" [(type_of ((first (binding)))); (String "symbol")])) then (symbol_name ((first (binding)))) else (first (binding))))) in (sx_append_b inits (nth (binding) ((Number 1.0))))))) (sx_to_list bindings); Nil) else (List.fold_left (fun _acc pair_idx -> (let () = ignore ((sx_append_b params (if sx_truthy ((prim_call "=" [(type_of ((nth (bindings) ((prim_call "*" [pair_idx; (Number 2.0)]))))); (String "symbol")])) then (symbol_name ((nth (bindings) ((prim_call "*" [pair_idx; (Number 2.0)]))))) else (nth (bindings) ((prim_call "*" [pair_idx; (Number 2.0)])))))) in (sx_append_b inits (nth (bindings) ((prim_call "inc" [(prim_call "*" [pair_idx; (Number 2.0)])])))))) Nil (sx_to_list (prim_call "range" [(Number 0.0); (prim_call "/" [(len (bindings)); (Number 2.0)])]))))) in (let loop_body = (if sx_truthy ((prim_call "=" [(len (body)); (Number 1.0)])) then (first (body)) else (cons ((make_symbol ((String "begin")))) (body))) in let loop_fn = (make_lambda (params) (loop_body) (env)) in (let () = ignore ((set_lambda_name loop_fn (sx_to_string loop_name))) in (let () = ignore ((env_bind (lambda_closure (loop_fn)) (sx_to_string loop_name) loop_fn)) in (let init_vals = (List (List.map (fun e -> (trampoline ((eval_expr (e) (env))))) (sx_to_list inits))) in (call_lambda (loop_fn) (init_vals) (env))))))))
+
+(* sf-lambda *)
+and sf_lambda args env =
+  (let params_expr = (first (args)) in let body_exprs = (rest (args)) in let body = (if sx_truthy ((prim_call "=" [(len (body_exprs)); (Number 1.0)])) then (first (body_exprs)) else (cons ((make_symbol ((String "begin")))) (body_exprs))) in let param_names = (List (List.map (fun p -> (if sx_truthy ((prim_call "=" [(type_of (p)); (String "symbol")])) then (symbol_name (p)) else (if sx_truthy ((let _and = (prim_call "=" [(type_of (p)); (String "list")]) in if not (sx_truthy _and) then _and else (let _and = (prim_call "=" [(len (p)); (Number 3.0)]) in if not (sx_truthy _and) then _and else (let _and = (prim_call "=" [(type_of ((nth (p) ((Number 1.0))))); (String "keyword")]) in if not (sx_truthy _and) then _and else (prim_call "=" [(keyword_name ((nth (p) ((Number 1.0))))); (String "as")]))))) then (symbol_name ((first (p)))) else p))) (sx_to_list params_expr))) in (make_lambda (param_names) (body) (env)))
+
+(* sf-defcomp *)
+and sf_defcomp args env =
+  (let name_sym = (first (args)) in let params_raw = (nth (args) ((Number 1.0))) in let body = (last (args)) in let comp_name = (strip_prefix ((symbol_name (name_sym))) ((String "~"))) in let parsed = (parse_comp_params (params_raw)) in let params = (first (parsed)) in let has_children = (nth (parsed) ((Number 1.0))) in let param_types = (nth (parsed) ((Number 2.0))) in let affinity = (defcomp_kwarg (args) ((String "affinity")) ((String "auto"))) in (let comp = (make_component (comp_name) (params) (has_children) (body) (env) (affinity)) in let effects = (defcomp_kwarg (args) ((String "effects")) (Nil)) in (let () = ignore ((if sx_truthy ((let _and = (Bool (not (sx_truthy ((is_nil (param_types)))))) in if not (sx_truthy _and) then _and else (Bool (not (sx_truthy ((empty_p ((prim_call "keys" [param_types]))))))))) then (component_set_param_types_b (comp) (param_types)) else Nil)) in (let () = ignore ((if sx_truthy ((Bool (not (sx_truthy ((is_nil (effects))))))) then (let effect_list = (if sx_truthy ((prim_call "=" [(type_of (effects)); (String "list")])) then (List (List.map (fun e -> (if sx_truthy ((prim_call "=" [(type_of (e)); (String "symbol")])) then (symbol_name (e)) else (String (sx_str [e])))) (sx_to_list effects))) else (List [(String (sx_str [effects]))])) in let effect_anns = (if sx_truthy ((env_has (env) ((String "*effect-annotations*")))) then (env_get (env) ((String "*effect-annotations*"))) else (Dict (Hashtbl.create 0))) in (let () = ignore ((sx_dict_set_b effect_anns (symbol_name (name_sym)) effect_list)) in (env_bind env (sx_to_string (String "*effect-annotations*")) effect_anns))) else Nil)) in (let () = ignore ((env_bind env (sx_to_string (symbol_name (name_sym))) comp)) in comp)))))
+
+(* defcomp-kwarg *)
+and defcomp_kwarg args key default =
+  (let end' = (prim_call "-" [(len (args)); (Number 1.0)]) in let result' = ref (default) in (let () = ignore ((List.iter (fun i -> ignore ((if sx_truthy ((let _and = (prim_call "=" [(type_of ((nth (args) (i)))); (String "keyword")]) in if not (sx_truthy _and) then _and else (let _and = (prim_call "=" [(keyword_name ((nth (args) (i)))); key]) in if not (sx_truthy _and) then _and else (prim_call "<" [(prim_call "+" [i; (Number 1.0)]); end'])))) then (let val' = (nth (args) ((prim_call "+" [i; (Number 1.0)]))) in (result' := (if sx_truthy ((prim_call "=" [(type_of (val')); (String "keyword")])) then (keyword_name (val')) else val'); Nil)) else Nil))) (sx_to_list (prim_call "range" [(Number 2.0); end'; (Number 1.0)])); Nil)) in !result'))
+
+(* parse-comp-params *)
+and parse_comp_params params_expr =
+  (let params = (List []) in let param_types = (Dict (Hashtbl.create 0)) in let has_children = ref ((Bool false)) in let in_key = ref ((Bool false)) in (let () = ignore ((List.iter (fun p -> ignore ((if sx_truthy ((let _and = (prim_call "=" [(type_of (p)); (String "list")]) in if not (sx_truthy _and) then _and else (let _and = (prim_call "=" [(len (p)); (Number 3.0)]) in if not (sx_truthy _and) then _and else (let _and = (prim_call "=" [(type_of ((first (p)))); (String "symbol")]) in if not (sx_truthy _and) then _and else (let _and = (prim_call "=" [(type_of ((nth (p) ((Number 1.0))))); (String "keyword")]) in if not (sx_truthy _and) then _and else (prim_call "=" [(keyword_name ((nth (p) ((Number 1.0))))); (String "as")])))))) then (let name = (symbol_name ((first (p)))) in let ptype = (nth (p) ((Number 2.0))) in (let type_val = (if sx_truthy ((prim_call "=" [(type_of (ptype)); (String "symbol")])) then (symbol_name (ptype)) else ptype) in (if sx_truthy ((Bool (not (sx_truthy (!has_children))))) then (let () = ignore ((sx_append_b params name)) in (sx_dict_set_b param_types name type_val)) else Nil))) else (if sx_truthy ((prim_call "=" [(type_of (p)); (String "symbol")])) then (let name = (symbol_name (p)) in (if sx_truthy ((prim_call "=" [name; (String "&key")])) then (in_key := (Bool true); Nil) else (if sx_truthy ((prim_call "=" [name; (String "&rest")])) then (has_children := (Bool true); Nil) else (if sx_truthy ((prim_call "=" [name; (String "&children")])) then (has_children := (Bool true); Nil) else (if sx_truthy (!has_children) then Nil else (if sx_truthy (!in_key) then (sx_append_b params name) else (sx_append_b params name))))))) else Nil)))) (sx_to_list params_expr); Nil)) in (List [params; !has_children; param_types])))
+
+(* sf-defisland *)
+and sf_defisland args env =
+  (let name_sym = (first (args)) in let params_raw = (nth (args) ((Number 1.0))) in let body = (last (args)) in let comp_name = (strip_prefix ((symbol_name (name_sym))) ((String "~"))) in let parsed = (parse_comp_params (params_raw)) in let params = (first (parsed)) in let has_children = (nth (parsed) ((Number 1.0))) in (let island = (make_island (comp_name) (params) (has_children) (body) (env)) in (let () = ignore ((env_bind env (sx_to_string (symbol_name (name_sym))) island)) in island)))
+
+(* sf-defmacro *)
+and sf_defmacro args env =
+  (let name_sym = (first (args)) in let params_raw = (nth (args) ((Number 1.0))) in let body = (nth (args) ((Number 2.0))) in let parsed = (parse_macro_params (params_raw)) in let params = (first (parsed)) in let rest_param = (nth (parsed) ((Number 1.0))) in (let mac = (make_macro (params) (rest_param) (body) (env) ((symbol_name (name_sym)))) in (let () = ignore ((env_bind env (sx_to_string (symbol_name (name_sym))) mac)) in mac)))
+
+(* parse-macro-params *)
+and parse_macro_params params_expr =
+  (let params = (List []) in let rest_param = ref (Nil) in (let () = ignore ((List.fold_left (fun state p -> (if sx_truthy ((let _and = (prim_call "=" [(type_of (p)); (String "symbol")]) in if not (sx_truthy _and) then _and else (prim_call "=" [(symbol_name (p)); (String "&rest")]))) then (prim_call "assoc" [state; (String "in-rest"); (Bool true)]) else (if sx_truthy ((get (state) ((String "in-rest")))) then (let () = ignore ((rest_param := (if sx_truthy ((prim_call "=" [(type_of (p)); (String "symbol")])) then (symbol_name (p)) else p); Nil)) in state) else (let () = ignore ((sx_append_b params (if sx_truthy ((prim_call "=" [(type_of (p)); (String "symbol")])) then (symbol_name (p)) else p))) in state)))) (let _d = Hashtbl.create 1 in Hashtbl.replace _d (value_to_str (String "in-rest")) (Bool false);  Dict _d) (sx_to_list params_expr))) in (List [params; !rest_param])))
+
+(* sf-defstyle *)
+and sf_defstyle args env =
+  (let name_sym = (first (args)) in let value = (trampoline ((eval_expr ((nth (args) ((Number 1.0)))) (env)))) in (let () = ignore ((env_bind env (sx_to_string (symbol_name (name_sym))) value)) in value))
+
+(* make-type-def *)
+and make_type_def name params body =
+  (let _d = Hashtbl.create 3 in Hashtbl.replace _d "name" name; Hashtbl.replace _d "params" params; Hashtbl.replace _d "body" body; Dict _d)
+
+(* normalize-type-body *)
+and normalize_type_body body =
+  (if sx_truthy ((is_nil (body))) then (String "nil") else (if sx_truthy ((prim_call "=" [(type_of (body)); (String "symbol")])) then (symbol_name (body)) else (if sx_truthy ((prim_call "=" [(type_of (body)); (String "string")])) then body else (if sx_truthy ((prim_call "=" [(type_of (body)); (String "keyword")])) then (keyword_name (body)) else (if sx_truthy ((prim_call "=" [(type_of (body)); (String "dict")])) then (match body with Dict _tbl -> let _r = Hashtbl.create (Hashtbl.length _tbl) in Hashtbl.iter (fun k v -> let k = String k in Hashtbl.replace _r (value_to_str k) ((normalize_type_body (v)))) _tbl; Dict _r | _ -> raise (Eval_error "map-dict: expected dict")) else (if sx_truthy ((prim_call "=" [(type_of (body)); (String "list")])) then (if sx_truthy ((empty_p (body))) then (String "any") else (let head = (first (body)) in (let head_name = (if sx_truthy ((prim_call "=" [(type_of (head)); (String "symbol")])) then (symbol_name (head)) else (String (sx_str [head]))) in (if sx_truthy ((prim_call "=" [head_name; (String "union")])) then (cons ((String "or")) ((List (List.map (fun _x -> normalize_type_body _x) (sx_to_list (rest (body))))))) else (cons (head_name) ((List (List.map (fun _x -> normalize_type_body _x) (sx_to_list (rest (body))))))))))) else (String (sx_str [body]))))))))
+
+(* sf-deftype *)
+and sf_deftype args env =
+  (let name_or_form = (first (args)) in let body_expr = (nth (args) ((Number 1.0))) in let type_name = ref (Nil) in let type_params = ref ((List [])) in (let () = ignore ((if sx_truthy ((prim_call "=" [(type_of (name_or_form)); (String "symbol")])) then (type_name := (symbol_name (name_or_form)); Nil) else (if sx_truthy ((prim_call "=" [(type_of (name_or_form)); (String "list")])) then (let () = ignore ((type_name := (symbol_name ((first (name_or_form)))); Nil)) in (type_params := (List (List.map (fun p -> (if sx_truthy ((prim_call "=" [(type_of (p)); (String "symbol")])) then (symbol_name (p)) else (String (sx_str [p])))) (sx_to_list (rest (name_or_form))))); Nil)) else Nil))) in (let body = (normalize_type_body (body_expr)) in let registry = (if sx_truthy ((env_has (env) ((String "*type-registry*")))) then (env_get (env) ((String "*type-registry*"))) else (Dict (Hashtbl.create 0))) in (let () = ignore ((sx_dict_set_b registry !type_name (make_type_def (!type_name) (!type_params) (body)))) in (let () = ignore ((env_bind env (sx_to_string (String "*type-registry*")) registry)) in Nil)))))
+
+(* sf-defeffect *)
+and sf_defeffect args env =
+  (let effect_name = (if sx_truthy ((prim_call "=" [(type_of ((first (args)))); (String "symbol")])) then (symbol_name ((first (args)))) else (String (sx_str [(first (args))]))) in let registry = (if sx_truthy ((env_has (env) ((String "*effect-registry*")))) then (env_get (env) ((String "*effect-registry*"))) else (List [])) in (let () = ignore ((if sx_truthy ((Bool (not (sx_truthy ((prim_call "contains?" [registry; effect_name])))))) then (sx_append_b registry effect_name) else Nil)) in (let () = ignore ((env_bind env (sx_to_string (String "*effect-registry*")) registry)) in Nil)))
+
+(* qq-expand *)
+and qq_expand template env =
+  (if sx_truthy ((Bool (not (sx_truthy ((prim_call "=" [(type_of (template)); (String "list")])))))) then template else (if sx_truthy ((empty_p (template))) then (List []) else (let head = (first (template)) in (if sx_truthy ((let _and = (prim_call "=" [(type_of (head)); (String "symbol")]) in if not (sx_truthy _and) then _and else (prim_call "=" [(symbol_name (head)); (String "unquote")]))) then (trampoline ((eval_expr ((nth (template) ((Number 1.0)))) (env)))) else (List.fold_left (fun result' item -> (if sx_truthy ((let _and = (prim_call "=" [(type_of (item)); (String "list")]) in if not (sx_truthy _and) then _and else (let _and = (prim_call "=" [(len (item)); (Number 2.0)]) in if not (sx_truthy _and) then _and else (let _and = (prim_call "=" [(type_of ((first (item)))); (String "symbol")]) in if not (sx_truthy _and) then _and else (prim_call "=" [(symbol_name ((first (item)))); (String "splice-unquote")]))))) then (let spliced = (trampoline ((eval_expr ((nth (item) ((Number 1.0)))) (env)))) in (if sx_truthy ((prim_call "=" [(type_of (spliced)); (String "list")])) then (prim_call "concat" [result'; spliced]) else (if sx_truthy ((is_nil (spliced))) then result' else (prim_call "concat" [result'; (List [spliced])])))) else (prim_call "concat" [result'; (List [(qq_expand (item) (env))])]))) (List []) (sx_to_list template))))))
+
+(* sf-letrec *)
+and sf_letrec args env =
+  (let bindings = (first (args)) in let body = (rest (args)) in let local = (env_extend (env)) in let names = (List []) in let val_exprs = (List []) in (let () = ignore ((if sx_truthy ((let _and = (prim_call "=" [(type_of ((first (bindings)))); (String "list")]) in if not (sx_truthy _and) then _and else (prim_call "=" [(len ((first (bindings)))); (Number 2.0)]))) then (List.iter (fun binding -> ignore ((let vname = (if sx_truthy ((prim_call "=" [(type_of ((first (binding)))); (String "symbol")])) then (symbol_name ((first (binding)))) else (first (binding))) in (let () = ignore ((sx_append_b names vname)) in (let () = ignore ((sx_append_b val_exprs (nth (binding) ((Number 1.0))))) in (env_bind local (sx_to_string vname) Nil)))))) (sx_to_list bindings); Nil) else (List.fold_left (fun _acc pair_idx -> (let vname = (if sx_truthy ((prim_call "=" [(type_of ((nth (bindings) ((prim_call "*" [pair_idx; (Number 2.0)]))))); (String "symbol")])) then (symbol_name ((nth (bindings) ((prim_call "*" [pair_idx; (Number 2.0)]))))) else (nth (bindings) ((prim_call "*" [pair_idx; (Number 2.0)])))) in let val_expr = (nth (bindings) ((prim_call "inc" [(prim_call "*" [pair_idx; (Number 2.0)])]))) in (let () = ignore ((sx_append_b names vname)) in (let () = ignore ((sx_append_b val_exprs val_expr)) in (env_bind local (sx_to_string vname) Nil))))) Nil (sx_to_list (prim_call "range" [(Number 0.0); (prim_call "/" [(len (bindings)); (Number 2.0)])]))))) in (let () = ignore ((let values = (List (List.map (fun e -> (trampoline ((eval_expr (e) (local))))) (sx_to_list val_exprs))) in (let () = ignore ((List.iter (fun pair -> ignore ((env_bind local (sx_to_string (first (pair))) (nth (pair) ((Number 1.0)))))) (sx_to_list (prim_call "zip" [names; values])); Nil)) in (List.iter (fun val' -> ignore ((if sx_truthy ((is_lambda (val'))) then (List.iter (fun n -> ignore ((env_bind (lambda_closure (val')) (sx_to_string n) (env_get (local) (n))))) (sx_to_list names); Nil) else Nil))) (sx_to_list values); Nil)))) in (let () = ignore ((List.iter (fun e -> ignore ((trampoline ((eval_expr (e) (local)))))) (sx_to_list (prim_call "slice" [body; (Number 0.0); (prim_call "dec" [(len (body))])])); Nil)) in (make_thunk ((last (body))) (local))))))
+
+(* sf-dynamic-wind *)
+and sf_dynamic_wind args env =
+  (let before = (trampoline ((eval_expr ((first (args))) (env)))) in let body = (trampoline ((eval_expr ((nth (args) ((Number 1.0)))) (env)))) in let after = (trampoline ((eval_expr ((nth (args) ((Number 2.0)))) (env)))) in (dynamic_wind_call (before) (body) (after) (env)))
+
+(* sf-scope *)
+and sf_scope args env =
+  (let name = (trampoline ((eval_expr ((first (args))) (env)))) in let rest = (prim_call "slice" [args; (Number 1.0)]) in let val' = ref (Nil) in let body_exprs = ref (Nil) in (let () = ignore ((if sx_truthy ((let _and = (prim_call ">=" [(len (rest)); (Number 2.0)]) in if not (sx_truthy _and) then _and else (let _and = (prim_call "=" [(type_of ((first (rest)))); (String "keyword")]) in if not (sx_truthy _and) then _and else (prim_call "=" [(keyword_name ((first (rest)))); (String "value")])))) then (let () = ignore ((val' := (trampoline ((eval_expr ((nth (rest) ((Number 1.0)))) (env)))); Nil)) in (body_exprs := (prim_call "slice" [rest; (Number 2.0)]); Nil)) else (body_exprs := rest; Nil))) in (let () = ignore ((scope_push (name) (!val'))) in (let result' = ref (Nil) in (let () = ignore ((List.iter (fun e -> ignore ((result' := (trampoline ((eval_expr (e) (env)))); Nil))) (sx_to_list !body_exprs); Nil)) in (let () = ignore ((scope_pop (name))) in !result'))))))
+
+(* sf-provide *)
+and sf_provide args env =
+  (let name = (trampoline ((eval_expr ((first (args))) (env)))) in let val' = (trampoline ((eval_expr ((nth (args) ((Number 1.0)))) (env)))) in let body_exprs = (prim_call "slice" [args; (Number 2.0)]) in let result' = ref (Nil) in (let () = ignore ((scope_push (name) (val'))) in (let () = ignore ((List.iter (fun e -> ignore ((result' := (trampoline ((eval_expr (e) (env)))); Nil))) (sx_to_list body_exprs); Nil)) in (let () = ignore ((scope_pop (name))) in !result'))))
+
+(* expand-macro *)
+and expand_macro mac raw_args env =
+  (let local = (env_merge ((macro_closure (mac))) (env)) in (let () = ignore ((List.iter (fun pair -> ignore ((env_bind local (sx_to_string (first (pair))) (if sx_truthy ((prim_call "<" [(nth (pair) ((Number 1.0))); (len (raw_args))])) then (nth (raw_args) ((nth (pair) ((Number 1.0))))) else Nil)))) (sx_to_list (List (List.mapi (fun i p -> let i = Number (float_of_int i) in (List [p; i])) (sx_to_list (macro_params (mac)))))); Nil)) in (let () = ignore ((if sx_truthy ((macro_rest_param (mac))) then (env_bind local (sx_to_string (macro_rest_param (mac))) (prim_call "slice" [raw_args; (len ((macro_params (mac))))])) else Nil)) in (trampoline ((eval_expr ((macro_body (mac))) (local)))))))
+
+(* cek-run *)
+and cek_run state =
+  (if sx_truthy ((cek_terminal_p (state))) then (cek_value (state)) else (cek_run ((cek_step (state)))))
+
+(* cek-step *)
+and cek_step state =
+  (if sx_truthy ((prim_call "=" [(cek_phase (state)); (String "eval")])) then (step_eval (state)) else (step_continue (state)))
+
+(* step-eval *)
+and step_eval state =
+  (let expr = (cek_control (state)) in let env = (cek_env (state)) in let kont = (cek_kont (state)) in (let _match_val = (type_of (expr)) in (if _match_val = (String "number") then (make_cek_value (expr) (env) (kont)) else (if _match_val = (String "string") then (make_cek_value (expr) (env) (kont)) else (if _match_val = (String "boolean") then (make_cek_value (expr) (env) (kont)) else (if _match_val = (String "nil") then (make_cek_value (Nil) (env) (kont)) else (if _match_val = (String "symbol") then (let name = (symbol_name (expr)) in (let val' = (if sx_truthy ((env_has (env) (name))) then (env_get (env) (name)) else (if sx_truthy ((is_primitive (name))) then (get_primitive (name)) else (if sx_truthy ((prim_call "=" [name; (String "true")])) then (Bool true) else (if sx_truthy ((prim_call "=" [name; (String "false")])) then (Bool false) else (if sx_truthy ((prim_call "=" [name; (String "nil")])) then Nil else (raise (Eval_error (value_to_str (String (sx_str [(String "Undefined symbol: "); name])))))))))) in (make_cek_value (val') (env) (kont)))) else (if _match_val = (String "keyword") then (make_cek_value ((keyword_name (expr))) (env) (kont)) else (if _match_val = (String "dict") then (let ks = (prim_call "keys" [expr]) in (if sx_truthy ((empty_p (ks))) then (make_cek_value ((Dict (Hashtbl.create 0))) (env) (kont)) else (let first_key = (first (ks)) in let remaining_entries = (List []) in (let () = ignore ((List.iter (fun k -> ignore ((sx_append_b remaining_entries (List [k; (get (expr) (k))])))) (sx_to_list (rest (ks))); Nil)) in (make_cek_state ((get (expr) (first_key))) (env) ((kont_push ((make_dict_frame (remaining_entries) ((List [(List [first_key])])) (env))) (kont)))))))) else (if _match_val = (String "list") then (if sx_truthy ((empty_p (expr))) then (make_cek_value ((List [])) (env) (kont)) else (step_eval_list (expr) (env) (kont))) else (make_cek_value (expr) (env) (kont))))))))))))
+
+(* step-eval-list *)
+and step_eval_list expr env kont =
+  (let head = (first (expr)) in let args = (rest (expr)) in (if sx_truthy ((Bool (not (sx_truthy ((let _or = (prim_call "=" [(type_of (head)); (String "symbol")]) in if sx_truthy _or then _or else (let _or = (prim_call "=" [(type_of (head)); (String "lambda")]) in if sx_truthy _or then _or else (prim_call "=" [(type_of (head)); (String "list")])))))))) then (if sx_truthy ((empty_p (expr))) then (make_cek_value ((List [])) (env) (kont)) else (make_cek_state ((first (expr))) (env) ((kont_push ((make_map_frame (Nil) ((rest (expr))) ((List [])) (env))) (kont))))) else (if sx_truthy ((prim_call "=" [(type_of (head)); (String "symbol")])) then (let name = (symbol_name (head)) in (if sx_truthy ((prim_call "=" [name; (String "if")])) then (step_sf_if (args) (env) (kont)) else (if sx_truthy ((prim_call "=" [name; (String "when")])) then (step_sf_when (args) (env) (kont)) else (if sx_truthy ((prim_call "=" [name; (String "cond")])) then (step_sf_cond (args) (env) (kont)) else (if sx_truthy ((prim_call "=" [name; (String "case")])) then (step_sf_case (args) (env) (kont)) else (if sx_truthy ((prim_call "=" [name; (String "and")])) then (step_sf_and (args) (env) (kont)) else (if sx_truthy ((prim_call "=" [name; (String "or")])) then (step_sf_or (args) (env) (kont)) else (if sx_truthy ((prim_call "=" [name; (String "let")])) then (step_sf_let (args) (env) (kont)) else (if sx_truthy ((prim_call "=" [name; (String "let*")])) then (step_sf_let (args) (env) (kont)) else (if sx_truthy ((prim_call "=" [name; (String "lambda")])) then (step_sf_lambda (args) (env) (kont)) else (if sx_truthy ((prim_call "=" [name; (String "fn")])) then (step_sf_lambda (args) (env) (kont)) else (if sx_truthy ((prim_call "=" [name; (String "define")])) then (step_sf_define (args) (env) (kont)) else (if sx_truthy ((prim_call "=" [name; (String "defcomp")])) then (make_cek_value ((sf_defcomp (args) (env))) (env) (kont)) else (if sx_truthy ((prim_call "=" [name; (String "defisland")])) then (make_cek_value ((sf_defisland (args) (env))) (env) (kont)) else (if sx_truthy ((prim_call "=" [name; (String "defmacro")])) then (make_cek_value ((sf_defmacro (args) (env))) (env) (kont)) else (if sx_truthy ((prim_call "=" [name; (String "defstyle")])) then (make_cek_value ((sf_defstyle (args) (env))) (env) (kont)) else (if sx_truthy ((prim_call "=" [name; (String "defhandler")])) then (make_cek_value ((sf_defhandler (args) (env))) (env) (kont)) else (if sx_truthy ((prim_call "=" [name; (String "defpage")])) then (make_cek_value ((sf_defpage (args) (env))) (env) (kont)) else (if sx_truthy ((prim_call "=" [name; (String "defquery")])) then (make_cek_value ((sf_defquery (args) (env))) (env) (kont)) else (if sx_truthy ((prim_call "=" [name; (String "defaction")])) then (make_cek_value ((sf_defaction (args) (env))) (env) (kont)) else (if sx_truthy ((prim_call "=" [name; (String "deftype")])) then (make_cek_value ((sf_deftype (args) (env))) (env) (kont)) else (if sx_truthy ((prim_call "=" [name; (String "defeffect")])) then (make_cek_value ((sf_defeffect (args) (env))) (env) (kont)) else (if sx_truthy ((prim_call "=" [name; (String "begin")])) then (step_sf_begin (args) (env) (kont)) else (if sx_truthy ((prim_call "=" [name; (String "do")])) then (step_sf_begin (args) (env) (kont)) else (if sx_truthy ((prim_call "=" [name; (String "quote")])) then (make_cek_value ((if sx_truthy ((empty_p (args))) then Nil else (first (args)))) (env) (kont)) else (if sx_truthy ((prim_call "=" [name; (String "quasiquote")])) then (make_cek_value ((qq_expand ((first (args))) (env))) (env) (kont)) else (if sx_truthy ((prim_call "=" [name; (String "->")])) then (step_sf_thread_first (args) (env) (kont)) else (if sx_truthy ((prim_call "=" [name; (String "set!")])) then (step_sf_set_b (args) (env) (kont)) else (if sx_truthy ((prim_call "=" [name; (String "letrec")])) then (make_cek_value ((sf_letrec (args) (env))) (env) (kont)) else (if sx_truthy ((prim_call "=" [name; (String "reset")])) then (step_sf_reset (args) (env) (kont)) else (if sx_truthy ((prim_call "=" [name; (String "shift")])) then (step_sf_shift (args) (env) (kont)) else (if sx_truthy ((prim_call "=" [name; (String "deref")])) then (step_sf_deref (args) (env) (kont)) else (if sx_truthy ((prim_call "=" [name; (String "scope")])) then (step_sf_scope (args) (env) (kont)) else (if sx_truthy ((prim_call "=" [name; (String "provide")])) then (step_sf_provide (args) (env) (kont)) else (if sx_truthy ((prim_call "=" [name; (String "context")])) then (step_sf_context (args) (env) (kont)) else (if sx_truthy ((prim_call "=" [name; (String "emit!")])) then (step_sf_emit (args) (env) (kont)) else (if sx_truthy ((prim_call "=" [name; (String "emitted")])) then (step_sf_emitted (args) (env) (kont)) else (if sx_truthy ((prim_call "=" [name; (String "dynamic-wind")])) then (make_cek_value ((sf_dynamic_wind (args) (env))) (env) (kont)) else (if sx_truthy ((prim_call "=" [name; (String "map")])) then (step_ho_map (args) (env) (kont)) else (if sx_truthy ((prim_call "=" [name; (String "map-indexed")])) then (step_ho_map_indexed (args) (env) (kont)) else (if sx_truthy ((prim_call "=" [name; (String "filter")])) then (step_ho_filter (args) (env) (kont)) else (if sx_truthy ((prim_call "=" [name; (String "reduce")])) then (step_ho_reduce (args) (env) (kont)) else (if sx_truthy ((prim_call "=" [name; (String "some")])) then (step_ho_some (args) (env) (kont)) else (if sx_truthy ((prim_call "=" [name; (String "every?")])) then (step_ho_every (args) (env) (kont)) else (if sx_truthy ((prim_call "=" [name; (String "for-each")])) then (step_ho_for_each (args) (env) (kont)) else (if sx_truthy ((let _and = (env_has (env) (name)) in if not (sx_truthy _and) then _and else (is_macro ((env_get (env) (name)))))) then (let mac = (env_get (env) (name)) in (make_cek_state ((expand_macro (mac) (args) (env))) (env) (kont))) else (if sx_truthy ((let _and = (render_active_p ()) in if not (sx_truthy _and) then _and else (is_render_expr (expr)))) then (make_cek_value ((render_expr (expr) (env))) (env) (kont)) else (step_eval_call (head) (args) (env) (kont))))))))))))))))))))))))))))))))))))))))))))))))) else (step_eval_call (head) (args) (env) (kont)))))
+
+(* step-sf-if *)
+and step_sf_if args env kont =
+  (make_cek_state ((first (args))) (env) ((kont_push ((make_if_frame ((nth (args) ((Number 1.0)))) ((if sx_truthy ((prim_call ">" [(len (args)); (Number 2.0)])) then (nth (args) ((Number 2.0))) else Nil)) (env))) (kont))))
+
+(* step-sf-when *)
+and step_sf_when args env kont =
+  (make_cek_state ((first (args))) (env) ((kont_push ((make_when_frame ((rest (args))) (env))) (kont))))
+
+(* step-sf-begin *)
+and step_sf_begin args env kont =
+  (if sx_truthy ((empty_p (args))) then (make_cek_value (Nil) (env) (kont)) else (if sx_truthy ((prim_call "=" [(len (args)); (Number 1.0)])) then (make_cek_state ((first (args))) (env) (kont)) else (make_cek_state ((first (args))) (env) ((kont_push ((make_begin_frame ((rest (args))) (env))) (kont))))))
+
+(* step-sf-let *)
+and step_sf_let args env kont =
+  (if sx_truthy ((prim_call "=" [(type_of ((first (args)))); (String "symbol")])) then (make_cek_value ((sf_named_let (args) (env))) (env) (kont)) else (let bindings = (first (args)) in let body = (rest (args)) in let local = (env_extend (env)) in (if sx_truthy ((empty_p (bindings))) then (step_sf_begin (body) (local) (kont)) else (let first_binding = (if sx_truthy ((let _and = (prim_call "=" [(type_of ((first (bindings)))); (String "list")]) in if not (sx_truthy _and) then _and else (prim_call "=" [(len ((first (bindings)))); (Number 2.0)]))) then (first (bindings)) else (List [(first (bindings)); (nth (bindings) ((Number 1.0)))])) in let rest_bindings = (if sx_truthy ((let _and = (prim_call "=" [(type_of ((first (bindings)))); (String "list")]) in if not (sx_truthy _and) then _and else (prim_call "=" [(len ((first (bindings)))); (Number 2.0)]))) then (rest (bindings)) else (let pairs = (List []) in (let () = ignore ((List.fold_left (fun _acc i -> (sx_append_b pairs (List [(nth (bindings) ((prim_call "*" [i; (Number 2.0)]))); (nth (bindings) ((prim_call "inc" [(prim_call "*" [i; (Number 2.0)])])))]))) Nil (sx_to_list (prim_call "range" [(Number 1.0); (prim_call "/" [(len (bindings)); (Number 2.0)])])))) in pairs))) in (let vname = (if sx_truthy ((prim_call "=" [(type_of ((first (first_binding)))); (String "symbol")])) then (symbol_name ((first (first_binding)))) else (first (first_binding))) in (make_cek_state ((nth (first_binding) ((Number 1.0)))) (local) ((kont_push ((make_let_frame (vname) (rest_bindings) (body) (local))) (kont)))))))))
+
+(* step-sf-define *)
+and step_sf_define args env kont =
+  (let name_sym = (first (args)) in let has_effects = (let _and = (prim_call ">=" [(len (args)); (Number 4.0)]) in if not (sx_truthy _and) then _and else (let _and = (prim_call "=" [(type_of ((nth (args) ((Number 1.0))))); (String "keyword")]) in if not (sx_truthy _and) then _and else (prim_call "=" [(keyword_name ((nth (args) ((Number 1.0))))); (String "effects")]))) in let val_idx = (if sx_truthy ((let _and = (prim_call ">=" [(len (args)); (Number 4.0)]) in if not (sx_truthy _and) then _and else (let _and = (prim_call "=" [(type_of ((nth (args) ((Number 1.0))))); (String "keyword")]) in if not (sx_truthy _and) then _and else (prim_call "=" [(keyword_name ((nth (args) ((Number 1.0))))); (String "effects")])))) then (Number 3.0) else (Number 1.0)) in let effect_list = (if sx_truthy ((let _and = (prim_call ">=" [(len (args)); (Number 4.0)]) in if not (sx_truthy _and) then _and else (let _and = (prim_call "=" [(type_of ((nth (args) ((Number 1.0))))); (String "keyword")]) in if not (sx_truthy _and) then _and else (prim_call "=" [(keyword_name ((nth (args) ((Number 1.0))))); (String "effects")])))) then (nth (args) ((Number 2.0))) else Nil) in (make_cek_state ((nth (args) (val_idx))) (env) ((kont_push ((make_define_frame ((symbol_name (name_sym))) (env) (has_effects) (effect_list))) (kont)))))
+
+(* step-sf-set! *)
+and step_sf_set_b args env kont =
+  (make_cek_state ((nth (args) ((Number 1.0)))) (env) ((kont_push ((make_set_frame ((symbol_name ((first (args))))) (env))) (kont))))
+
+(* step-sf-and *)
+and step_sf_and args env kont =
+  (if sx_truthy ((empty_p (args))) then (make_cek_value ((Bool true)) (env) (kont)) else (make_cek_state ((first (args))) (env) ((kont_push ((make_and_frame ((rest (args))) (env))) (kont)))))
+
+(* step-sf-or *)
+and step_sf_or args env kont =
+  (if sx_truthy ((empty_p (args))) then (make_cek_value ((Bool false)) (env) (kont)) else (make_cek_state ((first (args))) (env) ((kont_push ((make_or_frame ((rest (args))) (env))) (kont)))))
+
+(* step-sf-cond *)
+and step_sf_cond args env kont =
+  (let scheme_p = (cond_scheme_p (args)) in (if sx_truthy (scheme_p) then (if sx_truthy ((empty_p (args))) then (make_cek_value (Nil) (env) (kont)) else (let clause = (first (args)) in let test = (first (clause)) in (if sx_truthy ((let _or = (let _and = (prim_call "=" [(type_of (test)); (String "symbol")]) in if not (sx_truthy _and) then _and else (let _or = (prim_call "=" [(symbol_name (test)); (String "else")]) in if sx_truthy _or then _or else (prim_call "=" [(symbol_name (test)); (String ":else")]))) in if sx_truthy _or then _or else (let _and = (prim_call "=" [(type_of (test)); (String "keyword")]) in if not (sx_truthy _and) then _and else (prim_call "=" [(keyword_name (test)); (String "else")])))) then (make_cek_state ((nth (clause) ((Number 1.0)))) (env) (kont)) else (make_cek_state (test) (env) ((kont_push ((make_cond_frame (args) (env) ((Bool true)))) (kont))))))) else (if sx_truthy ((prim_call "<" [(len (args)); (Number 2.0)])) then (make_cek_value (Nil) (env) (kont)) else (let test = (first (args)) in (if sx_truthy ((let _or = (let _and = (prim_call "=" [(type_of (test)); (String "keyword")]) in if not (sx_truthy _and) then _and else (prim_call "=" [(keyword_name (test)); (String "else")])) in if sx_truthy _or then _or else (let _and = (prim_call "=" [(type_of (test)); (String "symbol")]) in if not (sx_truthy _and) then _and else (let _or = (prim_call "=" [(symbol_name (test)); (String "else")]) in if sx_truthy _or then _or else (prim_call "=" [(symbol_name (test)); (String ":else")]))))) then (make_cek_state ((nth (args) ((Number 1.0)))) (env) (kont)) else (make_cek_state (test) (env) ((kont_push ((make_cond_frame (args) (env) ((Bool false)))) (kont)))))))))
+
+(* step-sf-case *)
+and step_sf_case args env kont =
+  (make_cek_state ((first (args))) (env) ((kont_push ((make_case_frame (Nil) ((rest (args))) (env))) (kont))))
+
+(* step-sf-thread-first *)
+and step_sf_thread_first args env kont =
+  (make_cek_state ((first (args))) (env) ((kont_push ((make_thread_frame ((rest (args))) (env))) (kont))))
+
+(* step-sf-lambda *)
+and step_sf_lambda args env kont =
+  (make_cek_value ((sf_lambda (args) (env))) (env) (kont))
+
+(* step-sf-scope *)
+and step_sf_scope args env kont =
+  (let name = (trampoline ((eval_expr ((first (args))) (env)))) in let rest_args = (prim_call "slice" [args; (Number 1.0)]) in let val' = ref (Nil) in let body = ref (Nil) in (let () = ignore ((if sx_truthy ((let _and = (prim_call ">=" [(len (rest_args)); (Number 2.0)]) in if not (sx_truthy _and) then _and else (let _and = (prim_call "=" [(type_of ((first (rest_args)))); (String "keyword")]) in if not (sx_truthy _and) then _and else (prim_call "=" [(keyword_name ((first (rest_args)))); (String "value")])))) then (let () = ignore ((val' := (trampoline ((eval_expr ((nth (rest_args) ((Number 1.0)))) (env)))); Nil)) in (body := (prim_call "slice" [rest_args; (Number 2.0)]); Nil)) else (body := rest_args; Nil))) in (if sx_truthy ((empty_p (!body))) then (make_cek_value (Nil) (env) (kont)) else (if sx_truthy ((prim_call "=" [(len (!body)); (Number 1.0)])) then (make_cek_state ((first (!body))) (env) ((kont_push ((make_scope_acc_frame (name) (!val') ((List [])) (env))) (kont)))) else (make_cek_state ((first (!body))) (env) ((kont_push ((make_scope_acc_frame (name) (!val') ((rest (!body))) (env))) (kont))))))))
+
+(* step-sf-provide *)
+and step_sf_provide args env kont =
+  (let name = (trampoline ((eval_expr ((first (args))) (env)))) in let val' = (trampoline ((eval_expr ((nth (args) ((Number 1.0)))) (env)))) in let body = (prim_call "slice" [args; (Number 2.0)]) in (if sx_truthy ((empty_p (body))) then (make_cek_value (Nil) (env) (kont)) else (if sx_truthy ((prim_call "=" [(len (body)); (Number 1.0)])) then (make_cek_state ((first (body))) (env) ((kont_push ((make_provide_frame (name) (val') ((List [])) (env))) (kont)))) else (make_cek_state ((first (body))) (env) ((kont_push ((make_provide_frame (name) (val') ((rest (body))) (env))) (kont)))))))
+
+(* step-sf-context *)
+and step_sf_context args env kont =
+  (let name = (trampoline ((eval_expr ((first (args))) (env)))) in let default_val = (if sx_truthy ((prim_call ">=" [(len (args)); (Number 2.0)])) then (trampoline ((eval_expr ((nth (args) ((Number 1.0)))) (env)))) else Nil) in let frame = (kont_find_provide (kont) (name)) in (if sx_truthy (frame) then (make_cek_value ((get (frame) ((String "value")))) (env) (kont)) else (if sx_truthy ((prim_call ">=" [(len (args)); (Number 2.0)])) then (make_cek_value (default_val) (env) (kont)) else (raise (Eval_error (value_to_str (String (sx_str [(String "No provider for: "); name]))))))))
+
+(* step-sf-emit *)
+and step_sf_emit args env kont =
+  (let name = (trampoline ((eval_expr ((first (args))) (env)))) in let val' = (trampoline ((eval_expr ((nth (args) ((Number 1.0)))) (env)))) in let frame = (kont_find_scope_acc (kont) (name)) in (if sx_truthy (frame) then (let () = ignore ((sx_append_b (get (frame) ((String "emitted"))) val')) in (make_cek_value (Nil) (env) (kont))) else (raise (Eval_error (value_to_str (String (sx_str [(String "No scope for emit!: "); name])))))))
+
+(* step-sf-emitted *)
+and step_sf_emitted args env kont =
+  (let name = (trampoline ((eval_expr ((first (args))) (env)))) in let frame = (kont_find_scope_acc (kont) (name)) in (if sx_truthy (frame) then (make_cek_value ((get (frame) ((String "emitted")))) (env) (kont)) else (raise (Eval_error (value_to_str (String (sx_str [(String "No scope for emitted: "); name])))))))
+
+(* step-sf-reset *)
+and step_sf_reset args env kont =
+  (make_cek_state ((first (args))) (env) ((kont_push ((make_reset_frame (env))) (kont))))
+
+(* step-sf-shift *)
+and step_sf_shift args env kont =
+  (let k_name = (symbol_name ((first (args)))) in let body = (nth (args) ((Number 1.0))) in let captured_result = (kont_capture_to_reset (kont)) in let captured = (first (captured_result)) in let rest_kont = (nth (captured_result) ((Number 1.0))) in (let k = (make_cek_continuation (captured) (rest_kont)) in (let shift_env = (env_extend (env)) in (let () = ignore ((env_bind shift_env (sx_to_string k_name) k)) in (make_cek_state (body) (shift_env) (rest_kont))))))
+
+(* step-sf-deref *)
+and step_sf_deref args env kont =
+  (make_cek_state ((first (args))) (env) ((kont_push ((make_deref_frame (env))) (kont))))
+
+(* cek-call *)
+and cek_call f args =
+  (let a = (if sx_truthy ((is_nil (args))) then (List []) else args) in (if sx_truthy ((is_nil (f))) then Nil else (if sx_truthy ((is_lambda (f))) then (cek_run ((continue_with_call (f) (a) ((Dict (Hashtbl.create 0))) (a) ((List []))))) else (if sx_truthy ((is_callable (f))) then (sx_apply f a) else Nil))))
+
+(* reactive-shift-deref *)
+and reactive_shift_deref sig' env kont =
+  (let scan_result = (kont_capture_to_reactive_reset (kont)) in let captured_frames = (first (scan_result)) in let reset_frame = (nth (scan_result) ((Number 1.0))) in let remaining_kont = (nth (scan_result) ((Number 2.0))) in let update_fn = (get (reset_frame) ((String "update-fn"))) in (let sub_disposers = ref ((List [])) in (let subscriber = (fun () -> let sub_disposers = ref Nil in (let () = ignore ((List.iter (fun d -> ignore ((cek_call (d) (Nil)))) (sx_to_list !sub_disposers); Nil)) in (let () = ignore ((sub_disposers := (List []); Nil)) in (let new_reset = (make_reactive_reset_frame (env) (update_fn) ((Bool false))) in let new_kont = (prim_call "concat" [captured_frames; (List [new_reset]); remaining_kont]) in (with_island_scope ((fun d -> (sx_append_b !sub_disposers d))) ((fun () -> (cek_run ((make_cek_value ((signal_value (sig'))) (env) (new_kont))))))))))) in (let () = ignore ((signal_add_sub_b (sig') (subscriber))) in (let () = ignore ((register_in_scope ((fun () -> (let () = ignore ((signal_remove_sub_b (sig') (subscriber))) in (List.iter (fun d -> ignore ((cek_call (d) (Nil)))) (sx_to_list !sub_disposers); Nil)))))) in (let initial_kont = (prim_call "concat" [captured_frames; (List [reset_frame]); remaining_kont]) in (make_cek_value ((signal_value (sig'))) (env) (initial_kont))))))))
+
+(* step-eval-call *)
+and step_eval_call head args env kont =
+  (let hname = (if sx_truthy ((prim_call "=" [(type_of (head)); (String "symbol")])) then (symbol_name (head)) else Nil) in (make_cek_state (head) (env) ((kont_push ((make_arg_frame (Nil) ((List [])) (args) (env) (args) (hname))) (kont)))))
+
+(* ho-form-name? *)
+and ho_form_name_p name =
+  (let _or = (prim_call "=" [name; (String "map")]) in if sx_truthy _or then _or else (let _or = (prim_call "=" [name; (String "map-indexed")]) in if sx_truthy _or then _or else (let _or = (prim_call "=" [name; (String "filter")]) in if sx_truthy _or then _or else (let _or = (prim_call "=" [name; (String "reduce")]) in if sx_truthy _or then _or else (let _or = (prim_call "=" [name; (String "some")]) in if sx_truthy _or then _or else (let _or = (prim_call "=" [name; (String "every?")]) in if sx_truthy _or then _or else (prim_call "=" [name; (String "for-each")])))))))
+
+(* ho-fn? *)
+and ho_fn_p v =
+  (let _or = (is_callable (v)) in if sx_truthy _or then _or else (is_lambda (v)))
+
+(* ho-swap-args *)
+and ho_swap_args ho_type evaled =
+  (if sx_truthy ((prim_call "=" [ho_type; (String "reduce")])) then (let a = (first (evaled)) in let b = (nth (evaled) ((Number 1.0))) in (if sx_truthy ((let _and = (Bool (not (sx_truthy ((ho_fn_p (a)))))) in if not (sx_truthy _and) then _and else (ho_fn_p (b)))) then (List [b; (nth (evaled) ((Number 2.0))); a]) else evaled)) else (let a = (first (evaled)) in let b = (nth (evaled) ((Number 1.0))) in (if sx_truthy ((let _and = (Bool (not (sx_truthy ((ho_fn_p (a)))))) in if not (sx_truthy _and) then _and else (ho_fn_p (b)))) then (List [b; a]) else evaled)))
+
+(* ho-setup-dispatch *)
+and ho_setup_dispatch ho_type evaled env kont =
+  (let ordered = (ho_swap_args (ho_type) (evaled)) in (let f = (first (ordered)) in (if sx_truthy ((prim_call "=" [ho_type; (String "map")])) then (let coll = (nth (ordered) ((Number 1.0))) in (if sx_truthy ((empty_p (coll))) then (make_cek_value ((List [])) (env) (kont)) else (continue_with_call (f) ((List [(first (coll))])) (env) ((List [])) ((kont_push ((make_map_frame (f) ((rest (coll))) ((List [])) (env))) (kont)))))) else (if sx_truthy ((prim_call "=" [ho_type; (String "map-indexed")])) then (let coll = (nth (ordered) ((Number 1.0))) in (if sx_truthy ((empty_p (coll))) then (make_cek_value ((List [])) (env) (kont)) else (continue_with_call (f) ((List [(Number 0.0); (first (coll))])) (env) ((List [])) ((kont_push ((make_map_indexed_frame (f) ((rest (coll))) ((List [])) (env))) (kont)))))) else (if sx_truthy ((prim_call "=" [ho_type; (String "filter")])) then (let coll = (nth (ordered) ((Number 1.0))) in (if sx_truthy ((empty_p (coll))) then (make_cek_value ((List [])) (env) (kont)) else (continue_with_call (f) ((List [(first (coll))])) (env) ((List [])) ((kont_push ((make_filter_frame (f) ((rest (coll))) ((List [])) ((first (coll))) (env))) (kont)))))) else (if sx_truthy ((prim_call "=" [ho_type; (String "reduce")])) then (let init = (nth (ordered) ((Number 1.0))) in let coll = (nth (ordered) ((Number 2.0))) in (if sx_truthy ((empty_p (coll))) then (make_cek_value (init) (env) (kont)) else (continue_with_call (f) ((List [init; (first (coll))])) (env) ((List [])) ((kont_push ((make_reduce_frame (f) ((rest (coll))) (env))) (kont)))))) else (if sx_truthy ((prim_call "=" [ho_type; (String "some")])) then (let coll = (nth (ordered) ((Number 1.0))) in (if sx_truthy ((empty_p (coll))) then (make_cek_value ((Bool false)) (env) (kont)) else (continue_with_call (f) ((List [(first (coll))])) (env) ((List [])) ((kont_push ((make_some_frame (f) ((rest (coll))) (env))) (kont)))))) else (if sx_truthy ((prim_call "=" [ho_type; (String "every")])) then (let coll = (nth (ordered) ((Number 1.0))) in (if sx_truthy ((empty_p (coll))) then (make_cek_value ((Bool true)) (env) (kont)) else (continue_with_call (f) ((List [(first (coll))])) (env) ((List [])) ((kont_push ((make_every_frame (f) ((rest (coll))) (env))) (kont)))))) else (if sx_truthy ((prim_call "=" [ho_type; (String "for-each")])) then (let coll = (nth (ordered) ((Number 1.0))) in (if sx_truthy ((empty_p (coll))) then (make_cek_value (Nil) (env) (kont)) else (continue_with_call (f) ((List [(first (coll))])) (env) ((List [])) ((kont_push ((make_for_each_frame (f) ((rest (coll))) (env))) (kont)))))) else (raise (Eval_error (value_to_str (String (sx_str [(String "Unknown HO type: "); ho_type]))))))))))))))
+
+(* step-ho-map *)
+and step_ho_map args env kont =
+  (make_cek_state ((first (args))) (env) ((kont_push ((make_ho_setup_frame ((String "map")) ((rest (args))) ((List [])) (env))) (kont))))
+
+(* step-ho-map-indexed *)
+and step_ho_map_indexed args env kont =
+  (make_cek_state ((first (args))) (env) ((kont_push ((make_ho_setup_frame ((String "map-indexed")) ((rest (args))) ((List [])) (env))) (kont))))
+
+(* step-ho-filter *)
+and step_ho_filter args env kont =
+  (make_cek_state ((first (args))) (env) ((kont_push ((make_ho_setup_frame ((String "filter")) ((rest (args))) ((List [])) (env))) (kont))))
+
+(* step-ho-reduce *)
+and step_ho_reduce args env kont =
+  (make_cek_state ((first (args))) (env) ((kont_push ((make_ho_setup_frame ((String "reduce")) ((rest (args))) ((List [])) (env))) (kont))))
+
+(* step-ho-some *)
+and step_ho_some args env kont =
+  (make_cek_state ((first (args))) (env) ((kont_push ((make_ho_setup_frame ((String "some")) ((rest (args))) ((List [])) (env))) (kont))))
+
+(* step-ho-every *)
+and step_ho_every args env kont =
+  (make_cek_state ((first (args))) (env) ((kont_push ((make_ho_setup_frame ((String "every")) ((rest (args))) ((List [])) (env))) (kont))))
+
+(* step-ho-for-each *)
+and step_ho_for_each args env kont =
+  (make_cek_state ((first (args))) (env) ((kont_push ((make_ho_setup_frame ((String "for-each")) ((rest (args))) ((List [])) (env))) (kont))))
+
+(* step-continue *)
+and step_continue state =
+  (let value = (cek_value (state)) in let env = (cek_env (state)) in let kont = (cek_kont (state)) in (if sx_truthy ((kont_empty_p (kont))) then state else (let frame = (kont_top (kont)) in let rest_k = (kont_pop (kont)) in let ft = (frame_type (frame)) in (if sx_truthy ((prim_call "=" [ft; (String "if")])) then (if sx_truthy ((let _and = value in if not (sx_truthy _and) then _and else (Bool (not (sx_truthy ((is_nil (value)))))))) then (make_cek_state ((get (frame) ((String "then")))) ((get (frame) ((String "env")))) (rest_k)) else (if sx_truthy ((is_nil ((get (frame) ((String "else")))))) then (make_cek_value (Nil) (env) (rest_k)) else (make_cek_state ((get (frame) ((String "else")))) ((get (frame) ((String "env")))) (rest_k)))) else (if sx_truthy ((prim_call "=" [ft; (String "when")])) then (if sx_truthy ((let _and = value in if not (sx_truthy _and) then _and else (Bool (not (sx_truthy ((is_nil (value)))))))) then (let body = (get (frame) ((String "body"))) in let fenv = (get (frame) ((String "env"))) in (if sx_truthy ((empty_p (body))) then (make_cek_value (Nil) (fenv) (rest_k)) else (if sx_truthy ((prim_call "=" [(len (body)); (Number 1.0)])) then (make_cek_state ((first (body))) (fenv) (rest_k)) else (make_cek_state ((first (body))) (fenv) ((kont_push ((make_begin_frame ((rest (body))) (fenv))) (rest_k))))))) else (make_cek_value (Nil) (env) (rest_k))) else (if sx_truthy ((prim_call "=" [ft; (String "begin")])) then (let remaining = (get (frame) ((String "remaining"))) in let fenv = (get (frame) ((String "env"))) in (if sx_truthy ((empty_p (remaining))) then (make_cek_value (value) (fenv) (rest_k)) else (if sx_truthy ((prim_call "=" [(len (remaining)); (Number 1.0)])) then (make_cek_state ((first (remaining))) (fenv) (rest_k)) else (make_cek_state ((first (remaining))) (fenv) ((kont_push ((make_begin_frame ((rest (remaining))) (fenv))) (rest_k))))))) else (if sx_truthy ((prim_call "=" [ft; (String "let")])) then (let name = (get (frame) ((String "name"))) in let remaining = (get (frame) ((String "remaining"))) in let body = (get (frame) ((String "body"))) in let local = (get (frame) ((String "env"))) in (let () = ignore ((env_bind local (sx_to_string name) value)) in (if sx_truthy ((empty_p (remaining))) then (step_sf_begin (body) (local) (rest_k)) else (let next_binding = (first (remaining)) in let vname = (if sx_truthy ((prim_call "=" [(type_of ((first (next_binding)))); (String "symbol")])) then (symbol_name ((first (next_binding)))) else (first (next_binding))) in (make_cek_state ((nth (next_binding) ((Number 1.0)))) (local) ((kont_push ((make_let_frame (vname) ((rest (remaining))) (body) (local))) (rest_k)))))))) else (if sx_truthy ((prim_call "=" [ft; (String "define")])) then (let name = (get (frame) ((String "name"))) in let fenv = (get (frame) ((String "env"))) in let has_effects = (get (frame) ((String "has-effects"))) in let effect_list = (get (frame) ((String "effect-list"))) in (let () = ignore ((if sx_truthy ((let _and = (is_lambda (value)) in if not (sx_truthy _and) then _and else (is_nil ((lambda_name (value)))))) then (set_lambda_name value (sx_to_string name)) else Nil)) in (let () = ignore ((env_bind fenv (sx_to_string name) value)) in (let () = ignore ((if sx_truthy (has_effects) then (let effect_names = (if sx_truthy ((prim_call "=" [(type_of (effect_list)); (String "list")])) then (List (List.map (fun e -> (if sx_truthy ((prim_call "=" [(type_of (e)); (String "symbol")])) then (symbol_name (e)) else (String (sx_str [e])))) (sx_to_list effect_list))) else (List [(String (sx_str [effect_list]))])) in let effect_anns = (if sx_truthy ((env_has (fenv) ((String "*effect-annotations*")))) then (env_get (fenv) ((String "*effect-annotations*"))) else (Dict (Hashtbl.create 0))) in (let () = ignore ((sx_dict_set_b effect_anns name effect_names)) in (env_bind fenv (sx_to_string (String "*effect-annotations*")) effect_anns))) else Nil)) in (make_cek_value (value) (fenv) (rest_k)))))) else (if sx_truthy ((prim_call "=" [ft; (String "set")])) then (let name = (get (frame) ((String "name"))) in let fenv = (get (frame) ((String "env"))) in (let () = ignore ((env_set fenv (sx_to_string name) value)) in (make_cek_value (value) (env) (rest_k)))) else (if sx_truthy ((prim_call "=" [ft; (String "and")])) then (if sx_truthy ((Bool (not (sx_truthy (value))))) then (make_cek_value (value) (env) (rest_k)) else (let remaining = (get (frame) ((String "remaining"))) in (if sx_truthy ((empty_p (remaining))) then (make_cek_value (value) (env) (rest_k)) else (make_cek_state ((first (remaining))) ((get (frame) ((String "env")))) ((if sx_truthy ((prim_call "=" [(len (remaining)); (Number 1.0)])) then rest_k else (kont_push ((make_and_frame ((rest (remaining))) ((get (frame) ((String "env")))))) (rest_k)))))))) else (if sx_truthy ((prim_call "=" [ft; (String "or")])) then (if sx_truthy (value) then (make_cek_value (value) (env) (rest_k)) else (let remaining = (get (frame) ((String "remaining"))) in (if sx_truthy ((empty_p (remaining))) then (make_cek_value ((Bool false)) (env) (rest_k)) else (make_cek_state ((first (remaining))) ((get (frame) ((String "env")))) ((if sx_truthy ((prim_call "=" [(len (remaining)); (Number 1.0)])) then rest_k else (kont_push ((make_or_frame ((rest (remaining))) ((get (frame) ((String "env")))))) (rest_k)))))))) else (if sx_truthy ((prim_call "=" [ft; (String "cond")])) then (let remaining = (get (frame) ((String "remaining"))) in let fenv = (get (frame) ((String "env"))) in let scheme_p = (get (frame) ((String "scheme"))) in (if sx_truthy (scheme_p) then (if sx_truthy (value) then (make_cek_state ((nth ((first (remaining))) ((Number 1.0)))) (fenv) (rest_k)) else (let next_clauses = (rest (remaining)) in (if sx_truthy ((empty_p (next_clauses))) then (make_cek_value (Nil) (fenv) (rest_k)) else (let next_clause = (first (next_clauses)) in let next_test = (first (next_clause)) in (if sx_truthy ((let _or = (let _and = (prim_call "=" [(type_of (next_test)); (String "symbol")]) in if not (sx_truthy _and) then _and else (let _or = (prim_call "=" [(symbol_name (next_test)); (String "else")]) in if sx_truthy _or then _or else (prim_call "=" [(symbol_name (next_test)); (String ":else")]))) in if sx_truthy _or then _or else (let _and = (prim_call "=" [(type_of (next_test)); (String "keyword")]) in if not (sx_truthy _and) then _and else (prim_call "=" [(keyword_name (next_test)); (String "else")])))) then (make_cek_state ((nth (next_clause) ((Number 1.0)))) (fenv) (rest_k)) else (make_cek_state (next_test) (fenv) ((kont_push ((make_cond_frame (next_clauses) (fenv) ((Bool true)))) (rest_k))))))))) else (if sx_truthy (value) then (make_cek_state ((nth (remaining) ((Number 1.0)))) (fenv) (rest_k)) else (let next = (prim_call "slice" [remaining; (Number 2.0)]) in (if sx_truthy ((prim_call "<" [(len (next)); (Number 2.0)])) then (make_cek_value (Nil) (fenv) (rest_k)) else (let next_test = (first (next)) in (if sx_truthy ((let _or = (let _and = (prim_call "=" [(type_of (next_test)); (String "keyword")]) in if not (sx_truthy _and) then _and else (prim_call "=" [(keyword_name (next_test)); (String "else")])) in if sx_truthy _or then _or else (let _and = (prim_call "=" [(type_of (next_test)); (String "symbol")]) in if not (sx_truthy _and) then _and else (let _or = (prim_call "=" [(symbol_name (next_test)); (String "else")]) in if sx_truthy _or then _or else (prim_call "=" [(symbol_name (next_test)); (String ":else")]))))) then (make_cek_state ((nth (next) ((Number 1.0)))) (fenv) (rest_k)) else (make_cek_state (next_test) (fenv) ((kont_push ((make_cond_frame (next) (fenv) ((Bool false)))) (rest_k))))))))))) else (if sx_truthy ((prim_call "=" [ft; (String "case")])) then (let match_val = (get (frame) ((String "match-val"))) in let remaining = (get (frame) ((String "remaining"))) in let fenv = (get (frame) ((String "env"))) in (if sx_truthy ((is_nil (match_val))) then (sf_case_step_loop (value) (remaining) (fenv) (rest_k)) else (sf_case_step_loop (match_val) (remaining) (fenv) (rest_k)))) else (if sx_truthy ((prim_call "=" [ft; (String "thread")])) then (let remaining = (get (frame) ((String "remaining"))) in let fenv = (get (frame) ((String "env"))) in (if sx_truthy ((empty_p (remaining))) then (make_cek_value (value) (fenv) (rest_k)) else (let form = (first (remaining)) in let rest_forms = (rest (remaining)) in let new_kont = (if sx_truthy ((empty_p ((rest (remaining))))) then rest_k else (kont_push ((make_thread_frame ((rest (remaining))) (fenv))) (rest_k))) in (if sx_truthy ((let _and = (prim_call "=" [(type_of (form)); (String "list")]) in if not (sx_truthy _and) then _and else (let _and = (Bool (not (sx_truthy ((empty_p (form)))))) in if not (sx_truthy _and) then _and else (let _and = (prim_call "=" [(type_of ((first (form)))); (String "symbol")]) in if not (sx_truthy _and) then _and else (ho_form_name_p ((symbol_name ((first (form)))))))))) then (make_cek_state ((cons ((first (form))) ((cons ((List [(Symbol "quote"); value])) ((rest (form))))))) (fenv) (new_kont)) else (let result' = (if sx_truthy ((prim_call "=" [(type_of (form)); (String "list")])) then (let f = (trampoline ((eval_expr ((first (form))) (fenv)))) in let rargs = (List (List.map (fun a -> (trampoline ((eval_expr (a) (fenv))))) (sx_to_list (rest (form))))) in let all_args = (cons (value) (rargs)) in (if sx_truthy ((let _and = (is_callable (f)) in if not (sx_truthy _and) then _and else (Bool (not (sx_truthy ((is_lambda (f)))))))) then (sx_apply f all_args) else (if sx_truthy ((is_lambda (f))) then (trampoline ((call_lambda (f) (all_args) (fenv)))) else (raise (Eval_error (value_to_str (String (sx_str [(String "-> form not callable: "); (inspect (f))])))))))) else (let f = (trampoline ((eval_expr (form) (fenv)))) in (if sx_truthy ((let _and = (is_callable (f)) in if not (sx_truthy _and) then _and else (Bool (not (sx_truthy ((is_lambda (f)))))))) then (cek_call (f) (List [value])) else (if sx_truthy ((is_lambda (f))) then (trampoline ((call_lambda (f) ((List [value])) (fenv)))) else (raise (Eval_error (value_to_str (String (sx_str [(String "-> form not callable: "); (inspect (f))]))))))))) in (if sx_truthy ((empty_p (rest_forms))) then (make_cek_value (result') (fenv) (rest_k)) else (make_cek_value (result') (fenv) ((kont_push ((make_thread_frame (rest_forms) (fenv))) (rest_k)))))))))) else (if sx_truthy ((prim_call "=" [ft; (String "arg")])) then (let f = (get (frame) ((String "f"))) in let evaled = (get (frame) ((String "evaled"))) in let remaining = (get (frame) ((String "remaining"))) in let fenv = (get (frame) ((String "env"))) in let raw_args = (get (frame) ((String "raw-args"))) in let hname = (get (frame) ((String "head-name"))) in (if sx_truthy ((is_nil (f))) then (let () = ignore ((if sx_truthy ((let _and = _strict_ in if not (sx_truthy _and) then _and else hname)) then (strict_check_args (hname) ((List []))) else Nil)) in (if sx_truthy ((empty_p (remaining))) then (continue_with_call (value) ((List [])) (fenv) (raw_args) (rest_k)) else (make_cek_state ((first (remaining))) (fenv) ((kont_push ((make_arg_frame (value) ((List [])) ((rest (remaining))) (fenv) (raw_args) (hname))) (rest_k)))))) else (let new_evaled = (prim_call "append" [evaled; (List [value])]) in (if sx_truthy ((empty_p (remaining))) then (let () = ignore ((if sx_truthy ((let _and = _strict_ in if not (sx_truthy _and) then _and else hname)) then (strict_check_args (hname) (new_evaled)) else Nil)) in (continue_with_call (f) (new_evaled) (fenv) (raw_args) (rest_k))) else (make_cek_state ((first (remaining))) (fenv) ((kont_push ((make_arg_frame (f) (new_evaled) ((rest (remaining))) (fenv) (raw_args) (hname))) (rest_k)))))))) else (if sx_truthy ((prim_call "=" [ft; (String "dict")])) then (let remaining = (get (frame) ((String "remaining"))) in let results = (get (frame) ((String "results"))) in let fenv = (get (frame) ((String "env"))) in (let last_result = (last (results)) in let completed = (prim_call "append" [(prim_call "slice" [results; (Number 0.0); (prim_call "dec" [(len (results))])]); (List [(List [(first (last_result)); value])])]) in (if sx_truthy ((empty_p (remaining))) then (let d = (Dict (Hashtbl.create 0)) in (let () = ignore ((List.iter (fun pair -> ignore ((sx_dict_set_b d (first (pair)) (nth (pair) ((Number 1.0)))))) (sx_to_list completed); Nil)) in (make_cek_value (d) (fenv) (rest_k)))) else (let next_entry = (first (remaining)) in (make_cek_state ((nth (next_entry) ((Number 1.0)))) (fenv) ((kont_push ((make_dict_frame ((rest (remaining))) ((prim_call "append" [completed; (List [(List [(first (next_entry))])])])) (fenv))) (rest_k)))))))) else (if sx_truthy ((prim_call "=" [ft; (String "ho-setup")])) then (let ho_type = (get (frame) ((String "ho-type"))) in let remaining = (get (frame) ((String "remaining"))) in let evaled = (prim_call "append" [(get (frame) ((String "evaled"))); (List [value])]) in let fenv = (get (frame) ((String "env"))) in (if sx_truthy ((empty_p (remaining))) then (ho_setup_dispatch (ho_type) (evaled) (fenv) (rest_k)) else (make_cek_state ((first (remaining))) (fenv) ((kont_push ((make_ho_setup_frame (ho_type) ((rest (remaining))) (evaled) (fenv))) (rest_k)))))) else (if sx_truthy ((prim_call "=" [ft; (String "reset")])) then (make_cek_value (value) (env) (rest_k)) else (if sx_truthy ((prim_call "=" [ft; (String "deref")])) then (let val' = value in let fenv = (get (frame) ((String "env"))) in (if sx_truthy ((Bool (not (sx_truthy ((is_signal (val'))))))) then (make_cek_value (val') (fenv) (rest_k)) else (if sx_truthy ((has_reactive_reset_frame_p (rest_k))) then (reactive_shift_deref (val') (fenv) (rest_k)) else (let () = ignore ((let ctx = (sx_context ((String "sx-reactive")) (Nil)) in (if sx_truthy (ctx) then (let dep_list = (get (ctx) ((String "deps"))) in let notify_fn = (get (ctx) ((String "notify"))) in (if sx_truthy ((Bool (not (sx_truthy ((prim_call "contains?" [dep_list; val'])))))) then (let () = ignore ((sx_append_b dep_list val')) in (signal_add_sub_b (val') (notify_fn))) else Nil)) else Nil))) in (make_cek_value ((signal_value (val'))) (fenv) (rest_k)))))) else (if sx_truthy ((prim_call "=" [ft; (String "reactive-reset")])) then (let update_fn = (get (frame) ((String "update-fn"))) in let first_p = (get (frame) ((String "first-render"))) in (let () = ignore ((if sx_truthy ((let _and = update_fn in if not (sx_truthy _and) then _and else (Bool (not (sx_truthy (first_p)))))) then (cek_call (update_fn) ((List [value]))) else Nil)) in (make_cek_value (value) (env) (rest_k)))) else (if sx_truthy ((prim_call "=" [ft; (String "scope")])) then (let name = (get (frame) ((String "name"))) in let remaining = (get (frame) ((String "remaining"))) in let fenv = (get (frame) ((String "env"))) in (if sx_truthy ((empty_p (remaining))) then (let () = ignore ((scope_pop (name))) in (make_cek_value (value) (fenv) (rest_k))) else (make_cek_state ((first (remaining))) (fenv) ((kont_push ((make_scope_frame (name) ((rest (remaining))) (fenv))) (rest_k)))))) else (if sx_truthy ((prim_call "=" [ft; (String "provide")])) then (let remaining = (get (frame) ((String "remaining"))) in let fenv = (get (frame) ((String "env"))) in (if sx_truthy ((empty_p (remaining))) then (make_cek_value (value) (fenv) (rest_k)) else (make_cek_state ((first (remaining))) (fenv) ((kont_push ((make_provide_frame ((get (frame) ((String "name")))) ((get (frame) ((String "value")))) ((rest (remaining))) (fenv))) (rest_k)))))) else (if sx_truthy ((prim_call "=" [ft; (String "scope-acc")])) then (let remaining = (get (frame) ((String "remaining"))) in let fenv = (get (frame) ((String "env"))) in (if sx_truthy ((empty_p (remaining))) then (make_cek_value (value) (fenv) (rest_k)) else (make_cek_state ((first (remaining))) (fenv) ((kont_push ((let new_frame = (make_scope_acc_frame ((get (frame) ((String "name")))) ((get (frame) ((String "value")))) ((rest (remaining))) (fenv)) in (let () = ignore ((sx_dict_set_b new_frame (String "emitted") (get (frame) ((String "emitted"))))) in new_frame))) (rest_k)))))) else (if sx_truthy ((prim_call "=" [ft; (String "map")])) then (let f = (get (frame) ((String "f"))) in let remaining = (get (frame) ((String "remaining"))) in let results = (get (frame) ((String "results"))) in let indexed = (get (frame) ((String "indexed"))) in let fenv = (get (frame) ((String "env"))) in (let new_results = (prim_call "append" [results; (List [value])]) in (if sx_truthy ((empty_p (remaining))) then (make_cek_value (new_results) (fenv) (rest_k)) else (let call_args = (if sx_truthy (indexed) then (List [(len (new_results)); (first (remaining))]) else (List [(first (remaining))])) in let next_frame = (if sx_truthy (indexed) then (make_map_indexed_frame (f) ((rest (remaining))) (new_results) (fenv)) else (make_map_frame (f) ((rest (remaining))) (new_results) (fenv))) in (continue_with_call (f) (call_args) (fenv) ((List [])) ((kont_push (next_frame) (rest_k)))))))) else (if sx_truthy ((prim_call "=" [ft; (String "filter")])) then (let f = (get (frame) ((String "f"))) in let remaining = (get (frame) ((String "remaining"))) in let results = (get (frame) ((String "results"))) in let current_item = (get (frame) ((String "current-item"))) in let fenv = (get (frame) ((String "env"))) in (let new_results = (if sx_truthy (value) then (prim_call "append" [results; (List [current_item])]) else results) in (if sx_truthy ((empty_p (remaining))) then (make_cek_value (new_results) (fenv) (rest_k)) else (continue_with_call (f) ((List [(first (remaining))])) (fenv) ((List [])) ((kont_push ((make_filter_frame (f) ((rest (remaining))) (new_results) ((first (remaining))) (fenv))) (rest_k))))))) else (if sx_truthy ((prim_call "=" [ft; (String "reduce")])) then (let f = (get (frame) ((String "f"))) in let remaining = (get (frame) ((String "remaining"))) in let fenv = (get (frame) ((String "env"))) in (if sx_truthy ((empty_p (remaining))) then (make_cek_value (value) (fenv) (rest_k)) else (continue_with_call (f) ((List [value; (first (remaining))])) (fenv) ((List [])) ((kont_push ((make_reduce_frame (f) ((rest (remaining))) (fenv))) (rest_k)))))) else (if sx_truthy ((prim_call "=" [ft; (String "for-each")])) then (let f = (get (frame) ((String "f"))) in let remaining = (get (frame) ((String "remaining"))) in let fenv = (get (frame) ((String "env"))) in (if sx_truthy ((empty_p (remaining))) then (make_cek_value (Nil) (fenv) (rest_k)) else (continue_with_call (f) ((List [(first (remaining))])) (fenv) ((List [])) ((kont_push ((make_for_each_frame (f) ((rest (remaining))) (fenv))) (rest_k)))))) else (if sx_truthy ((prim_call "=" [ft; (String "some")])) then (let f = (get (frame) ((String "f"))) in let remaining = (get (frame) ((String "remaining"))) in let fenv = (get (frame) ((String "env"))) in (if sx_truthy (value) then (make_cek_value (value) (fenv) (rest_k)) else (if sx_truthy ((empty_p (remaining))) then (make_cek_value ((Bool false)) (fenv) (rest_k)) else (continue_with_call (f) ((List [(first (remaining))])) (fenv) ((List [])) ((kont_push ((make_some_frame (f) ((rest (remaining))) (fenv))) (rest_k))))))) else (if sx_truthy ((prim_call "=" [ft; (String "every")])) then (let f = (get (frame) ((String "f"))) in let remaining = (get (frame) ((String "remaining"))) in let fenv = (get (frame) ((String "env"))) in (if sx_truthy ((Bool (not (sx_truthy (value))))) then (make_cek_value ((Bool false)) (fenv) (rest_k)) else (if sx_truthy ((empty_p (remaining))) then (make_cek_value ((Bool true)) (fenv) (rest_k)) else (continue_with_call (f) ((List [(first (remaining))])) (fenv) ((List [])) ((kont_push ((make_every_frame (f) ((rest (remaining))) (fenv))) (rest_k))))))) else (raise (Eval_error (value_to_str (String (sx_str [(String "Unknown frame type: "); ft]))))))))))))))))))))))))))))))))))
+
+(* continue-with-call *)
+and continue_with_call f args env raw_args kont =
+  (if sx_truthy ((continuation_p (f))) then (let arg = (if sx_truthy ((empty_p (args))) then Nil else (first (args))) in let cont_data = (continuation_data (f)) in (let captured = (get (cont_data) ((String "captured"))) in (let result' = (cek_run ((make_cek_value (arg) (env) (captured)))) in (make_cek_value (result') (env) (kont))))) else (if sx_truthy ((let _and = (is_callable (f)) in if not (sx_truthy _and) then _and else (let _and = (Bool (not (sx_truthy ((is_lambda (f)))))) in if not (sx_truthy _and) then _and else (let _and = (Bool (not (sx_truthy ((is_component (f)))))) in if not (sx_truthy _and) then _and else (Bool (not (sx_truthy ((is_island (f)))))))))) then (make_cek_value ((sx_apply f args)) (env) (kont)) else (if sx_truthy ((is_lambda (f))) then (let params = (lambda_params (f)) in let local = (env_merge ((lambda_closure (f))) (env)) in (if sx_truthy ((prim_call ">" [(len (args)); (len (params))])) then (raise (Eval_error (value_to_str (String (sx_str [(let _or = (lambda_name (f)) in if sx_truthy _or then _or else (String "lambda")); (String " expects "); (len (params)); (String " args, got "); (len (args))]))))) else (let () = ignore ((List.iter (fun pair -> ignore ((env_bind local (sx_to_string (first (pair))) (nth (pair) ((Number 1.0)))))) (sx_to_list (prim_call "zip" [params; args])); Nil)) in (let () = ignore ((List.iter (fun p -> ignore ((env_bind local (sx_to_string p) Nil))) (sx_to_list (prim_call "slice" [params; (len (args))])); Nil)) in (make_cek_state ((lambda_body (f))) (local) (kont)))))) else (if sx_truthy ((let _or = (is_component (f)) in if sx_truthy _or then _or else (is_island (f)))) then (let parsed = (parse_keyword_args (raw_args) (env)) in let kwargs = (first (parsed)) in let children = (nth (parsed) ((Number 1.0))) in let local = (env_merge ((component_closure (f))) (env)) in (let () = ignore ((List.iter (fun p -> ignore ((env_bind local (sx_to_string p) (let _or = (dict_get (kwargs) (p)) in if sx_truthy _or then _or else Nil)))) (sx_to_list (component_params (f))); Nil)) in (let () = ignore ((if sx_truthy ((component_has_children (f))) then (env_bind local (sx_to_string (String "children")) children) else Nil)) in (make_cek_state ((component_body (f))) (local) (kont))))) else (raise (Eval_error (value_to_str (String (sx_str [(String "Not callable: "); (inspect (f))])))))))))
+
+(* sf-case-step-loop *)
+and sf_case_step_loop match_val clauses env kont =
+  (if sx_truthy ((prim_call "<" [(len (clauses)); (Number 2.0)])) then (make_cek_value (Nil) (env) (kont)) else (let test = (first (clauses)) in let body = (nth (clauses) ((Number 1.0))) in (if sx_truthy ((let _or = (let _and = (prim_call "=" [(type_of (test)); (String "keyword")]) in if not (sx_truthy _and) then _and else (prim_call "=" [(keyword_name (test)); (String "else")])) in if sx_truthy _or then _or else (let _and = (prim_call "=" [(type_of (test)); (String "symbol")]) in if not (sx_truthy _and) then _and else (let _or = (prim_call "=" [(symbol_name (test)); (String "else")]) in if sx_truthy _or then _or else (prim_call "=" [(symbol_name (test)); (String ":else")]))))) then (make_cek_state (body) (env) (kont)) else (let test_val = (trampoline ((eval_expr (test) (env)))) in (if sx_truthy ((prim_call "=" [match_val; test_val])) then (make_cek_state (body) (env) (kont)) else (sf_case_step_loop (match_val) ((prim_call "slice" [clauses; (Number 2.0)])) (env) (kont)))))))
+
+(* eval-expr-cek *)
+and eval_expr_cek expr env =
+  (cek_run ((make_cek_state (expr) (env) ((List [])))))
+
+(* trampoline-cek *)
+and trampoline_cek val' =
+  (if sx_truthy ((is_thunk (val'))) then (eval_expr_cek ((thunk_expr (val'))) ((thunk_env (val')))) else val')
+
+(* freeze-registry *)
+and freeze_registry =
+  (Dict (Hashtbl.create 0))
+
+(* freeze-signal *)
+and freeze_signal =
+  (String "effects")
+
+(* freeze-scope *)
+and freeze_scope =
+  (String "effects")
+
+(* cek-freeze-scope *)
+and cek_freeze_scope =
+  (String "effects")
+
+(* cek-freeze-all *)
+and cek_freeze_all =
+  (String "effects")
+
+(* cek-thaw-scope *)
+and cek_thaw_scope =
+  (String "effects")
+
+(* cek-thaw-all *)
+and cek_thaw_all =
+  (String "effects")
+
+(* freeze-to-sx *)
+and freeze_to_sx =
+  (String "effects")
+
+(* thaw-from-sx *)
+and thaw_from_sx =
+  (String "effects")
+
+(* content-store *)
+and content_store =
+  (Dict (Hashtbl.create 0))
+
+(* content-hash *)
+and content_hash =
+  (String "effects")
+
+(* content-put *)
+and content_put =
+  (String "effects")
+
+(* content-get *)
+and content_get =
+  (String "effects")
+
+(* freeze-to-cid *)
+and freeze_to_cid =
+  (String "effects")
+
+(* thaw-from-cid *)
+and thaw_from_cid =
+  (String "effects")
+
+(* eval-expr *)
+and eval_expr expr env =
+  (cek_run ((make_cek_state (expr) (env) ((List [])))))
+
+
+(* Override recursive cek_run with iterative loop *)
+let cek_run_iterative state =
+  let s = ref state in
+  while not (match cek_terminal_p !s with Bool true -> true | _ -> false) do
+    s := cek_step !s
+  done;
+  cek_value !s
+
diff --git a/hosts/ocaml/lib/sx_runtime.ml b/hosts/ocaml/lib/sx_runtime.ml
new file mode 100644
index 0000000..2b513a4
--- /dev/null
+++ b/hosts/ocaml/lib/sx_runtime.ml
@@ -0,0 +1,347 @@
+(** Runtime helpers for transpiled code.
+
+    These bridge the gap between the transpiler's output and the
+    foundation types/primitives. The transpiled evaluator calls these
+    functions directly. *)
+
+open Sx_types
+
+(** Call a registered primitive by name. *)
+let prim_call name args =
+  match Hashtbl.find_opt Sx_primitives.primitives name with
+  | Some f -> f args
+  | None -> raise (Eval_error ("Unknown primitive: " ^ name))
+
+(** Convert any SX value to an OCaml string (internal). *)
+let value_to_str = function
+  | String s -> s
+  | Number n ->
+    if Float.is_integer n then string_of_int (int_of_float n)
+    else Printf.sprintf "%g" n
+  | Bool true -> "true"
+  | Bool false -> "false"
+  | Nil -> ""
+  | Symbol s -> s
+  | Keyword k -> k
+  | v -> inspect v
+
+(** sx_to_string returns a value (String) for transpiled code. *)
+let sx_to_string v = String (value_to_str v)
+
+(** String concatenation helper — [sx_str] takes a list of values. *)
+let sx_str args =
+  String.concat "" (List.map value_to_str args)
+
+(** Convert a value to a list. *)
+let sx_to_list = function
+  | List l -> l
+  | Nil -> []
+  | v -> raise (Eval_error ("Expected list, got " ^ type_of v))
+
+(** Call an SX callable (lambda, native fn, continuation). *)
+let sx_call f args =
+  match f with
+  | NativeFn (_, fn) -> fn args
+  | Lambda l ->
+    let local = Sx_types.env_extend l.l_closure in
+    List.iter2 (fun p a -> ignore (Sx_types.env_bind local p a)) l.l_params args;
+    (* Return the body + env for the trampoline to evaluate *)
+    Thunk (l.l_body, local)
+  | Continuation (k, _) ->
+    k (match args with x :: _ -> x | [] -> Nil)
+  | _ -> raise (Eval_error ("Not callable: " ^ inspect f))
+
+(** Apply a function to a list of args. *)
+let sx_apply f args_list =
+  sx_call f (sx_to_list args_list)
+
+(** Mutable append — add item to a list ref or accumulator.
+    In transpiled code, lists that get appended to are mutable refs. *)
+let sx_append_b lst item =
+  match lst with
+  | List items -> List (items @ [item])
+  | _ -> raise (Eval_error ("append!: expected list, got " ^ type_of lst))
+
+(** Mutable dict-set — set key in dict, return value. *)
+let sx_dict_set_b d k v =
+  match d, k with
+  | Dict tbl, String key -> Hashtbl.replace tbl key v; v
+  | Dict tbl, Keyword key -> Hashtbl.replace tbl key v; v
+  | _ -> raise (Eval_error "dict-set!: expected dict and string key")
+
+(** Get from dict or list. *)
+let get_val container key =
+  match container, key with
+  | Dict d, String k -> dict_get d k
+  | Dict d, Keyword k -> dict_get d k
+  | List l, Number n -> (try List.nth l (int_of_float n) with _ -> Nil)
+  | _ -> raise (Eval_error ("get: unsupported " ^ type_of container ^ " / " ^ type_of key))
+
+(** Register get as a primitive override — transpiled code calls (get d k). *)
+let () =
+  Sx_primitives.register "get" (fun args ->
+    match args with
+    | [c; k] -> get_val c k
+    | _ -> raise (Eval_error "get: 2 args"))
+
+
+(* ====================================================================== *)
+(* Primitive aliases — top-level functions called by transpiled code       *)
+(* ====================================================================== *)
+
+(** The transpiled evaluator calls primitives directly by their mangled
+    OCaml name. These aliases delegate to the primitives table so the
+    transpiled code compiles without needing [prim_call] everywhere. *)
+
+let _prim name = match Hashtbl.find_opt Sx_primitives.primitives name with
+  | Some f -> f | None -> (fun _ -> raise (Eval_error ("Missing prim: " ^ name)))
+
+(* Collection ops *)
+let first args = _prim "first" [args]
+let rest args = _prim "rest" [args]
+let last args = _prim "last" [args]
+let nth coll i = _prim "nth" [coll; i]
+let cons x l = _prim "cons" [x; l]
+let append a b = _prim "append" [a; b]
+let reverse l = _prim "reverse" [l]
+let flatten l = _prim "flatten" [l]
+let concat a b = _prim "concat" [a; b]
+let slice a b = _prim "slice" [a; b]
+let len a = _prim "len" [a]
+let get a b = get_val a b
+let sort' a = _prim "sort" [a]
+let range' a = _prim "range" [a]
+let unique a = _prim "unique" [a]
+let zip a b = _prim "zip" [a; b]
+let zip_pairs a = _prim "zip-pairs" [a]
+let take a b = _prim "take" [a; b]
+let drop a b = _prim "drop" [a; b]
+let chunk_every a b = _prim "chunk-every" [a; b]
+
+(* Predicates *)
+let empty_p a = _prim "empty?" [a]
+let nil_p a = _prim "nil?" [a]
+let number_p a = _prim "number?" [a]
+let string_p a = _prim "string?" [a]
+let boolean_p a = _prim "boolean?" [a]
+let list_p a = _prim "list?" [a]
+let dict_p a = _prim "dict?" [a]
+let symbol_p a = _prim "symbol?" [a]
+let keyword_p a = _prim "keyword?" [a]
+let contains_p a b = _prim "contains?" [a; b]
+let has_key_p a b = _prim "has-key?" [a; b]
+let starts_with_p a b = _prim "starts-with?" [a; b]
+let ends_with_p a b = _prim "ends-with?" [a; b]
+let string_contains_p a b = _prim "string-contains?" [a; b]
+let odd_p a = _prim "odd?" [a]
+let even_p a = _prim "even?" [a]
+let zero_p a = _prim "zero?" [a]
+
+(* String ops *)
+let str' args = String (sx_str args)
+let upper a = _prim "upper" [a]
+let upcase a = _prim "upcase" [a]
+let lower a = _prim "lower" [a]
+let downcase a = _prim "downcase" [a]
+let trim a = _prim "trim" [a]
+let split a b = _prim "split" [a; b]
+let join a b = _prim "join" [a; b]
+let replace a b c = _prim "replace" [a; b; c]
+let index_of a b = _prim "index-of" [a; b]
+let substring a b c = _prim "substring" [a; b; c]
+let string_length a = _prim "string-length" [a]
+let char_from_code a = _prim "char-from-code" [a]
+
+(* Dict ops *)
+let assoc d k v = _prim "assoc" [d; k; v]
+let dissoc d k = _prim "dissoc" [d; k]
+let merge' a b = _prim "merge" [a; b]
+let keys a = _prim "keys" [a]
+let vals a = _prim "vals" [a]
+let dict_set a b c = _prim "dict-set!" [a; b; c]
+let dict_get a b = _prim "dict-get" [a; b]
+let dict_has_p a b = _prim "dict-has?" [a; b]
+let dict_delete a b = _prim "dict-delete!" [a; b]
+
+(* Math *)
+let abs' a = _prim "abs" [a]
+let sqrt' a = _prim "sqrt" [a]
+let pow' a b = _prim "pow" [a; b]
+let floor' a = _prim "floor" [a]
+let ceil' a = _prim "ceil" [a]
+let round' a = _prim "round" [a]
+let min' a b = _prim "min" [a; b]
+let max' a b = _prim "max" [a; b]
+let clamp a b c = _prim "clamp" [a; b; c]
+let parse_int a = _prim "parse-int" [a]
+let parse_float a = _prim "parse-float" [a]
+
+(* Misc *)
+let error msg = raise (Eval_error (value_to_str msg))
+
+(* inspect wrapper — returns String value instead of OCaml string *)
+let inspect v = String (Sx_types.inspect v)
+let apply' f args = sx_apply f args
+let identical_p a b = _prim "identical?" [a; b]
+let _is_spread_prim a = _prim "spread?" [a]
+let spread_attrs a = _prim "spread-attrs" [a]
+let make_spread a = _prim "make-spread" [a]
+
+(* Scope primitives — delegate to sx_ref.py's shared scope stacks *)
+let sx_collect a b = prim_call "collect!" [a; b]
+let sx_collected a = prim_call "collected" [a]
+let sx_clear_collected a = prim_call "clear-collected!" [a]
+let sx_emit a b = prim_call "emit!" [a; b]
+let sx_emitted a = prim_call "emitted" [a]
+let sx_context a b = prim_call "context" [a; b]
+
+(* Trampoline — evaluate thunks iteratively *)
+let trampoline v = v  (* CEK machine doesn't use tree-walk thunks *)
+
+(* Value-returning type predicates — the transpiled code passes these through
+   sx_truthy, so they need to return Bool, not OCaml bool. *)
+(* type_of returns value, not string *)
+let type_of v = String (Sx_types.type_of v)
+
+(* Env operations — accept Env-wrapped values and value keys.
+   The transpiled CEK machine stores envs in dicts as Env values. *)
+let unwrap_env = function
+  | Env e -> e
+  | _ -> raise (Eval_error "Expected env")
+
+let env_has e name = Bool (Sx_types.env_has (unwrap_env e) (value_to_str name))
+let env_get e name = Sx_types.env_get (unwrap_env e) (value_to_str name)
+let env_bind e name v = Sx_types.env_bind (unwrap_env e) (value_to_str name) v
+let env_set e name v = Sx_types.env_set (unwrap_env e) (value_to_str name) v
+
+let make_env () = Env (Sx_types.make_env ())
+let env_extend e = Env (Sx_types.env_extend (unwrap_env e))
+let env_merge a b = Env (Sx_types.env_merge (unwrap_env a) (unwrap_env b))
+
+(* set_lambda_name wrapper — accepts value, extracts string *)
+let set_lambda_name l n = Sx_types.set_lambda_name l (value_to_str n)
+
+let is_nil v = Bool (Sx_types.is_nil v)
+let is_thunk v = Bool (Sx_types.is_thunk v)
+let is_lambda v = Bool (Sx_types.is_lambda v)
+let is_component v = Bool (Sx_types.is_component v)
+let is_island v = Bool (Sx_types.is_island v)
+let is_macro v = Bool (Sx_types.is_macro v)
+let is_signal v = Bool (Sx_types.is_signal v)
+let is_callable v = Bool (Sx_types.is_callable v)
+let is_identical a b = Bool (a == b)
+let is_primitive name = Bool (Sx_primitives.is_primitive (value_to_str name))
+let get_primitive name = Sx_primitives.get_primitive (value_to_str name)
+let is_spread v = match v with Spread _ -> Bool true | _ -> Bool false
+
+(* Stubs for functions defined in sx_ref.ml — resolved at link time *)
+(* These are forward-declared here; sx_ref.ml defines the actual implementations *)
+
+(* strip-prefix *)
+(* Stubs for evaluator functions — defined in sx_ref.ml but
+   sometimes referenced before their definition via forward calls.
+   These get overridden by the actual transpiled definitions. *)
+
+let map_indexed fn coll =
+  List (List.mapi (fun i x -> sx_call fn [Number (float_of_int i); x]) (sx_to_list coll))
+
+let map_dict fn d =
+  match d with
+  | Dict tbl ->
+    let result = Hashtbl.create (Hashtbl.length tbl) in
+    Hashtbl.iter (fun k v -> Hashtbl.replace result k (sx_call fn [String k; v])) tbl;
+    Dict result
+  | _ -> raise (Eval_error "map-dict: expected dict")
+
+let for_each fn coll =
+  List.iter (fun x -> ignore (sx_call fn [x])) (sx_to_list coll);
+  Nil
+
+let for_each_indexed fn coll =
+  List.iteri (fun i x -> ignore (sx_call fn [Number (float_of_int i); x])) (sx_to_list coll);
+  Nil
+
+(* Continuation support *)
+let continuation_p v = match v with Continuation (_, _) -> Bool true | _ -> Bool false
+
+let make_cek_continuation captured rest_kont =
+  let data = Hashtbl.create 2 in
+  Hashtbl.replace data "captured" captured;
+  Hashtbl.replace data "rest-kont" rest_kont;
+  Continuation ((fun v -> v), Some data)
+
+let continuation_data v = match v with
+  | Continuation (_, Some d) -> Dict d
+  | Continuation (_, None) -> Dict (Hashtbl.create 0)
+  | _ -> raise (Eval_error "not a continuation")
+
+(* Dynamic wind — simplified for OCaml (no async) *)
+let dynamic_wind_call before body after _env =
+  ignore (sx_call before []);
+  let result = sx_call body [] in
+  ignore (sx_call after []);
+  result
+
+(* Scope stack stubs — delegated to primitives when available *)
+let scope_push name value = prim_call "collect!" [name; value]
+let scope_pop _name = Nil
+let provide_push name value = ignore name; ignore value; Nil
+let provide_pop _name = Nil
+
+(* Render mode stubs *)
+let render_active_p () = Bool false
+let render_expr _expr _env = Nil
+let is_render_expr _expr = Bool false
+
+(* Signal accessors *)
+let signal_value s = match s with Signal sig' -> sig'.s_value | _ -> raise (Eval_error "not a signal")
+let signal_set_value s v = match s with Signal sig' -> sig'.s_value <- v; v | _ -> raise (Eval_error "not a signal")
+let signal_subscribers s = match s with Signal sig' -> List (List.map (fun _ -> Nil) sig'.s_subscribers) | _ -> List []
+let signal_add_sub_b _s _f = Nil
+let signal_remove_sub_b _s _f = Nil
+let signal_deps _s = List []
+let signal_set_deps _s _d = Nil
+let notify_subscribers _s = Nil
+let flush_subscribers _s = Nil
+let dispose_computed _s = Nil
+
+(* Island scope stubs — accept OCaml functions from transpiled code *)
+let with_island_scope _register_fn body_fn = body_fn ()
+let register_in_scope _dispose_fn = Nil
+
+(* Component type annotation stub *)
+let component_set_param_types_b _comp _types = Nil
+
+(* Parse keyword args from a call — this is defined in evaluator.sx,
+   the transpiled version will override this stub. *)
+(* Forward-reference stubs for evaluator functions used before definition *)
+let parse_comp_params _params = List [List []; Nil; Bool false]
+let parse_macro_params _params = List [List []; Nil]
+
+let parse_keyword_args _raw_args _env =
+  (* Stub — the real implementation is transpiled from evaluator.sx *)
+  List [Dict (Hashtbl.create 0); List []]
+
+(* Make handler/query/action/page def stubs *)
+let make_handler_def name params body _env = Dict (let d = Hashtbl.create 4 in Hashtbl.replace d "type" (String "handler"); Hashtbl.replace d "name" name; Hashtbl.replace d "params" params; Hashtbl.replace d "body" body; d)
+let make_query_def name params body _env = make_handler_def name params body _env
+let make_action_def name params body _env = make_handler_def name params body _env
+let make_page_def name _opts = Dict (let d = Hashtbl.create 4 in Hashtbl.replace d "type" (String "page"); Hashtbl.replace d "name" name; d)
+
+(* sf-def* stubs — platform-specific def-forms, not in the SX spec *)
+let sf_defhandler args env =
+  let name = first args in let rest_args = rest args in
+  make_handler_def name (first rest_args) (nth rest_args (Number 1.0)) env
+let sf_defquery args env = sf_defhandler args env
+let sf_defaction args env = sf_defhandler args env
+let sf_defpage args _env =
+  let name = first args in make_page_def name (rest args)
+
+let strip_prefix s prefix =
+  match s, prefix with
+  | String s, String p ->
+    let pl = String.length p in
+    if String.length s >= pl && String.sub s 0 pl = p
+    then String (String.sub s pl (String.length s - pl))
+    else String s
+  | _ -> s
diff --git a/hosts/ocaml/lib/sx_types.ml b/hosts/ocaml/lib/sx_types.ml
new file mode 100644
index 0000000..5f23296
--- /dev/null
+++ b/hosts/ocaml/lib/sx_types.ml
@@ -0,0 +1,370 @@
+(** Core types for the SX language.
+
+    The [value] sum type represents every possible SX runtime value.
+    OCaml's algebraic types make the CEK machine's frame dispatch a
+    pattern match — exactly what the spec describes. *)
+
+(** {1 Environment} *)
+
+(** Lexical scope chain.  Each frame holds a mutable binding table and
+    an optional parent link for scope-chain lookup. *)
+type env = {
+  bindings : (string, value) Hashtbl.t;
+  parent   : env option;
+}
+
+(** {1 Values} *)
+
+and value =
+  | Nil
+  | Bool   of bool
+  | Number of float
+  | String of string
+  | Symbol of string
+  | Keyword of string
+  | List   of value list
+  | Dict   of dict
+  | Lambda of lambda
+  | Component of component
+  | Island of island
+  | Macro  of macro
+  | Thunk  of value * env
+  | Continuation of (value -> value) * dict option
+  | NativeFn of string * (value list -> value)
+  | Signal of signal
+  | RawHTML of string
+  | Spread of (string * value) list
+  | SxExpr of string  (** Opaque SX wire-format string — aser output. *)
+  | Env of env  (** First-class environment — used by CEK machine state dicts. *)
+
+(** Mutable string-keyed table (SX dicts support [dict-set!]). *)
+and dict = (string, value) Hashtbl.t
+
+and lambda = {
+  l_params  : string list;
+  l_body    : value;
+  l_closure : env;
+  mutable l_name : string option;
+}
+
+and component = {
+  c_name         : string;
+  c_params       : string list;
+  c_has_children : bool;
+  c_body         : value;
+  c_closure      : env;
+  c_affinity     : string;  (** "auto" | "client" | "server" *)
+}
+
+and island = {
+  i_name         : string;
+  i_params       : string list;
+  i_has_children : bool;
+  i_body         : value;
+  i_closure      : env;
+}
+
+and macro = {
+  m_params     : string list;
+  m_rest_param : string option;
+  m_body       : value;
+  m_closure    : env;
+  m_name       : string option;
+}
+
+and signal = {
+  mutable s_value       : value;
+  mutable s_subscribers : (unit -> unit) list;
+  mutable s_deps        : signal list;
+}
+
+
+(** {1 Errors} *)
+
+exception Eval_error of string
+exception Parse_error of string
+
+
+(** {1 Environment operations} *)
+
+let make_env () =
+  { bindings = Hashtbl.create 16; parent = None }
+
+let env_extend parent =
+  { bindings = Hashtbl.create 16; parent = Some parent }
+
+let env_bind env name v =
+  Hashtbl.replace env.bindings name v; Nil
+
+let rec env_has env name =
+  Hashtbl.mem env.bindings name ||
+  match env.parent with Some p -> env_has p name | None -> false
+
+let rec env_get env name =
+  match Hashtbl.find_opt env.bindings name with
+  | Some v -> v
+  | None ->
+    match env.parent with
+    | Some p -> env_get p name
+    | None -> raise (Eval_error ("Undefined symbol: " ^ name))
+
+let rec env_set env name v =
+  if Hashtbl.mem env.bindings name then
+    (Hashtbl.replace env.bindings name v; Nil)
+  else
+    match env.parent with
+    | Some p -> env_set p name v
+    | None -> Hashtbl.replace env.bindings name v; Nil
+
+let env_merge base overlay =
+  let e = { bindings = Hashtbl.copy base.bindings; parent = base.parent } in
+  Hashtbl.iter (fun k v -> Hashtbl.replace e.bindings k v) overlay.bindings;
+  e
+
+
+(** {1 Value extraction helpers} *)
+
+let value_to_string = function
+  | String s -> s | Symbol s -> s | Keyword k -> k
+  | Number n -> if Float.is_integer n then string_of_int (int_of_float n) else Printf.sprintf "%g" n
+  | Bool true -> "true" | Bool false -> "false"
+  | Nil -> "" | _ -> "<value>"
+
+let value_to_string_list = function
+  | List items -> List.map value_to_string items
+  | _ -> []
+
+let value_to_bool = function
+  | Bool b -> b | Nil -> false | _ -> true
+
+let value_to_string_opt = function
+  | String s -> Some s | Symbol s -> Some s | Nil -> None | _ -> None
+
+
+(** {1 Constructors — accept [value] args from transpiled code} *)
+
+let unwrap_env_val = function
+  | Env e -> e
+  | _ -> raise (Eval_error "make_lambda: expected env for closure")
+
+let make_lambda params body closure =
+  let ps = match params with
+    | List items -> List.map value_to_string items
+    | _ -> value_to_string_list params
+  in
+  Lambda { l_params = ps; l_body = body; l_closure = unwrap_env_val closure; l_name = None }
+
+let make_component name params has_children body closure affinity =
+  let n = value_to_string name in
+  let ps = value_to_string_list params in
+  let hc = value_to_bool has_children in
+  let aff = match affinity with String s -> s | _ -> "auto" in
+  Component {
+    c_name = n; c_params = ps; c_has_children = hc;
+    c_body = body; c_closure = unwrap_env_val closure; c_affinity = aff;
+  }
+
+let make_island name params has_children body closure =
+  let n = value_to_string name in
+  let ps = value_to_string_list params in
+  let hc = value_to_bool has_children in
+  Island {
+    i_name = n; i_params = ps; i_has_children = hc;
+    i_body = body; i_closure = unwrap_env_val closure;
+  }
+
+let make_macro params rest_param body closure name =
+  let ps = value_to_string_list params in
+  let rp = value_to_string_opt rest_param in
+  let n = value_to_string_opt name in
+  Macro {
+    m_params = ps; m_rest_param = rp;
+    m_body = body; m_closure = unwrap_env_val closure; m_name = n;
+  }
+
+let make_thunk expr env = Thunk (expr, unwrap_env_val env)
+
+let make_symbol name = Symbol (value_to_string name)
+let make_keyword name = Keyword (value_to_string name)
+
+
+(** {1 Type inspection} *)
+
+let type_of = function
+  | Nil            -> "nil"
+  | Bool _         -> "boolean"
+  | Number _       -> "number"
+  | String _       -> "string"
+  | Symbol _       -> "symbol"
+  | Keyword _      -> "keyword"
+  | List _         -> "list"
+  | Dict _         -> "dict"
+  | Lambda _       -> "lambda"
+  | Component _    -> "component"
+  | Island _       -> "island"
+  | Macro _        -> "macro"
+  | Thunk _        -> "thunk"
+  | Continuation (_, _) -> "continuation"
+  | NativeFn _     -> "function"
+  | Signal _       -> "signal"
+  | RawHTML _      -> "raw-html"
+  | Spread _       -> "spread"
+  | SxExpr _       -> "sx-expr"
+  | Env _          -> "env"
+
+let is_nil = function Nil -> true | _ -> false
+let is_lambda = function Lambda _ -> true | _ -> false
+let is_component = function Component _ -> true | _ -> false
+let is_island = function Island _ -> true | _ -> false
+let is_macro = function Macro _ -> true | _ -> false
+let is_thunk = function Thunk _ -> true | _ -> false
+let is_signal = function Signal _ -> true | _ -> false
+
+let is_callable = function
+  | Lambda _ | NativeFn _ | Continuation (_, _) -> true
+  | _ -> false
+
+
+(** {1 Truthiness} *)
+
+(** SX truthiness: everything is truthy except [Nil] and [Bool false]. *)
+let sx_truthy = function
+  | Nil | Bool false -> false
+  | _ -> true
+
+
+(** {1 Accessors} *)
+
+let symbol_name = function
+  | Symbol s -> String s
+  | v -> raise (Eval_error ("Expected symbol, got " ^ type_of v))
+
+let keyword_name = function
+  | Keyword k -> String k
+  | v -> raise (Eval_error ("Expected keyword, got " ^ type_of v))
+
+let lambda_params = function
+  | Lambda l -> List (List.map (fun s -> String s) l.l_params)
+  | v -> raise (Eval_error ("Expected lambda, got " ^ type_of v))
+
+let lambda_body = function
+  | Lambda l -> l.l_body
+  | v -> raise (Eval_error ("Expected lambda, got " ^ type_of v))
+
+let lambda_closure = function
+  | Lambda l -> Env l.l_closure
+  | v -> raise (Eval_error ("Expected lambda, got " ^ type_of v))
+
+let lambda_name = function
+  | Lambda l -> (match l.l_name with Some n -> String n | None -> Nil)
+  | v -> raise (Eval_error ("Expected lambda, got " ^ type_of v))
+
+let set_lambda_name l n = match l with
+  | Lambda l -> l.l_name <- Some n; Nil
+  | _ -> raise (Eval_error "set-lambda-name!: not a lambda")
+
+let component_name = function
+  | Component c -> String c.c_name
+  | v -> raise (Eval_error ("Expected component, got " ^ type_of v))
+
+let component_params = function
+  | Component c -> List (List.map (fun s -> String s) c.c_params)
+  | v -> raise (Eval_error ("Expected component, got " ^ type_of v))
+
+let component_body = function
+  | Component c -> c.c_body
+  | v -> raise (Eval_error ("Expected component, got " ^ type_of v))
+
+let component_closure = function
+  | Component c -> Env c.c_closure
+  | v -> raise (Eval_error ("Expected component, got " ^ type_of v))
+
+let component_has_children = function
+  | Component c -> Bool c.c_has_children
+  | v -> raise (Eval_error ("Expected component, got " ^ type_of v))
+
+let component_affinity = function
+  | Component c -> String c.c_affinity
+  | _ -> String "auto"
+
+let macro_params = function
+  | Macro m -> List (List.map (fun s -> String s) m.m_params)
+  | v -> raise (Eval_error ("Expected macro, got " ^ type_of v))
+
+let macro_rest_param = function
+  | Macro m -> (match m.m_rest_param with Some s -> String s | None -> Nil)
+  | v -> raise (Eval_error ("Expected macro, got " ^ type_of v))
+
+let macro_body = function
+  | Macro m -> m.m_body
+  | v -> raise (Eval_error ("Expected macro, got " ^ type_of v))
+
+let macro_closure = function
+  | Macro m -> Env m.m_closure
+  | v -> raise (Eval_error ("Expected macro, got " ^ type_of v))
+
+let thunk_expr = function
+  | Thunk (e, _) -> e
+  | v -> raise (Eval_error ("Expected thunk, got " ^ type_of v))
+
+let thunk_env = function
+  | Thunk (_, e) -> Env e
+  | v -> raise (Eval_error ("Expected thunk, got " ^ type_of v))
+
+
+(** {1 Dict operations} *)
+
+let make_dict () : dict = Hashtbl.create 8
+
+let dict_get (d : dict) key =
+  match Hashtbl.find_opt d key with Some v -> v | None -> Nil
+
+let dict_has (d : dict) key = Hashtbl.mem d key
+
+let dict_set (d : dict) key v = Hashtbl.replace d key v
+
+let dict_delete (d : dict) key = Hashtbl.remove d key
+
+let dict_keys (d : dict) =
+  Hashtbl.fold (fun k _ acc -> String k :: acc) d []
+
+let dict_vals (d : dict) =
+  Hashtbl.fold (fun _ v acc -> v :: acc) d []
+
+
+(** {1 Value display} *)
+
+let rec inspect = function
+  | Nil -> "nil"
+  | Bool true -> "true"
+  | Bool false -> "false"
+  | Number n ->
+    if Float.is_integer n then Printf.sprintf "%d" (int_of_float n)
+    else Printf.sprintf "%g" n
+  | String s -> Printf.sprintf "%S" s
+  | Symbol s -> s
+  | Keyword k -> ":" ^ k
+  | List items ->
+    "(" ^ String.concat " " (List.map inspect items) ^ ")"
+  | Dict d ->
+    let pairs = Hashtbl.fold (fun k v acc ->
+      (Printf.sprintf ":%s %s" k (inspect v)) :: acc) d [] in
+    "{" ^ String.concat " " pairs ^ "}"
+  | Lambda l ->
+    let tag = match l.l_name with Some n -> n | None -> "lambda" in
+    Printf.sprintf "<%s(%s)>" tag (String.concat ", " l.l_params)
+  | Component c ->
+    Printf.sprintf "<Component ~%s(%s)>" c.c_name (String.concat ", " c.c_params)
+  | Island i ->
+    Printf.sprintf "<Island ~%s(%s)>" i.i_name (String.concat ", " i.i_params)
+  | Macro m ->
+    let tag = match m.m_name with Some n -> n | None -> "macro" in
+    Printf.sprintf "<%s(%s)>" tag (String.concat ", " m.m_params)
+  | Thunk _ -> "<thunk>"
+  | Continuation (_, _) -> "<continuation>"
+  | NativeFn (name, _) -> Printf.sprintf "<native:%s>" name
+  | Signal _ -> "<signal>"
+  | RawHTML s -> Printf.sprintf "<raw-html:%d chars>" (String.length s)
+  | Spread _ -> "<spread>"
+  | SxExpr s -> Printf.sprintf "<sx-expr:%d chars>" (String.length s)
+  | Env _ -> "<env>"
diff --git a/hosts/ocaml/transpiler.sx b/hosts/ocaml/transpiler.sx
new file mode 100644
index 0000000..de233df
--- /dev/null
+++ b/hosts/ocaml/transpiler.sx
@@ -0,0 +1,1212 @@
+;; ==========================================================================
+;; ml.sx — SX-to-OCaml translator, written in SX
+;;
+;; Translates (define ...) forms from .sx spec files into OCaml source.
+;; The Python evaluator executes this file against the spec to produce
+;; sx_ref.ml — the transpiled evaluator as native OCaml.
+;;
+;; Usage (from SX):
+;;   (ml-expr expr)              — translate one expression to OCaml
+;;   (ml-statement expr)         — translate to OCaml top-level statement
+;;   (ml-translate-file defines) — translate a list of (name . define-expr) pairs
+;; ==========================================================================
+
+
+;; --------------------------------------------------------------------------
+;; OCaml reserved words — names that get _ suffix
+;; --------------------------------------------------------------------------
+
+(define ml-reserved
+  (list "and" "as" "assert" "asr" "begin" "class" "constraint" "do" "done"
+        "downto" "else" "end" "exception" "external" "false" "for" "fun"
+        "function" "functor" "if" "in" "include" "inherit" "initializer"
+        "land" "lazy" "let" "lor" "lsl" "lsr" "lxor" "match" "method"
+        "mod" "module" "mutable" "new" "nonrec" "object" "of" "open"
+        "or" "private" "rec" "sig" "struct" "then" "to" "true" "try"
+        "type" "val" "virtual" "when" "while" "with"
+        "ref" "not" "ignore" "print" "list" "string" "int" "float"
+        "option" "result"))
+
+
+;; --------------------------------------------------------------------------
+;; RENAMES table — explicit SX name → OCaml name mappings
+;; --------------------------------------------------------------------------
+
+(define ml-renames {
+  :nil "Nil"
+  :true "(Bool true)"
+  :false "(Bool false)"
+  "nil?" "is_nil"
+  "type-of" "type_of"
+  "symbol-name" "symbol_name"
+  "keyword-name" "keyword_name"
+  "make-lambda" "make_lambda"
+  "make-component" "make_component"
+  "make-macro" "make_macro"
+  "make-thunk" "make_thunk"
+  "make-symbol" "make_symbol"
+  "make-keyword" "make_keyword"
+  "lambda-params" "lambda_params"
+  "lambda-body" "lambda_body"
+  "lambda-closure" "lambda_closure"
+  "lambda-name" "lambda_name"
+  "set-lambda-name!" "set_lambda_name"
+  "component-params" "component_params"
+  "component-body" "component_body"
+  "component-closure" "component_closure"
+  "component-has-children?" "component_has_children"
+  "component-name" "component_name"
+  "component-affinity" "component_affinity"
+  "macro-params" "macro_params"
+  "macro-rest-param" "macro_rest_param"
+  "macro-body" "macro_body"
+  "macro-closure" "macro_closure"
+  "thunk?" "is_thunk"
+  "thunk-expr" "thunk_expr"
+  "thunk-env" "thunk_env"
+  "callable?" "is_callable"
+  "lambda?" "is_lambda"
+  "component?" "is_component"
+  "island?" "is_island"
+  "make-island" "make_island"
+  "macro?" "is_macro"
+  "signal?" "is_signal"
+  "identical?" "is_identical"
+  "primitive?" "is_primitive"
+  "get-primitive" "get_primitive"
+  "env-has?" "env_has"
+  "env-get" "env_get"
+  "env-bind!" "env_bind"
+  "env-set!" "env_set"
+  "env-extend" "env_extend"
+  "env-merge" "env_merge"
+  "dict-set!" "dict_set"
+  "dict-get" "dict_get"
+  "dict-has?" "dict_has"
+  "dict-delete!" "dict_delete"
+  "eval-expr" "eval_expr"
+  "call-lambda" "call_lambda"
+  "expand-macro" "expand_macro"
+  "render-to-html" "render_to_html"
+  "escape-html" "escape_html"
+  "escape-attr" "escape_attr"
+  "escape-string" "escape_string"
+  "raw-html-content" "raw_html_content"
+  "make-raw-html" "make_raw_html"
+  "make-spread" "make_spread"
+  "spread?" "is_spread"
+  "spread-attrs" "spread_attrs"
+  "contains?" "contains_p"
+  "starts-with?" "starts_with_p"
+  "ends-with?" "ends_with_p"
+  "empty?" "empty_p"
+  "every?" "every_p"
+  "for-each" "for_each"
+  "for-each-indexed" "for_each_indexed"
+  "map-indexed" "map_indexed"
+  "map-dict" "map_dict"
+  "string-length" "string_length"
+  "string-contains?" "string_contains_p"
+  "has-key?" "has_key_p"
+  "index-of" "index_of"
+  "char-from-code" "char_from_code"
+  "parse-int" "parse_int"
+  "parse-float" "parse_float"
+  "collect!" "sx_collect"
+  "collected" "sx_collected"
+  "clear-collected!" "sx_clear_collected"
+  "context" "sx_context"
+  "emit!" "sx_emit"
+  "emitted" "sx_emitted"
+  "scope-push!" "scope_push"
+  "scope-pop!" "scope_pop"
+  "provide-push!" "provide_push"
+  "provide-pop!" "provide_pop"
+  "sx-serialize" "sx_serialize"
+  "render-active?" "render_active_p"
+  "is-render-expr?" "is_render_expr"
+  "render-expr" "render_expr"
+  "HTML_TAGS" "html_tags"
+  "VOID_ELEMENTS" "void_elements"
+  "BOOLEAN_ATTRS" "boolean_attrs"
+})
+
+
+;; --------------------------------------------------------------------------
+;; Name mangling: SX identifier → valid OCaml identifier
+;; --------------------------------------------------------------------------
+
+(define ml-mangle
+  (fn ((name :as string))
+    (let ((renamed (get ml-renames name)))
+      (if (not (nil? renamed))
+        renamed
+        ;; General mangling rules
+        (let ((result name))
+          ;; Handle trailing ? and !
+          (let ((result (cond
+                  (ends-with? result "?")
+                    (str (slice result 0 (- (string-length result) 1)) "_p")
+                  (ends-with? result "!")
+                    (str (slice result 0 (- (string-length result) 1)) "_b")
+                  :else result)))
+            ;; Kebab to snake_case
+            (let ((result (replace result "-" "_")))
+              ;; Handle * wrappers (like *strict*)
+              (let ((result (replace result "*" "_")))
+                ;; Escape OCaml reserved words
+                (if (some (fn (r) (= r result)) ml-reserved)
+                  (str result "'")
+                  result)))))))))
+
+
+;; --------------------------------------------------------------------------
+;; Known name detection — distinguishes static OCaml calls from dynamic SX calls.
+;; Names in ml-renames, _known_defines, or ml-runtime-names get direct calls.
+;; Unknown names (local variables) use cek_call for dynamic dispatch.
+;; --------------------------------------------------------------------------
+
+(define ml-runtime-names
+  (list "env-bind!" "env-set!" "env-get" "env-has?" "env-extend" "env-merge"
+        "make-env" "make-lambda" "make-component" "make-island" "make-macro"
+        "make-thunk" "make-symbol" "make-keyword" "set-lambda-name!"
+        "type-of" "symbol-name" "keyword-name" "inspect"
+        "lambda-params" "lambda-body" "lambda-closure" "lambda-name"
+        "component-params" "component-body" "component-closure"
+        "component-has-children?" "component-name" "component-affinity"
+        "macro-params" "macro-rest-param" "macro-body" "macro-closure"
+        "thunk-expr" "thunk-env" "thunk?" "callable?" "lambda?" "component?"
+        "island?" "macro?" "signal?" "primitive?" "nil?" "identical?"
+        "get-primitive" "trampoline" "sx-serialize" "prim-call"
+        "first" "rest" "last" "nth" "cons" "append" "reverse" "flatten"
+        "concat" "len" "get" "empty?" "list?" "dict?" "number?" "string?"
+        "boolean?" "symbol?" "keyword?" "contains?" "has-key?" "starts-with?"
+        "ends-with?" "string-contains?" "odd?" "even?" "zero?"
+        "upper" "upcase" "lower" "downcase" "trim" "split" "join"
+        "replace" "index-of" "substring" "string-length" "char-from-code"
+        "keys" "vals" "assoc" "dissoc" "merge" "dict-set!" "dict-get"
+        "dict-has?" "dict-delete!" "abs" "sqrt" "pow" "floor" "ceil"
+        "round" "min" "max" "clamp" "parse-int" "parse-float"
+        "error" "apply" "make-spread" "spread?" "spread-attrs"
+        "map-indexed" "map-dict" "for-each" "for-each-indexed"
+        "cek-call" "cek-run" "sx-call" "sx-apply"
+        "collect!" "collected" "clear-collected!" "context" "emit!" "emitted"
+        "scope-push!" "scope-pop!" "provide-push!" "provide-pop!"
+        "render-active?" "render-expr" "is-render-expr?"
+        "with-island-scope" "register-in-scope"
+        "signal-value" "signal-set-value" "signal-subscribers"
+        "signal-add-sub!" "signal-remove-sub!" "signal-deps" "signal-set-deps"
+        "notify-subscribers" "flush-subscribers" "dispose-computed"
+        "continuation?" "continuation-data" "make-cek-continuation"
+        "dynamic-wind-call" "strip-prefix"
+        "sf-defhandler" "sf-defpage" "sf-defquery" "sf-defaction"
+        "make-handler-def" "make-query-def" "make-action-def" "make-page-def"
+        "component-set-param-types!" "parse-comp-params" "parse-macro-params"
+        "parse-keyword-args"))
+
+(define ml-is-known-name?
+  (fn ((name :as string))
+    ;; Check renames table
+    (if (not (nil? (get ml-renames name)))
+      true
+      ;; Check runtime names
+      (if (some (fn (r) (= r name)) ml-runtime-names)
+        true
+        ;; Check _known_defines (set by bootstrap.py)
+        (some (fn (d) (= d name)) _known_defines)))))
+
+;; Check if a variable is "dynamic" — locally bound to a non-function expression.
+;; These variables hold SX values (from eval-expr, get, etc.) and need cek_call
+;; when used as callees. We encode this in the set-vars list as "dyn:name".
+(define ml-is-dyn-var?
+  (fn ((name :as string) (set-vars :as list))
+    (some (fn (v) (= v (str "dyn:" name))) set-vars)))
+
+
+;; --------------------------------------------------------------------------
+;; String quoting for OCaml
+;; --------------------------------------------------------------------------
+
+(define ml-quote-string
+  (fn ((s :as string))
+    (str "\"" (replace (replace (replace (replace s "\\" "\\\\") "\"" "\\\"") "\n" "\\n") "\t" "\\t") "\"")))
+
+
+;; --------------------------------------------------------------------------
+;; Detect self-recursion in a define body
+;; --------------------------------------------------------------------------
+
+(define ml-is-self-recursive?
+  (fn ((name :as string) body)
+    (ml-scan-for-name name body)))
+
+(define ml-scan-for-name
+  (fn ((name :as string) node)
+    (cond
+      (and (= (type-of node) "symbol") (= (symbol-name node) name)) true
+      (list? node)
+        (some (fn (child) (ml-scan-for-name name child)) node)
+      :else false)))
+
+
+;; --------------------------------------------------------------------------
+;; let-bound name detection — find variables bound by let in the body
+;; --------------------------------------------------------------------------
+
+(define ml-find-let-bound-names
+  (fn ((body :as list))
+    (let ((result (list)))
+      (begin
+        (for-each (fn (b) (ml-scan-let-names b result)) body)
+        result))))
+
+(define ml-scan-let-names
+  (fn (node (result :as list))
+    (when (and (list? node) (not (empty? node)))
+      (let ((head (first node)))
+        (cond
+          (and (= (type-of head) "symbol")
+               (or (= (symbol-name head) "let") (= (symbol-name head) "let*"))
+               (>= (len node) 2)
+               (list? (nth node 1)))
+            (let ((bindings (nth node 1)))
+              (begin
+                ;; Extract bound names from let bindings
+                (if (and (not (empty? bindings)) (list? (first bindings)))
+                  ;; Scheme-style: ((name val) ...)
+                  (for-each (fn (b)
+                    (when (and (list? b) (>= (len b) 1))
+                      (let ((vname (if (= (type-of (first b)) "symbol")
+                                     (ml-mangle (symbol-name (first b)))
+                                     (str (first b)))))
+                        (when (not (some (fn (x) (= x vname)) result))
+                          (append! result vname)))))
+                    bindings)
+                  ;; Clojure-style: (name val name val ...)
+                  (let ((i 0))
+                    (for-each (fn (item)
+                      (when (= (mod i 2) 0)
+                        (let ((vname (if (= (type-of item) "symbol")
+                                       (ml-mangle (symbol-name item))
+                                       (str item))))
+                          (when (not (some (fn (x) (= x vname)) result))
+                            (append! result vname)))))
+                      bindings)))
+                ;; Also scan body of let for more let-bound names
+                (for-each (fn (child) (ml-scan-let-names child result))
+                  (rest (rest node)))))
+          :else
+            (for-each (fn (child)
+                        (when (list? child)
+                          (ml-scan-let-names child result)))
+                      node))))))
+
+
+;; --------------------------------------------------------------------------
+;; set! target detection — find variables that need ref
+;; --------------------------------------------------------------------------
+
+(define ml-find-set-targets
+  (fn ((body :as list))
+    (let ((result (list)))
+      (begin
+        (for-each (fn (b) (ml-scan-set b result)) body)
+        result))))
+
+(define ml-scan-set
+  (fn (node (result :as list))
+    (when (and (list? node) (not (empty? node)))
+      (let ((head (first node)))
+        (cond
+          (and (= (type-of head) "symbol")
+               (= (symbol-name head) "set!")
+               (>= (len node) 2))
+            (let ((var-name (if (= (type-of (nth node 1)) "symbol")
+                              (symbol-name (nth node 1))
+                              (str (nth node 1)))))
+              (let ((mangled (ml-mangle var-name)))
+                (when (not (some (fn (x) (= x mangled)) result))
+                  (append! result mangled))))
+          :else
+            (for-each (fn (child)
+                        (when (list? child)
+                          (ml-scan-set child result)))
+                      node))))))
+
+
+;; --------------------------------------------------------------------------
+;; Expression translator: SX AST → OCaml expression string
+;; --------------------------------------------------------------------------
+
+(define ml-expr
+  (fn (expr)
+    (ml-expr-inner expr (list))))
+
+(define ml-expr-inner
+  (fn (expr (set-vars :as list))
+    (cond
+      ;; Bool
+      (= (type-of expr) "boolean")
+        (if expr "(Bool true)" "(Bool false)")
+
+      ;; Nil
+      (nil? expr) "Nil"
+
+      ;; Numbers — ensure float suffix for OCaml
+      (number? expr)
+        (if (string-contains? (str expr) ".")
+          (str "(Number " (str expr) ")")
+          (str "(Number " (str expr) ".0)"))
+
+      ;; Strings
+      (string? expr)
+        (str "(String " (ml-quote-string expr) ")")
+
+      ;; Symbols
+      (= (type-of expr) "symbol")
+        (let ((mangled (ml-mangle (symbol-name expr))))
+          (if (some (fn (c) (= c mangled)) set-vars)
+            (str "!" mangled)
+            mangled))
+
+      ;; Keywords → string value
+      (= (type-of expr) "keyword")
+        (str "(String " (ml-quote-string (keyword-name expr)) ")")
+
+      ;; Dicts
+      (= (type-of expr) "dict")
+        (ml-emit-dict-native expr set-vars)
+
+      ;; Lists
+      (list? expr)
+        (if (empty? expr)
+          "[]"
+          (ml-emit-list expr set-vars))
+
+      ;; Fallback
+      :else (str "(* ??? *) " (str expr)))))
+
+
+;; --------------------------------------------------------------------------
+;; Dict emission
+;; --------------------------------------------------------------------------
+
+(define ml-emit-dict-native
+  (fn ((d :as dict) (set-vars :as list))
+    (let ((items (keys d)))
+      (str "(let _d = Hashtbl.create " (str (round (len items)))
+           " in " (join "; " (map (fn (k)
+             (str "Hashtbl.replace _d " (ml-quote-string k)
+                  " " (ml-expr-inner (get d k) set-vars)))
+             items))
+           "; Dict _d)"))))
+
+
+;; --------------------------------------------------------------------------
+;; List/call emission — the main dispatch
+;; --------------------------------------------------------------------------
+
+(define ml-emit-list
+  (fn (expr (set-vars :as list))
+    (let ((head (first expr))
+          (args (rest expr)))
+      (if (not (= (type-of head) "symbol"))
+        ;; Data list
+        (str "[" (join "; " (map (fn (x) (ml-expr-inner x set-vars)) expr)) "]")
+        (let ((op (symbol-name head)))
+          (cond
+            ;; fn/lambda
+            (or (= op "fn") (= op "lambda"))
+              (ml-emit-fn expr set-vars)
+
+            ;; let/let*
+            (or (= op "let") (= op "let*"))
+              (ml-emit-let expr set-vars)
+
+            ;; if
+            (= op "if")
+              (let ((cond-e (ml-expr-inner (nth args 0) set-vars))
+                    (then-e (ml-expr-inner (nth args 1) set-vars))
+                    (else-e (if (>= (len args) 3)
+                              (ml-expr-inner (nth args 2) set-vars)
+                              "Nil")))
+                (str "(if sx_truthy (" cond-e ") then " then-e " else " else-e ")"))
+
+            ;; when
+            (= op "when")
+              (ml-emit-when expr set-vars)
+
+            ;; cond
+            (= op "cond")
+              (ml-emit-cond args set-vars)
+
+            ;; case
+            (= op "case")
+              (ml-emit-case args set-vars)
+
+            ;; and
+            (= op "and")
+              (ml-emit-and args set-vars)
+
+            ;; or
+            (= op "or")
+              (ml-emit-or args set-vars)
+
+            ;; not
+            (= op "not")
+              (str "(Bool (not (sx_truthy (" (ml-expr-inner (first args) set-vars) "))))")
+
+            ;; do/begin
+            (or (= op "do") (= op "begin"))
+              (ml-emit-do args set-vars)
+
+            ;; list literal
+            (= op "list")
+              (str "(List [" (join "; " (map (fn (x) (ml-expr-inner x set-vars)) args)) "])")
+
+            ;; dict literal
+            (= op "dict")
+              (ml-emit-dict-call args set-vars)
+
+            ;; quote
+            (= op "quote")
+              (ml-emit-quote (first args))
+
+            ;; set!
+            (= op "set!")
+              (let ((var-name (if (= (type-of (first args)) "symbol")
+                                (symbol-name (first args))
+                                (str (first args)))))
+                (let ((mangled (ml-mangle var-name)))
+                  (str "(" mangled " := " (ml-expr-inner (nth args 1) set-vars) "; Nil)")))
+
+            ;; str — concatenate
+            (= op "str")
+              (str "(String (sx_str [" (join "; " (map (fn (x) (ml-expr-inner x set-vars)) args)) "]))")
+
+            ;; error
+            (= op "error")
+              (str "(raise (Eval_error (value_to_str " (ml-expr-inner (first args) set-vars) ")))")
+
+            ;; Infix arithmetic — emit as primitive calls
+            (= op "+")
+              (str "(prim_call \"+\" [" (join "; " (map (fn (x) (ml-expr-inner x set-vars)) args)) "])")
+            (= op "-")
+              (str "(prim_call \"-\" [" (join "; " (map (fn (x) (ml-expr-inner x set-vars)) args)) "])")
+            (= op "*")
+              (str "(prim_call \"*\" [" (join "; " (map (fn (x) (ml-expr-inner x set-vars)) args)) "])")
+            (= op "/")
+              (str "(prim_call \"/\" [" (join "; " (map (fn (x) (ml-expr-inner x set-vars)) args)) "])")
+            (= op "mod")
+              (str "(prim_call \"mod\" [" (join "; " (map (fn (x) (ml-expr-inner x set-vars)) args)) "])")
+
+            ;; Comparison — emit as primitive calls
+            (= op "=")
+              (str "(prim_call \"=\" [" (join "; " (map (fn (x) (ml-expr-inner x set-vars)) args)) "])")
+            (= op "!=")
+              (str "(prim_call \"!=\" [" (join "; " (map (fn (x) (ml-expr-inner x set-vars)) args)) "])")
+            (= op "<")
+              (str "(prim_call \"<\" [" (join "; " (map (fn (x) (ml-expr-inner x set-vars)) args)) "])")
+            (= op ">")
+              (str "(prim_call \">\" [" (join "; " (map (fn (x) (ml-expr-inner x set-vars)) args)) "])")
+            (= op "<=")
+              (str "(prim_call \"<=\" [" (join "; " (map (fn (x) (ml-expr-inner x set-vars)) args)) "])")
+            (= op ">=")
+              (str "(prim_call \">=\" [" (join "; " (map (fn (x) (ml-expr-inner x set-vars)) args)) "])")
+
+            ;; apply
+            (= op "apply")
+              (str "(sx_apply " (ml-expr-inner (first args) set-vars)
+                   " " (ml-expr-inner (nth args 1) set-vars) ")")
+
+            ;; for-each
+            (= op "for-each")
+              (ml-emit-for-each args set-vars)
+
+            ;; map, filter, reduce, some, every?
+            (= op "map")
+              (ml-emit-ho-form "List.map" "(fun _x -> " ")" "List" args set-vars)
+            (= op "map-indexed")
+              (ml-emit-ho-indexed args set-vars)
+            (= op "filter")
+              (ml-emit-ho-form "List.filter" "(fun _x -> sx_truthy (" "))" "List" args set-vars)
+            (= op "reduce")
+              (ml-emit-reduce args set-vars)
+            (= op "some")
+              (ml-emit-ho-form "List.exists" "(fun _x -> sx_truthy (" "))" "Bool" args set-vars)
+            (= op "every?")
+              (ml-emit-ho-form "List.for_all" "(fun _x -> sx_truthy (" "))" "Bool" args set-vars)
+
+            ;; map-dict — inline lambda optimization
+            (= op "map-dict")
+              (ml-emit-map-dict args set-vars)
+
+            ;; Mutation forms
+            (= op "append!")
+              (str "(sx_append_b " (ml-expr-inner (nth args 0) set-vars)
+                   " " (ml-expr-inner (nth args 1) set-vars) ")")
+
+            (= op "dict-set!")
+              (str "(sx_dict_set_b " (ml-expr-inner (nth args 0) set-vars)
+                   " " (ml-expr-inner (nth args 1) set-vars)
+                   " " (ml-expr-inner (nth args 2) set-vars) ")")
+
+            (= op "env-bind!")
+              (str "(env_bind " (ml-expr-inner (nth args 0) set-vars)
+                   " (sx_to_string " (ml-expr-inner (nth args 1) set-vars) ")"
+                   " " (ml-expr-inner (nth args 2) set-vars) ")")
+
+            (= op "env-set!")
+              (str "(env_set " (ml-expr-inner (nth args 0) set-vars)
+                   " (sx_to_string " (ml-expr-inner (nth args 1) set-vars) ")"
+                   " " (ml-expr-inner (nth args 2) set-vars) ")")
+
+            (= op "set-lambda-name!")
+              (str "(set_lambda_name " (ml-expr-inner (nth args 0) set-vars)
+                   " (sx_to_string " (ml-expr-inner (nth args 1) set-vars) "))")
+
+            ;; Variadic primitives — always use prim_call
+            (or (= op "slice") (= op "concat") (= op "range")
+                (= op "sort") (= op "merge") (= op "round")
+                (= op "min") (= op "max") (= op "substring")
+                (= op "assoc") (= op "dissoc") (= op "append")
+                (= op "flatten") (= op "unique") (= op "zip")
+                (= op "take") (= op "drop") (= op "chunk-every")
+                (= op "zip-pairs") (= op "format") (= op "replace")
+                (= op "split") (= op "join") (= op "index-of")
+                (= op "dict") (= op "keys") (= op "vals")
+                (= op "has-key?") (= op "contains?")
+                (= op "starts-with?") (= op "ends-with?")
+                (= op "string-contains?") (= op "string-length"))
+              (str "(prim_call " (ml-quote-string op) " [" (join "; " (map (fn (x) (ml-expr-inner x set-vars)) args)) "])")
+
+            ;; inc/dec inlined
+            (= op "inc")
+              (str "(prim_call \"inc\" [" (ml-expr-inner (first args) set-vars) "])")
+            (= op "dec")
+              (str "(prim_call \"dec\" [" (ml-expr-inner (first args) set-vars) "])")
+
+            ;; Regular function call
+            :else
+              (let ((callee (ml-mangle op)))
+                (if (ml-is-dyn-var? op set-vars)
+                  ;; Dynamic callee (local var bound to non-fn expr) — dispatch via cek_call
+                  (str "(cek_call (" callee ") (List [" (join "; " (map (fn (x) (ml-expr-inner x set-vars)) args)) "]))")
+                  ;; Static callee — direct OCaml call
+                  (if (empty? args)
+                    (str "(" callee " ())")
+                    (str "(" callee " " (join " " (map (fn (x) (str "(" (ml-expr-inner x set-vars) ")")) args)) ")"))))))))))
+
+
+;; --------------------------------------------------------------------------
+;; fn/lambda
+;; --------------------------------------------------------------------------
+
+(define ml-emit-fn
+  (fn (expr (set-vars :as list))
+    (let ((params (nth expr 1))
+          (body (rest (rest expr)))
+          (param-strs (ml-collect-params params))
+          (body-set-vars (ml-find-set-targets body))
+          (let-bound (ml-find-let-bound-names body)))
+      (let ((params-str (if (empty? param-strs) "()" (join " " param-strs)))
+            (all-set-vars (append set-vars body-set-vars))
+            ;; Only pre-declare refs for set! targets NOT rebound by let
+            (needs-ref (filter (fn (v) (not (some (fn (lb) (= lb v)) let-bound))) body-set-vars)))
+        (if (empty? body-set-vars)
+          ;; No set! targets — simple function
+          (if (= (len body) 1)
+            (str "(fun " params-str " -> " (ml-expr-inner (first body) all-set-vars) ")")
+            (str "(fun " params-str " -> " (ml-emit-do body all-set-vars) ")"))
+          ;; Has set! targets — emit ref bindings only for non-let-bound vars
+          (let ((ref-decls (if (empty? needs-ref) ""
+                             (str (join " " (map (fn (v) (str "let " v " = ref Nil in")) needs-ref)) " ")))
+                (body-str (if (= (len body) 1)
+                            (ml-expr-inner (first body) all-set-vars)
+                            (ml-emit-do body all-set-vars))))
+            (str "(fun " params-str " -> " ref-decls body-str ")")))))))
+
+(define ml-collect-params
+  (fn ((params :as list))
+    (ml-collect-params-loop params 0 (list))))
+
+(define ml-collect-params-loop
+  (fn ((params :as list) (i :as number) (result :as list))
+    (if (>= i (len params))
+      result
+      (let ((p (nth params i)))
+        (cond
+          ;; &key — skip (components handle this differently)
+          (and (= (type-of p) "symbol") (= (symbol-name p) "&key"))
+            (ml-collect-params-loop params (+ i 1) result)
+          ;; &rest
+          (and (= (type-of p) "symbol") (= (symbol-name p) "&rest"))
+            (ml-collect-params-loop params (+ i 2) result)
+          ;; Annotated: (name :as type)
+          (and (= (type-of p) "list") (= (len p) 3)
+               (= (type-of (nth p 1)) "keyword")
+               (= (keyword-name (nth p 1)) "as"))
+            (ml-collect-params-loop params (+ i 1)
+              (append result (ml-mangle (symbol-name (first p)))))
+          ;; Simple symbol
+          (= (type-of p) "symbol")
+            (ml-collect-params-loop params (+ i 1)
+              (append result (ml-mangle (symbol-name p))))
+          :else
+            (ml-collect-params-loop params (+ i 1)
+              (append result (str p))))))))
+
+
+;; --------------------------------------------------------------------------
+;; let → OCaml let ... in ...
+;; --------------------------------------------------------------------------
+
+(define ml-emit-let
+  (fn (expr (set-vars :as list))
+    (let ((bindings (nth expr 1))
+          (body (rest (rest expr))))
+      (let ((parsed (ml-parse-bindings-full bindings set-vars)))
+        ;; Track dynamic vars: let-bound vars whose init is NOT a fn/lambda
+        (let ((dyn-additions (reduce (fn (acc b)
+                (let ((vname (first b))
+                      (is-fn (nth b 2)))
+                  (if is-fn acc (append acc (str "dyn:" vname)))))
+              (list) parsed)))
+          (let ((body-set-vars (append set-vars dyn-additions)))
+            (let ((binding-strs (map (fn (b)
+                    (let ((vname (first b))
+                          (vval (nth b 1)))
+                      (if (some (fn (sv) (= sv vname)) set-vars)
+                        (str "let " vname " = ref (" vval ") in")
+                        (str "let " vname " = " vval " in"))))
+                  parsed))
+                  (body-str (if (= (len body) 1)
+                              (ml-expr-inner (first body) body-set-vars)
+                              (ml-emit-do body body-set-vars))))
+              (str "(" (join " " binding-strs) " " body-str ")"))))))))
+
+;; ml-parse-bindings-full returns (name ocaml-expr is-fn?) triples
+(define ml-is-fn-expr?
+  (fn (expr)
+    (and (list? expr) (not (empty? expr))
+         (= (type-of (first expr)) "symbol")
+         (or (= (symbol-name (first expr)) "fn")
+             (= (symbol-name (first expr)) "lambda")))))
+
+(define ml-parse-bindings-full
+  (fn (bindings (set-vars :as list))
+    (if (and (list? bindings) (not (empty? bindings)))
+      (if (list? (first bindings))
+        ;; Scheme-style: ((name val) ...)
+        (map (fn (b)
+          (let ((vname (if (= (type-of (first b)) "symbol")
+                         (symbol-name (first b))
+                         (str (first b)))))
+            (list (ml-mangle vname) (ml-expr-inner (nth b 1) set-vars) (ml-is-fn-expr? (nth b 1)))))
+          bindings)
+        ;; Clojure-style: (name val name val ...)
+        (ml-parse-clojure-bindings-full bindings 0 (list) set-vars))
+      (list))))
+
+(define ml-parse-clojure-bindings-full
+  (fn (bindings (i :as number) (result :as list) (set-vars :as list))
+    (if (>= i (- (len bindings) 1))
+      result
+      (let ((vname (if (= (type-of (nth bindings i)) "symbol")
+                     (symbol-name (nth bindings i))
+                     (str (nth bindings i))))
+            (val-expr (nth bindings (+ i 1))))
+        (ml-parse-clojure-bindings-full bindings (+ i 2)
+          (append result (list (ml-mangle vname) (ml-expr-inner val-expr set-vars) (ml-is-fn-expr? val-expr)))
+          set-vars)))))
+
+(define ml-parse-bindings
+  (fn (bindings (set-vars :as list))
+    (if (and (list? bindings) (not (empty? bindings)))
+      (if (list? (first bindings))
+        ;; Scheme-style: ((name val) ...)
+        (map (fn (b)
+          (let ((vname (if (= (type-of (first b)) "symbol")
+                         (symbol-name (first b))
+                         (str (first b)))))
+            (list (ml-mangle vname) (ml-expr-inner (nth b 1) set-vars))))
+          bindings)
+        ;; Clojure-style: (name val name val ...)
+        (ml-parse-clojure-bindings bindings 0 (list) set-vars))
+      (list))))
+
+(define ml-parse-clojure-bindings
+  (fn (bindings (i :as number) (result :as list) (set-vars :as list))
+    (if (>= i (- (len bindings) 1))
+      result
+      (let ((vname (if (= (type-of (nth bindings i)) "symbol")
+                     (symbol-name (nth bindings i))
+                     (str (nth bindings i)))))
+        (ml-parse-clojure-bindings bindings (+ i 2)
+          (append result (list (ml-mangle vname) (ml-expr-inner (nth bindings (+ i 1)) set-vars)))
+          set-vars)))))
+
+
+;; --------------------------------------------------------------------------
+;; when
+;; --------------------------------------------------------------------------
+
+(define ml-emit-when
+  (fn (expr (set-vars :as list))
+    (let ((cond-e (ml-expr-inner (nth expr 1) set-vars))
+          (body-parts (rest (rest expr))))
+      (if (= (len body-parts) 1)
+        (str "(if sx_truthy (" cond-e ") then " (ml-expr-inner (first body-parts) set-vars) " else Nil)")
+        (str "(if sx_truthy (" cond-e ") then " (ml-emit-do body-parts set-vars) " else Nil)")))))
+
+
+;; --------------------------------------------------------------------------
+;; cond → chained if/then/else
+;; --------------------------------------------------------------------------
+
+(define ml-emit-cond
+  (fn ((clauses :as list) (set-vars :as list))
+    (if (empty? clauses)
+      "Nil"
+      (let ((is-scheme (and
+              (every? (fn (c) (and (list? c) (= (len c) 2))) clauses)
+              (not (some (fn (c) (= (type-of c) "keyword")) clauses)))))
+        (if is-scheme
+          (ml-cond-scheme clauses set-vars)
+          (ml-cond-clojure clauses set-vars))))))
+
+(define ml-is-else?
+  (fn (test)
+    (or (and (= (type-of test) "symbol")
+             (or (= (symbol-name test) "else") (= (symbol-name test) ":else")))
+        (and (= (type-of test) "keyword") (= (keyword-name test) "else")))))
+
+(define ml-cond-scheme
+  (fn ((clauses :as list) (set-vars :as list))
+    (if (empty? clauses)
+      "Nil"
+      (let ((clause (first clauses))
+            (test (first clause))
+            (body (nth clause 1)))
+        (if (ml-is-else? test)
+          (ml-expr-inner body set-vars)
+          (str "(if sx_truthy (" (ml-expr-inner test set-vars) ") then "
+               (ml-expr-inner body set-vars)
+               " else " (ml-cond-scheme (rest clauses) set-vars) ")"))))))
+
+(define ml-cond-clojure
+  (fn ((clauses :as list) (set-vars :as list))
+    (if (< (len clauses) 2)
+      "Nil"
+      (let ((test (first clauses))
+            (body (nth clauses 1)))
+        (if (ml-is-else? test)
+          (ml-expr-inner body set-vars)
+          (str "(if sx_truthy (" (ml-expr-inner test set-vars) ") then "
+               (ml-expr-inner body set-vars)
+               " else " (ml-cond-clojure (rest (rest clauses)) set-vars) ")"))))))
+
+
+;; --------------------------------------------------------------------------
+;; case → match ... with
+;; --------------------------------------------------------------------------
+
+(define ml-emit-case
+  (fn ((args :as list) (set-vars :as list))
+    (let ((match-expr (ml-expr-inner (first args) set-vars))
+          (clauses (rest args)))
+      (str "(let _match_val = " match-expr " in "
+           (ml-case-chain clauses set-vars) ")"))))
+
+(define ml-case-chain
+  (fn ((clauses :as list) (set-vars :as list))
+    (if (< (len clauses) 2)
+      "Nil"
+      (let ((test (first clauses))
+            (body (nth clauses 1)))
+        (if (ml-is-else? test)
+          (ml-expr-inner body set-vars)
+          (str "(if _match_val = " (ml-expr-inner test set-vars)
+               " then " (ml-expr-inner body set-vars)
+               " else " (ml-case-chain (rest (rest clauses)) set-vars) ")"))))))
+
+
+;; --------------------------------------------------------------------------
+;; and/or → short-circuit
+;; --------------------------------------------------------------------------
+
+(define ml-emit-and
+  (fn ((args :as list) (set-vars :as list))
+    (if (= (len args) 1)
+      (ml-expr-inner (first args) set-vars)
+      (let ((parts (map (fn (x) (ml-expr-inner x set-vars)) args)))
+        (ml-and-chain parts)))))
+
+(define ml-and-chain
+  (fn ((parts :as list))
+    (if (= (len parts) 1)
+      (first parts)
+      (str "(let _and = " (first parts) " in if not (sx_truthy _and) then _and else " (ml-and-chain (rest parts)) ")"))))
+
+(define ml-emit-or
+  (fn ((args :as list) (set-vars :as list))
+    (if (= (len args) 1)
+      (ml-expr-inner (first args) set-vars)
+      (let ((parts (map (fn (x) (ml-expr-inner x set-vars)) args)))
+        (ml-or-chain parts)))))
+
+(define ml-or-chain
+  (fn ((parts :as list))
+    (if (= (len parts) 1)
+      (first parts)
+      (str "(let _or = " (first parts) " in if sx_truthy _or then _or else " (ml-or-chain (rest parts)) ")"))))
+
+
+;; --------------------------------------------------------------------------
+;; do/begin → sequencing
+;; --------------------------------------------------------------------------
+
+(define ml-emit-do
+  (fn ((args :as list) (set-vars :as list))
+    (if (= (len args) 1)
+      (ml-expr-inner (first args) set-vars)
+      ;; Check for defines in the block — emit as let...in chain
+      (ml-emit-do-chain args 0 set-vars))))
+
+(define ml-is-define?
+  (fn (expr)
+    (and (list? expr) (not (empty? expr))
+         (= (type-of (first expr)) "symbol")
+         (= (symbol-name (first expr)) "define"))))
+
+(define ml-emit-do-chain
+  (fn ((args :as list) (i :as number) (set-vars :as list))
+    (if (>= i (len args))
+      "Nil"
+      (let ((expr (nth args i))
+            (is-last (= i (- (len args) 1))))
+        (if (ml-is-define? expr)
+          ;; define inside do — emit as let...in
+          (let ((name (if (= (type-of (nth expr 1)) "symbol")
+                        (symbol-name (nth expr 1))
+                        (str (nth expr 1))))
+                (val-expr (nth expr 2)))
+            (let ((ml-name (ml-mangle name))
+                  (is-fn (and (list? val-expr)
+                              (not (empty? val-expr))
+                              (= (type-of (first val-expr)) "symbol")
+                              (or (= (symbol-name (first val-expr)) "fn")
+                                  (= (symbol-name (first val-expr)) "lambda"))))
+                  (is-recursive (ml-is-self-recursive? name val-expr)))
+              (let ((rec-kw (if is-recursive "rec " ""))
+                    (val-str (ml-expr-inner val-expr set-vars))
+                    (rest-str (ml-emit-do-chain args (+ i 1) set-vars)))
+                (str "(let " rec-kw ml-name " = " val-str " in " rest-str ")"))))
+          ;; Non-define expression
+          (if is-last
+            (ml-expr-inner expr set-vars)
+            (str "(let () = ignore (" (ml-expr-inner expr set-vars) ") in "
+                 (ml-emit-do-chain args (+ i 1) set-vars) ")")))))))
+
+
+;; --------------------------------------------------------------------------
+;; Higher-order form helpers — detect inline lambdas for direct OCaml calls
+;; --------------------------------------------------------------------------
+
+(define ml-is-inline-fn?
+  (fn (expr)
+    (and (list? expr) (not (empty? expr))
+         (= (type-of (first expr)) "symbol")
+         (or (= (symbol-name (first expr)) "fn")
+             (= (symbol-name (first expr)) "lambda")))))
+
+(define ml-emit-ho-form
+  (fn ((ocaml-fn :as string) (wrap-pre :as string) (wrap-post :as string)
+       (result-wrap :as string) (args :as list) (set-vars :as list))
+    (let ((fn-arg (first args))
+          (coll-arg (nth args 1))
+          ;; Detect if the OCaml HOF needs bool (filter, exists, for_all)
+          (needs-bool (or (= ocaml-fn "List.filter")
+                         (= ocaml-fn "List.exists")
+                         (= ocaml-fn "List.for_all"))))
+      (if (ml-is-inline-fn? fn-arg)
+        ;; Inline lambda — call directly, no sx_call
+        (let ((params (nth fn-arg 1))
+              (body (rest (rest fn-arg)))
+              (param-strs (ml-collect-params params)))
+          (let ((param-str (if (empty? param-strs) "_" (first param-strs)))
+                (body-str (if (= (len body) 1)
+                            (ml-expr-inner (first body) set-vars)
+                            (ml-emit-do body set-vars))))
+            (let ((wrapped-body (if needs-bool
+                                  (str "sx_truthy (" body-str ")")
+                                  body-str)))
+              (str "(" result-wrap " (" ocaml-fn " (fun " param-str " -> " wrapped-body
+                   ") (sx_to_list " (ml-expr-inner coll-arg set-vars) ")))"))))
+        ;; Named function — direct call (all defines are OCaml fns)
+        (let ((fn-str (ml-expr-inner fn-arg set-vars)))
+          (if needs-bool
+            (str "(" result-wrap " (" ocaml-fn " (fun _x -> sx_truthy (" fn-str " _x))"
+                 " (sx_to_list " (ml-expr-inner coll-arg set-vars) ")))")
+            (str "(" result-wrap " (" ocaml-fn " (fun _x -> " fn-str " _x)"
+                 " (sx_to_list " (ml-expr-inner coll-arg set-vars) ")))")))))))
+
+(define ml-emit-ho-indexed
+  (fn ((args :as list) (set-vars :as list))
+    (let ((fn-arg (first args))
+          (coll-arg (nth args 1)))
+      (if (ml-is-inline-fn? fn-arg)
+        (let ((params (nth fn-arg 1))
+              (body (rest (rest fn-arg)))
+              (param-strs (ml-collect-params params)))
+          (let ((i-param (if (>= (len param-strs) 1) (first param-strs) "_i"))
+                (v-param (if (>= (len param-strs) 2) (nth param-strs 1) "_v"))
+                (body-str (if (= (len body) 1)
+                            (ml-expr-inner (first body) set-vars)
+                            (ml-emit-do body set-vars))))
+            (str "(List (List.mapi (fun " i-param " " v-param " -> let " i-param " = Number (float_of_int " i-param ") in " body-str
+                 ") (sx_to_list " (ml-expr-inner coll-arg set-vars) ")))")))
+        (str "(List (List.mapi (fun _i _x -> " (ml-expr-inner fn-arg set-vars)
+             " (Number (float_of_int _i)) _x) (sx_to_list " (ml-expr-inner coll-arg set-vars) ")))")))))
+
+(define ml-emit-reduce
+  (fn ((args :as list) (set-vars :as list))
+    (let ((fn-arg (first args))
+          (init-arg (nth args 1))
+          (coll-arg (nth args 2)))
+      (if (ml-is-inline-fn? fn-arg)
+        (let ((params (nth fn-arg 1))
+              (body (rest (rest fn-arg)))
+              (param-strs (ml-collect-params params)))
+          (let ((raw-acc (if (>= (len param-strs) 1) (first param-strs) "_acc"))
+                (x-param (if (>= (len param-strs) 2) (nth param-strs 1) "_x"))
+                (body-str (if (= (len body) 1)
+                            (ml-expr-inner (first body) set-vars)
+                            (ml-emit-do body set-vars)))
+                ;; Prefix acc with _ if unused in body to avoid OCaml warning
+                (acc-param (if (string-contains? body-str raw-acc) raw-acc
+                             (if (starts-with? raw-acc "_") raw-acc
+                               (str "_" raw-acc)))))
+            (str "(List.fold_left (fun " acc-param " " x-param " -> " body-str ") "
+                 (ml-expr-inner init-arg set-vars) " (sx_to_list " (ml-expr-inner coll-arg set-vars) "))")))
+        (str "(List.fold_left (fun _acc _x -> " (ml-expr-inner fn-arg set-vars)
+             " _acc _x) " (ml-expr-inner init-arg set-vars)
+             " (sx_to_list " (ml-expr-inner coll-arg set-vars) "))")))))
+
+
+;; --------------------------------------------------------------------------
+;; for-each
+;; --------------------------------------------------------------------------
+
+(define ml-emit-for-each
+  (fn ((args :as list) (set-vars :as list))
+    (let ((fn-arg (first args))
+          (coll-arg (nth args 1)))
+      (if (ml-is-inline-fn? fn-arg)
+        (let ((params (nth fn-arg 1))
+              (body (rest (rest fn-arg)))
+              (param-strs (ml-collect-params params)))
+          (let ((param-str (if (empty? param-strs) "_" (first param-strs)))
+                (body-str (if (= (len body) 1)
+                            (ml-expr-inner (first body) set-vars)
+                            (ml-emit-do body set-vars))))
+            (str "(List.iter (fun " param-str " -> ignore (" body-str
+                 ")) (sx_to_list " (ml-expr-inner coll-arg set-vars) "); Nil)")))
+        (str "(List.iter (fun _x -> ignore (" (ml-expr-inner fn-arg set-vars)
+             " _x)) (sx_to_list " (ml-expr-inner coll-arg set-vars) "); Nil)")))))
+
+
+;; --------------------------------------------------------------------------
+;; map-dict
+;; --------------------------------------------------------------------------
+
+(define ml-emit-map-dict
+  (fn ((args :as list) (set-vars :as list))
+    (let ((fn-arg (first args))
+          (dict-arg (nth args 1)))
+      (if (ml-is-inline-fn? fn-arg)
+        (let ((params (nth fn-arg 1))
+              (body (rest (rest fn-arg)))
+              (param-strs (ml-collect-params params)))
+          (let ((k-param (if (>= (len param-strs) 1) (first param-strs) "_k"))
+                (v-param (if (>= (len param-strs) 2) (nth param-strs 1) "_v"))
+                (body-str (if (= (len body) 1)
+                            (ml-expr-inner (first body) set-vars)
+                            (ml-emit-do body set-vars))))
+            (str "(match " (ml-expr-inner dict-arg set-vars) " with Dict _tbl -> "
+                 "let _r = Hashtbl.create (Hashtbl.length _tbl) in "
+                 "Hashtbl.iter (fun " k-param " " v-param " -> "
+                 "let " k-param " = String " k-param " in "
+                 "Hashtbl.replace _r (value_to_str " k-param ") (" body-str ")) _tbl; "
+                 "Dict _r | _ -> raise (Eval_error \"map-dict: expected dict\"))")))
+        (let ((fn-str (ml-expr-inner fn-arg set-vars)))
+          (str "(match " (ml-expr-inner dict-arg set-vars) " with Dict _tbl -> "
+               "let _r = Hashtbl.create (Hashtbl.length _tbl) in "
+               "Hashtbl.iter (fun _k _v -> "
+               "Hashtbl.replace _r _k (" fn-str " (String _k) _v)) _tbl; "
+               "Dict _r | _ -> raise (Eval_error \"map-dict: expected dict\"))"))))))
+
+
+;; --------------------------------------------------------------------------
+;; dict call
+;; --------------------------------------------------------------------------
+
+(define ml-emit-dict-call
+  (fn ((pairs :as list) (set-vars :as list))
+    (let ((n (len pairs)))
+      (if (= n 0)
+        "(Dict (Hashtbl.create 0))"
+        (str "(let _d = Hashtbl.create " (str (round (/ n 2)))
+             " in " (ml-dict-pairs pairs 0 set-vars) " Dict _d)")))))
+
+(define ml-dict-pairs
+  (fn ((pairs :as list) (i :as number) (set-vars :as list))
+    (if (>= i (- (len pairs) 1))
+      ""
+      (let ((key (nth pairs i))
+            (val (nth pairs (+ i 1))))
+        (let ((key-str (if (= (type-of key) "keyword")
+                         (ml-quote-string (keyword-name key))
+                         (str "(value_to_str " (ml-expr-inner key set-vars) ")")))
+              (val-str (ml-expr-inner val set-vars)))
+          (str "Hashtbl.replace _d " key-str " " val-str "; "
+               (ml-dict-pairs pairs (+ i 2) set-vars)))))))
+
+
+;; --------------------------------------------------------------------------
+;; quote → OCaml AST literals
+;; --------------------------------------------------------------------------
+
+(define ml-emit-quote
+  (fn (expr)
+    (cond
+      (= (type-of expr) "boolean")
+        (if expr "(Bool true)" "(Bool false)")
+      (number? expr) (str "(Number " (str expr) ")")
+      (string? expr) (str "(String " (ml-quote-string expr) ")")
+      (nil? expr)    "Nil"
+      (= (type-of expr) "symbol")
+        (str "(Symbol " (ml-quote-string (symbol-name expr)) ")")
+      (= (type-of expr) "keyword")
+        (str "(Keyword " (ml-quote-string (keyword-name expr)) ")")
+      (list? expr)
+        (str "(List [" (join "; " (map ml-emit-quote expr)) "])")
+      :else (str "(* quote fallback *) " (str expr)))))
+
+
+;; --------------------------------------------------------------------------
+;; Top-level define
+;; --------------------------------------------------------------------------
+
+(define ml-emit-define
+  (fn (expr)
+    (let ((name (if (= (type-of (nth expr 1)) "symbol")
+                  (symbol-name (nth expr 1))
+                  (str (nth expr 1))))
+          (val-expr (nth expr 2)))
+      (let ((ml-name (ml-mangle name))
+            (is-fn (and (list? val-expr)
+                        (not (empty? val-expr))
+                        (= (type-of (first val-expr)) "symbol")
+                        (or (= (symbol-name (first val-expr)) "fn")
+                            (= (symbol-name (first val-expr)) "lambda"))))
+            (is-recursive (ml-is-self-recursive? name val-expr)))
+        (let ((rec-kw (if is-recursive "rec " "")))
+          (if is-fn
+            ;; Function define — emit as let [rec] name params = body
+            (let ((params (nth val-expr 1))
+                  (body (rest (rest val-expr)))
+                  (param-strs (ml-collect-params params))
+                  (set-targets (ml-find-set-targets body))
+                  (let-bound (ml-find-let-bound-names body)))
+              (let ((params-str (if (empty? param-strs) "()" (join " " param-strs)))
+                    (all-set-vars set-targets)
+                    (needs-ref (filter (fn (v) (not (some (fn (lb) (= lb v)) let-bound))) set-targets)))
+                (if (empty? set-targets)
+                  (if (= (len body) 1)
+                    (str "let " rec-kw ml-name " " params-str " =\n  "
+                         (ml-expr-inner (first body) all-set-vars) "\n")
+                    (str "let " rec-kw ml-name " " params-str " =\n  "
+                         (ml-emit-do body all-set-vars) "\n"))
+                  ;; Has set! targets — only pre-declare refs for non-let-bound
+                  (let ((ref-decls (if (empty? needs-ref) ""
+                                     (str (join " " (map (fn (v) (str "let " v " = ref Nil in")) needs-ref)) " ")))
+                        (body-str (if (= (len body) 1)
+                                    (ml-expr-inner (first body) all-set-vars)
+                                    (ml-emit-do body all-set-vars))))
+                    (str "let " rec-kw ml-name " " params-str " =\n  "
+                         ref-decls body-str "\n")))))
+            ;; Non-function define
+            (str "let " ml-name " =\n  " (ml-expr val-expr) "\n")))))))
+
+
+;; --------------------------------------------------------------------------
+;; File translation: process a list of (name, define-expr) pairs
+;; --------------------------------------------------------------------------
+
+;; ml-translate-file emits all defines as a single let rec ... and ... block.
+;; This handles forward references between evaluator functions — OCaml's
+;; let rec allows mutual recursion between all and-joined definitions.
+(define ml-translate-file
+  (fn ((defines :as list))
+    (let ((parts (map (fn (pair)
+            (let ((name (first pair))
+                  (expr (nth pair 1)))
+              (str "(* " name " *)\n" (ml-emit-define-body expr))))
+            defines)))
+      ;; Join with "and" — first one uses "let rec", rest use "and"
+      ;; Each part is "(* name *)\nlet rec name ..." — replace the "let rec" on second line
+      (if (empty? parts)
+        ""
+        (str (first parts) "\n" (join "\n" (map (fn (p)
+          ;; Find first newline, then replace "let rec " after it
+          (let ((nl-idx (index-of p "\n")))
+            (if (and (number? nl-idx) (>= nl-idx 0))
+              (let ((before (slice p 0 (+ nl-idx 1)))
+                    (after (slice p (+ nl-idx 1))))
+                (if (starts-with? after "let rec ")
+                  (str before "and " (slice after 8))
+                  p))
+              ;; No newline — try direct replacement
+              (if (starts-with? p "let rec ")
+                (str "and " (slice p 8))
+                p))))
+          (rest parts))))))))
+
+;; ml-emit-define-body — like ml-emit-define but always emits as let [rec]
+(define ml-emit-define-body
+  (fn (expr)
+    (let ((name (if (= (type-of (nth expr 1)) "symbol")
+                  (symbol-name (nth expr 1))
+                  (str (nth expr 1))))
+          (val-expr (nth expr 2)))
+      (let ((ml-name (ml-mangle name))
+            (is-fn (and (list? val-expr)
+                        (not (empty? val-expr))
+                        (= (type-of (first val-expr)) "symbol")
+                        (or (= (symbol-name (first val-expr)) "fn")
+                            (= (symbol-name (first val-expr)) "lambda")))))
+        (if is-fn
+          ;; Function define
+          (let ((params (nth val-expr 1))
+                (body (rest (rest val-expr)))
+                (param-strs (ml-collect-params params))
+                (set-targets (ml-find-set-targets body))
+                (let-bound (ml-find-let-bound-names body)))
+            (let ((params-str (if (empty? param-strs) "()" (join " " param-strs)))
+                  (needs-ref (filter (fn (v) (not (some (fn (lb) (= lb v)) let-bound))) set-targets)))
+              (if (empty? set-targets)
+                (if (= (len body) 1)
+                  (str "let rec " ml-name " " params-str " =\n  "
+                       (ml-expr-inner (first body) set-targets) "\n")
+                  (str "let rec " ml-name " " params-str " =\n  "
+                       (ml-emit-do body set-targets) "\n"))
+                (let ((ref-decls (if (empty? needs-ref) ""
+                                   (str (join " " (map (fn (v) (str "let " v " = ref Nil in")) needs-ref)) " ")))
+                      (body-str (if (= (len body) 1)
+                                  (ml-expr-inner (first body) set-targets)
+                                  (ml-emit-do body set-targets))))
+                  (str "let rec " ml-name " " params-str " =\n  "
+                       ref-decls body-str "\n")))))
+          ;; Non-function define
+          (str "let rec " ml-name " =\n  " (ml-expr val-expr) "\n"))))))