(* sx_compiler.ml — Auto-generated from lib/compiler.sx *)
(* Do not edit — regenerate with: python3 hosts/ocaml/bootstrap_compiler.py *)

[@@@warning "-26-27"]

open Sx_types
open Sx_runtime

(* The compiler uses cek_call from the evaluator for runtime dispatch *)
let cek_call = Sx_ref.cek_call
let eval_expr = Sx_ref.eval_expr
let trampoline v = match v with
  | Thunk (expr, env) -> Sx_ref.eval_expr expr (Env env)
  | other -> other

(* Bindings for external functions the compiler calls.
   Some shadow OCaml stdlib names — the SX versions operate on values. *)
let serialize v = String (Sx_types.inspect v)
let sx_parse v = match v with
  | String s -> (match Sx_parser.parse_all s with [e] -> e | es -> List es)
  | v -> v
let floor v = prim_call "floor" [v]
let abs v = prim_call "abs" [v]
let min a b = prim_call "min" [a; b]
let max a b = prim_call "max" [a; b]
let set_nth_b lst idx v = prim_call "set-nth!" [lst; idx; v]
let init lst = prim_call "init" [lst]
let last lst = prim_call "last" [lst]

(* skip_annotations: strips :keyword value pairs from a list (type annotations) *)
let rec skip_annotations items =
  match items with
  | List [] | Nil -> Nil
  | List (Keyword _ :: _ :: rest) -> skip_annotations (List rest)
  | ListRef { contents = [] } -> Nil
  | ListRef { contents = Keyword _ :: _ :: rest } -> skip_annotations (List rest)
  | List (first :: _) -> first
  | ListRef { contents = first :: _ } -> first
  | _ -> Nil

(* compile_match: uses local recursion (letrec) that the transpiler can't handle.
   Falls back to CEK evaluation at runtime. *)
let compile_match em args scope tail_p =
  let fn = Sx_ref.eval_expr (Symbol "compile-match") (Env (Sx_types.make_env ())) in
  Sx_ref.cek_call fn (List [em; args; scope; tail_p])


(* === Transpiled from bytecode compiler === *)
(* make-pool *)
let rec make_pool () =
  (let _d = Hashtbl.create 2 in Hashtbl.replace _d "entries" (if sx_truthy ((is_primitive ((String "mutable-list")))) then (mutable_list ()) else (List [])); Hashtbl.replace _d "index" (let _d = Hashtbl.create 1 in Hashtbl.replace _d "_count" (Number 0.0); Dict _d); Dict _d)

(* pool-add *)
and pool_add pool value =
  (let () = ignore ((String "Add a value to the constant pool, return its index. Deduplicates.")) in (let key = (serialize (value)) in let idx_map = (get (pool) ((String "index"))) in (if sx_truthy ((prim_call "has-key?" [idx_map; key])) then (get (idx_map) (key)) else (let idx = (get (idx_map) ((String "_count"))) in (let () = ignore ((sx_dict_set_b idx_map key idx)) in (let () = ignore ((sx_dict_set_b idx_map (String "_count") (prim_call "+" [idx; (Number 1.0)]))) in (let () = ignore ((sx_append_b (get (pool) ((String "entries"))) value)) in idx)))))))

(* make-scope *)
and make_scope parent =
  (let _d = Hashtbl.create 5 in Hashtbl.replace _d "next-slot" (Number 0.0); Hashtbl.replace _d "upvalues" (List []); Hashtbl.replace _d "locals" (List []); Hashtbl.replace _d "parent" parent; Hashtbl.replace _d "is-function" (Bool false); Dict _d)

(* scope-define-local *)
and scope_define_local scope name =
  (let () = ignore ((String "Add a local variable, return its slot index.\n     Idempotent: if name already has a slot, return it.")) in (let existing = (first ((List (List.filter (fun l -> sx_truthy ((prim_call "=" [(get (l) ((String "name"))); name]))) (sx_to_list (get (scope) ((String "locals")))))))) in (if sx_truthy (existing) then (get (existing) ((String "slot"))) else (let slot = (get (scope) ((String "next-slot"))) in (let () = ignore ((sx_append_b (get (scope) ((String "locals"))) (let _d = Hashtbl.create 3 in Hashtbl.replace _d "mutable" (Bool false); Hashtbl.replace _d "slot" slot; Hashtbl.replace _d "name" name; Dict _d))) in (let () = ignore ((sx_dict_set_b scope (String "next-slot") (prim_call "+" [slot; (Number 1.0)]))) in slot))))))

(* scope-resolve *)
and scope_resolve scope name =
  (let () = ignore ((String "Resolve a variable name. Returns {:type \"local\"|\"upvalue\"|\"global\", :index N}.\n     Upvalue captures only happen at function boundaries (is-function=true).\n     Let scopes share the enclosing function's frame — their locals are\n     accessed directly without upvalue indirection.")) in (if sx_truthy ((is_nil (scope))) then (CekFrame { cf_type = "global"; cf_env = Nil; cf_name = Nil; cf_body = Nil; cf_remaining = Nil; cf_f = Nil; cf_args = Nil; cf_results = Nil; cf_extra = Nil; cf_extra2 = Nil }) else (let locals = (get (scope) ((String "locals"))) in let found = (Bool (List.exists (fun l -> sx_truthy ((prim_call "=" [(get (l) ((String "name"))); name]))) (sx_to_list locals))) in (if sx_truthy (found) then (let local = (first ((List (List.filter (fun l -> sx_truthy ((prim_call "=" [(get (l) ((String "name"))); name]))) (sx_to_list locals))))) in (CekFrame { cf_type = "local"; cf_env = Nil; cf_name = Nil; cf_body = Nil; cf_remaining = Nil; cf_f = Nil; cf_args = Nil; cf_results = Nil; cf_extra = Nil; cf_extra2 = Nil })) else (let upvals = (get (scope) ((String "upvalues"))) in let uv_found = (Bool (List.exists (fun u -> sx_truthy ((prim_call "=" [(get (u) ((String "name"))); name]))) (sx_to_list upvals))) in (if sx_truthy (uv_found) then (let uv = (first ((List (List.filter (fun u -> sx_truthy ((prim_call "=" [(get (u) ((String "name"))); name]))) (sx_to_list upvals))))) in (CekFrame { cf_type = "upvalue"; cf_env = Nil; cf_name = Nil; cf_body = Nil; cf_remaining = Nil; cf_f = Nil; cf_args = Nil; cf_results = Nil; cf_extra = Nil; cf_extra2 = Nil })) else (let parent = (get (scope) ((String "parent"))) in (if sx_truthy ((is_nil (parent))) then (CekFrame { cf_type = "global"; cf_env = Nil; cf_name = Nil; cf_body = Nil; cf_remaining = Nil; cf_f = Nil; cf_args = Nil; cf_results = Nil; cf_extra = Nil; cf_extra2 = Nil }) else (let parent_result = (scope_resolve (parent) (name)) in (if sx_truthy ((prim_call "=" [(get (parent_result) ((String "type"))); (String "global")])) then parent_result else (if sx_truthy ((get (scope) ((String "is-function")))) then (let uv_idx = (len ((get (scope) ((String "upvalues"))))) in (let () = ignore ((sx_append_b (get (scope) ((String "upvalues"))) (let _d = Hashtbl.create 4 in Hashtbl.replace _d "index" (get (parent_result) ((String "index"))); Hashtbl.replace _d "is-local" (prim_call "=" [(get (parent_result) ((String "type"))); (String "local")]); Hashtbl.replace _d "uv-index" uv_idx; Hashtbl.replace _d "name" name; Dict _d))) in (CekFrame { cf_type = "upvalue"; cf_env = Nil; cf_name = Nil; cf_body = Nil; cf_remaining = Nil; cf_f = Nil; cf_args = Nil; cf_results = Nil; cf_extra = Nil; cf_extra2 = Nil }))) else parent_result)))))))))))

(* make-emitter *)
and make_emitter () =
  (let _d = Hashtbl.create 2 in Hashtbl.replace _d "pool" (make_pool ()); Hashtbl.replace _d "bytecode" (if sx_truthy ((is_primitive ((String "mutable-list")))) then (mutable_list ()) else (List [])); Dict _d)

(* emit-byte *)
and emit_byte em byte =
  (sx_append_b (get (em) ((String "bytecode"))) byte)

(* emit-u16 *)
and emit_u16 em value =
  (let () = ignore ((emit_byte (em) ((prim_call "mod" [value; (Number 256.0)])))) in (emit_byte (em) ((prim_call "mod" [(floor ((prim_call "/" [value; (Number 256.0)]))); (Number 256.0)]))))

(* emit-i16 *)
and emit_i16 em value =
  (let v = (if sx_truthy ((prim_call "<" [value; (Number 0.0)])) then (prim_call "+" [value; (Number 65536.0)]) else value) in (emit_u16 (em) (v)))

(* emit-op *)
and emit_op em opcode =
  (emit_byte (em) (opcode))

(* emit-const *)
and emit_const em value =
  (let idx = (pool_add ((get (em) ((String "pool")))) (value)) in (let () = ignore ((emit_op (em) ((Number 1.0)))) in (emit_u16 (em) (idx))))

(* current-offset *)
and current_offset em =
  (len ((get (em) ((String "bytecode")))))

(* patch-i16 *)
and patch_i16 em offset value =
  (let () = ignore ((String "Patch a previously emitted i16 at the given bytecode offset.")) in (let v = (if sx_truthy ((prim_call "<" [value; (Number 0.0)])) then (prim_call "+" [value; (Number 65536.0)]) else value) in let bc = (get (em) ((String "bytecode"))) in (let () = ignore ((set_nth_b (bc) (offset) ((prim_call "mod" [v; (Number 256.0)])))) in (set_nth_b (bc) ((prim_call "+" [offset; (Number 1.0)])) ((prim_call "mod" [(floor ((prim_call "/" [v; (Number 256.0)]))); (Number 256.0)]))))))

(* compile-expr *)
and compile_expr em expr scope tail_p =
  (let () = ignore ((String "Compile an expression. tail? indicates tail position for TCO.")) in (if sx_truthy ((is_nil (expr))) then (emit_op (em) ((Number 2.0))) else (if sx_truthy ((prim_call "=" [(type_of (expr)); (String "number")])) then (emit_const (em) (expr)) else (if sx_truthy ((prim_call "=" [(type_of (expr)); (String "string")])) then (emit_const (em) (expr)) else (if sx_truthy ((prim_call "=" [(type_of (expr)); (String "boolean")])) then (emit_op (em) ((if sx_truthy (expr) then (Number 3.0) else (Number 4.0)))) else (if sx_truthy ((prim_call "=" [(type_of (expr)); (String "keyword")])) then (emit_const (em) ((keyword_name (expr)))) else (if sx_truthy ((prim_call "=" [(type_of (expr)); (String "symbol")])) then (compile_symbol (em) ((symbol_name (expr))) (scope)) else (if sx_truthy ((prim_call "=" [(type_of (expr)); (String "list")])) then (if sx_truthy ((empty_p (expr))) then (let () = ignore ((emit_op (em) ((Number 64.0)))) in (emit_u16 (em) ((Number 0.0)))) else (compile_list (em) (expr) (scope) (tail_p))) else (if sx_truthy ((prim_call "=" [(type_of (expr)); (String "dict")])) then (compile_dict (em) (expr) (scope)) else (emit_const (em) (expr)))))))))))

(* compile-symbol *)
and compile_symbol em name scope =
  (let resolved = (scope_resolve (scope) (name)) in (if sx_truthy ((prim_call "=" [(get (resolved) ((String "type"))); (String "local")])) then (let () = ignore ((emit_op (em) ((Number 16.0)))) in (emit_byte (em) ((get (resolved) ((String "index")))))) else (if sx_truthy ((prim_call "=" [(get (resolved) ((String "type"))); (String "upvalue")])) then (let () = ignore ((emit_op (em) ((Number 18.0)))) in (emit_byte (em) ((get (resolved) ((String "index")))))) else (let idx = (pool_add ((get (em) ((String "pool")))) (name)) in (let () = ignore ((emit_op (em) ((Number 20.0)))) in (emit_u16 (em) (idx)))))))

(* compile-dict *)
and compile_dict em expr scope =
  (let ks = (prim_call "keys" [expr]) in let count = (len (ks)) in (let () = ignore ((List.iter (fun k -> ignore ((let () = ignore ((emit_const (em) (k))) in (compile_expr (em) ((get (expr) (k))) (scope) ((Bool false)))))) (sx_to_list ks); Nil)) in (let () = ignore ((emit_op (em) ((Number 65.0)))) in (emit_u16 (em) (count)))))

(* compile-list *)
and compile_list em expr scope tail_p =
  (let head = (first (expr)) in let args = (rest (expr)) in (if sx_truthy ((Bool (not (sx_truthy ((prim_call "=" [(type_of (head)); (String "symbol")])))))) then (compile_call (em) (head) (args) (scope) (tail_p)) else (let name = (symbol_name (head)) in (if sx_truthy ((prim_call "=" [name; (String "if")])) then (compile_if (em) (args) (scope) (tail_p)) else (if sx_truthy ((prim_call "=" [name; (String "when")])) then (compile_when (em) (args) (scope) (tail_p)) else (if sx_truthy ((prim_call "=" [name; (String "and")])) then (compile_and (em) (args) (scope) (tail_p)) else (if sx_truthy ((prim_call "=" [name; (String "or")])) then (compile_or (em) (args) (scope) (tail_p)) else (if sx_truthy ((prim_call "=" [name; (String "let")])) then (compile_let (em) (args) (scope) (tail_p)) else (if sx_truthy ((prim_call "=" [name; (String "let*")])) then (compile_let (em) (args) (scope) (tail_p)) else (if sx_truthy ((prim_call "=" [name; (String "begin")])) then (compile_begin (em) (args) (scope) (tail_p)) else (if sx_truthy ((prim_call "=" [name; (String "do")])) then (compile_begin (em) (args) (scope) (tail_p)) else (if sx_truthy ((prim_call "=" [name; (String "lambda")])) then (compile_lambda (em) (args) (scope)) else (if sx_truthy ((prim_call "=" [name; (String "fn")])) then (compile_lambda (em) (args) (scope)) else (if sx_truthy ((prim_call "=" [name; (String "define")])) then (compile_define (em) (args) (scope)) else (if sx_truthy ((prim_call "=" [name; (String "set!")])) then (compile_set (em) (args) (scope)) else (if sx_truthy ((prim_call "=" [name; (String "quote")])) then (compile_quote (em) (args)) else (if sx_truthy ((prim_call "=" [name; (String "cond")])) then (compile_cond (em) (args) (scope) (tail_p)) else (if sx_truthy ((prim_call "=" [name; (String "case")])) then (compile_case (em) (args) (scope) (tail_p)) else (if sx_truthy ((prim_call "=" [name; (String "->")])) then (compile_thread (em) (args) (scope) (tail_p)) else (if sx_truthy ((prim_call "=" [name; (String "defcomp")])) then (compile_defcomp (em) (args) (scope)) else (if sx_truthy ((prim_call "=" [name; (String "defisland")])) then (compile_defcomp (em) (args) (scope)) else (if sx_truthy ((prim_call "=" [name; (String "defmacro")])) then (compile_defmacro (em) (args) (scope)) else (if sx_truthy ((prim_call "=" [name; (String "defstyle")])) then (emit_op (em) ((Number 2.0))) else (if sx_truthy ((prim_call "=" [name; (String "defhandler")])) then (emit_op (em) ((Number 2.0))) else (if sx_truthy ((prim_call "=" [name; (String "defpage")])) then (emit_op (em) ((Number 2.0))) else (if sx_truthy ((prim_call "=" [name; (String "defquery")])) then (emit_op (em) ((Number 2.0))) else (if sx_truthy ((prim_call "=" [name; (String "defaction")])) then (emit_op (em) ((Number 2.0))) else (if sx_truthy ((prim_call "=" [name; (String "defrelation")])) then (emit_op (em) ((Number 2.0))) else (if sx_truthy ((prim_call "=" [name; (String "deftype")])) then (emit_op (em) ((Number 2.0))) else (if sx_truthy ((prim_call "=" [name; (String "defeffect")])) then (emit_op (em) ((Number 2.0))) else (if sx_truthy ((prim_call "=" [name; (String "defisland")])) then (compile_defcomp (em) (args) (scope)) else (if sx_truthy ((prim_call "=" [name; (String "quasiquote")])) then (compile_quasiquote (em) ((first (args))) (scope)) else (if sx_truthy ((prim_call "=" [name; (String "letrec")])) then (compile_letrec (em) (args) (scope) (tail_p)) else (if sx_truthy ((prim_call "=" [name; (String "match")])) then (compile_match (em) (args) (scope) (tail_p)) else (compile_call (em) (head) (args) (scope) (tail_p))))))))))))))))))))))))))))))))))))

(* compile-if *)
and compile_if em args scope tail_p =
  (let test = (first (args)) in let then_expr = (nth (args) ((Number 1.0))) in let else_expr = (if sx_truthy ((prim_call ">" [(len (args)); (Number 2.0)])) then (nth (args) ((Number 2.0))) else Nil) in (let () = ignore ((compile_expr (em) (test) (scope) ((Bool false)))) in (let () = ignore ((emit_op (em) ((Number 33.0)))) in (let else_jump = (current_offset (em)) in (let () = ignore ((emit_i16 (em) ((Number 0.0)))) in (let () = ignore ((compile_expr (em) (then_expr) (scope) (tail_p))) in (let () = ignore ((emit_op (em) ((Number 32.0)))) in (let end_jump = (current_offset (em)) in (let () = ignore ((emit_i16 (em) ((Number 0.0)))) in (let () = ignore ((patch_i16 (em) (else_jump) ((prim_call "-" [(current_offset (em)); (prim_call "+" [else_jump; (Number 2.0)])])))) in (let () = ignore ((if sx_truthy ((is_nil (else_expr))) then (emit_op (em) ((Number 2.0))) else (compile_expr (em) (else_expr) (scope) (tail_p)))) in (patch_i16 (em) (end_jump) ((prim_call "-" [(current_offset (em)); (prim_call "+" [end_jump; (Number 2.0)])]))))))))))))))

(* compile-when *)
and compile_when em args scope tail_p =
  (let test = (first (args)) in let body = (rest (args)) in (let () = ignore ((compile_expr (em) (test) (scope) ((Bool false)))) in (let () = ignore ((emit_op (em) ((Number 33.0)))) in (let skip_jump = (current_offset (em)) in (let () = ignore ((emit_i16 (em) ((Number 0.0)))) in (let () = ignore ((compile_begin (em) (body) (scope) (tail_p))) in (let () = ignore ((emit_op (em) ((Number 32.0)))) in (let end_jump = (current_offset (em)) in (let () = ignore ((emit_i16 (em) ((Number 0.0)))) in (let () = ignore ((patch_i16 (em) (skip_jump) ((prim_call "-" [(current_offset (em)); (prim_call "+" [skip_jump; (Number 2.0)])])))) in (let () = ignore ((emit_op (em) ((Number 2.0)))) in (patch_i16 (em) (end_jump) ((prim_call "-" [(current_offset (em)); (prim_call "+" [end_jump; (Number 2.0)])]))))))))))))))

(* compile-and *)
and compile_and em args scope tail_p =
  (if sx_truthy ((empty_p (args))) then (emit_op (em) ((Number 3.0))) else (if sx_truthy ((prim_call "=" [(len (args)); (Number 1.0)])) then (compile_expr (em) ((first (args))) (scope) (tail_p)) else (let () = ignore ((compile_expr (em) ((first (args))) (scope) ((Bool false)))) in (let () = ignore ((emit_op (em) ((Number 6.0)))) in (let () = ignore ((emit_op (em) ((Number 33.0)))) in (let skip = (current_offset (em)) in (let () = ignore ((emit_i16 (em) ((Number 0.0)))) in (let () = ignore ((emit_op (em) ((Number 5.0)))) in (let () = ignore ((compile_and (em) ((rest (args))) (scope) (tail_p))) in (patch_i16 (em) (skip) ((prim_call "-" [(current_offset (em)); (prim_call "+" [skip; (Number 2.0)])]))))))))))))

(* compile-or *)
and compile_or em args scope tail_p =
  (if sx_truthy ((empty_p (args))) then (emit_op (em) ((Number 4.0))) else (if sx_truthy ((prim_call "=" [(len (args)); (Number 1.0)])) then (compile_expr (em) ((first (args))) (scope) (tail_p)) else (let () = ignore ((compile_expr (em) ((first (args))) (scope) ((Bool false)))) in (let () = ignore ((emit_op (em) ((Number 6.0)))) in (let () = ignore ((emit_op (em) ((Number 34.0)))) in (let skip = (current_offset (em)) in (let () = ignore ((emit_i16 (em) ((Number 0.0)))) in (let () = ignore ((emit_op (em) ((Number 5.0)))) in (let () = ignore ((compile_or (em) ((rest (args))) (scope) (tail_p))) in (patch_i16 (em) (skip) ((prim_call "-" [(current_offset (em)); (prim_call "+" [skip; (Number 2.0)])]))))))))))))

(* compile-begin *)
and compile_begin em exprs scope tail_p =
  (let () = ignore ((if sx_truthy ((let _and = (Bool (not (sx_truthy ((empty_p (exprs)))))) in if not (sx_truthy _and) then _and else (Bool (not (sx_truthy ((is_nil ((get (scope) ((String "parent"))))))))))) then (List.iter (fun expr -> ignore ((if sx_truthy ((let _and = (prim_call "=" [(type_of (expr)); (String "list")]) in if not (sx_truthy _and) then _and else (let _and = (prim_call ">=" [(len (expr)); (Number 2.0)]) in if not (sx_truthy _and) then _and else (let _and = (prim_call "=" [(type_of ((first (expr)))); (String "symbol")]) in if not (sx_truthy _and) then _and else (prim_call "=" [(symbol_name ((first (expr)))); (String "define")]))))) then (let name_expr = (nth (expr) ((Number 1.0))) in let name = (if sx_truthy ((prim_call "=" [(type_of (name_expr)); (String "symbol")])) then (symbol_name (name_expr)) else name_expr) in (scope_define_local (scope) (name))) else Nil))) (sx_to_list exprs); Nil) else Nil)) in (if sx_truthy ((empty_p (exprs))) then (emit_op (em) ((Number 2.0))) else (if sx_truthy ((prim_call "=" [(len (exprs)); (Number 1.0)])) then (compile_expr (em) ((first (exprs))) (scope) (tail_p)) else (let () = ignore ((compile_expr (em) ((first (exprs))) (scope) ((Bool false)))) in (let () = ignore ((emit_op (em) ((Number 5.0)))) in (compile_begin (em) ((rest (exprs))) (scope) (tail_p)))))))

(* compile-let *)
and compile_let em args scope tail_p =
  (if sx_truthy ((prim_call "=" [(type_of ((first (args)))); (String "symbol")])) then (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 = ref ((List [])) in let inits = ref ((List [])) in (let () = ignore ((List.iter (fun binding -> ignore ((let () = ignore ((params := sx_append_b !params (if sx_truthy ((prim_call "=" [(type_of ((first (binding)))); (String "symbol")])) then (first (binding)) else (make_symbol ((first (binding))))); Nil)) in (inits := sx_append_b !inits (nth (binding) ((Number 1.0))); Nil)))) (sx_to_list bindings); Nil)) in (let lambda_expr = (prim_call "concat" [(List [(make_symbol ((String "fn"))); !params]); body]) in let letrec_bindings = (List [(List [(make_symbol (loop_name)); lambda_expr])]) in let call_expr = (cons ((make_symbol (loop_name))) (!inits)) in (compile_letrec (em) ((List [letrec_bindings; call_expr])) (scope) (tail_p))))) else (let bindings = (first (args)) in let body = (rest (args)) in let let_scope = (make_scope (scope)) in (let () = ignore ((sx_dict_set_b let_scope (String "next-slot") (get (scope) ((String "next-slot"))))) in (let () = ignore ((List.iter (fun binding -> ignore ((let name = (if sx_truthy ((prim_call "=" [(type_of ((first (binding)))); (String "symbol")])) then (symbol_name ((first (binding)))) else (first (binding))) in let value = (nth (binding) ((Number 1.0))) in let slot = (scope_define_local (let_scope) (name)) in (let () = ignore ((compile_expr (em) (value) (let_scope) ((Bool false)))) in (let () = ignore ((emit_op (em) ((Number 17.0)))) in (emit_byte (em) (slot))))))) (sx_to_list bindings); Nil)) in (compile_begin (em) (body) (let_scope) (tail_p))))))

(* compile-letrec *)
and compile_letrec em args scope tail_p =
  (let () = ignore ((String "Compile letrec: all names visible during value compilation.\n     1. Define all local slots (initialized to nil).\n     2. Compile each value and assign — names are already in scope\n        so mutually recursive functions can reference each other.")) in (let bindings = (first (args)) in let body = (rest (args)) in let let_scope = (make_scope (scope)) in (let () = ignore ((sx_dict_set_b let_scope (String "next-slot") (get (scope) ((String "next-slot"))))) in (let () = ignore ((let slots = (List (List.map (fun binding -> (let name = (if sx_truthy ((prim_call "=" [(type_of ((first (binding)))); (String "symbol")])) then (symbol_name ((first (binding)))) else (first (binding))) in (let slot = (scope_define_local (let_scope) (name)) in (let () = ignore ((emit_op (em) ((Number 2.0)))) in (let () = ignore ((emit_op (em) ((Number 17.0)))) in (let () = ignore ((emit_byte (em) (slot))) in slot)))))) (sx_to_list bindings))) in (List.iter (fun pair -> ignore ((let binding = (first (pair)) in let slot = (nth (pair) ((Number 1.0))) in (let () = ignore ((compile_expr (em) ((nth (binding) ((Number 1.0)))) (let_scope) ((Bool false)))) in (let () = ignore ((emit_op (em) ((Number 17.0)))) in (emit_byte (em) (slot))))))) (sx_to_list (List (List.map (fun i -> (List [(nth (bindings) (i)); (nth (slots) (i))])) (sx_to_list (prim_call "range" [(Number 0.0); (len (bindings))]))))); Nil))) in (compile_begin (em) (body) (let_scope) (tail_p))))))

(* compile-lambda *)
and compile_lambda em args scope =
  (let params = (first (args)) in let body = (rest (args)) in let fn_scope = (make_scope (scope)) in let fn_em = (make_emitter ()) in (let () = ignore ((sx_dict_set_b fn_scope (String "is-function") (Bool true))) in (let () = ignore ((List.iter (fun p -> ignore ((let name = (if sx_truthy ((prim_call "=" [(type_of (p)); (String "symbol")])) then (symbol_name (p)) else (if sx_truthy ((let _and = (list_p (p)) in if not (sx_truthy _and) then _and else (let _and = (Bool (not (sx_truthy ((empty_p (p)))))) in if not (sx_truthy _and) then _and else (prim_call "=" [(type_of ((first (p)))); (String "symbol")])))) then (symbol_name ((first (p)))) else p)) in (if sx_truthy ((let _and = (Bool (not (sx_truthy ((prim_call "=" [name; (String "&key")]))))) in if not (sx_truthy _and) then _and else (Bool (not (sx_truthy ((prim_call "=" [name; (String "&rest")]))))))) then (scope_define_local (fn_scope) (name)) else Nil)))) (sx_to_list params); Nil)) in (let () = ignore ((compile_begin (fn_em) (body) (fn_scope) ((Bool true)))) in (let () = ignore ((emit_op (fn_em) ((Number 50.0)))) in (let upvals = (get (fn_scope) ((String "upvalues"))) in let code = (let _d = Hashtbl.create 4 in Hashtbl.replace _d "upvalue-count" (len (upvals)); Hashtbl.replace _d "arity" (len ((get (fn_scope) ((String "locals"))))); Hashtbl.replace _d "constants" (get ((get (fn_em) ((String "pool")))) ((String "entries"))); Hashtbl.replace _d "bytecode" (get (fn_em) ((String "bytecode"))); Dict _d) in let code_idx = (pool_add ((get (em) ((String "pool")))) (code)) in (let () = ignore ((emit_op (em) ((Number 51.0)))) in (let () = ignore ((emit_u16 (em) (code_idx))) in (List.iter (fun uv -> ignore ((let () = ignore ((emit_byte (em) ((if sx_truthy ((get (uv) ((String "is-local")))) then (Number 1.0) else (Number 0.0))))) in (emit_byte (em) ((get (uv) ((String "index")))))))) (sx_to_list upvals); Nil)))))))))

(* compile-define *)
and compile_define em args scope =
  (let name_expr = (first (args)) in let name = (if sx_truthy ((prim_call "=" [(type_of (name_expr)); (String "symbol")])) then (symbol_name (name_expr)) else name_expr) in let value = (let rest_args = (rest (args)) in (if sx_truthy ((let _and = (Bool (not (sx_truthy ((empty_p (rest_args)))))) in if not (sx_truthy _and) then _and else (prim_call "=" [(type_of ((first (rest_args)))); (String "keyword")]))) then (skip_annotations (rest_args)) else (first (rest_args)))) in (if sx_truthy ((Bool (not (sx_truthy ((is_nil ((get (scope) ((String "parent")))))))))) then (let slot = (scope_define_local (scope) (name)) in (let () = ignore ((compile_expr (em) (value) (scope) ((Bool false)))) in (let () = ignore ((emit_op (em) ((Number 17.0)))) in (emit_byte (em) (slot))))) else (let name_idx = (pool_add ((get (em) ((String "pool")))) (name)) in (let () = ignore ((compile_expr (em) (value) (scope) ((Bool false)))) in (let () = ignore ((emit_op (em) ((Number 128.0)))) in (emit_u16 (em) (name_idx)))))))

(* compile-set *)
and compile_set em args scope =
  (let name = (if sx_truthy ((prim_call "=" [(type_of ((first (args)))); (String "symbol")])) then (symbol_name ((first (args)))) else (first (args))) in let value = (nth (args) ((Number 1.0))) in let resolved = (scope_resolve (scope) (name)) in (let () = ignore ((compile_expr (em) (value) (scope) ((Bool false)))) in (if sx_truthy ((prim_call "=" [(get (resolved) ((String "type"))); (String "local")])) then (let () = ignore ((emit_op (em) ((Number 17.0)))) in (emit_byte (em) ((get (resolved) ((String "index")))))) else (if sx_truthy ((prim_call "=" [(get (resolved) ((String "type"))); (String "upvalue")])) then (let () = ignore ((emit_op (em) ((Number 19.0)))) in (emit_byte (em) ((get (resolved) ((String "index")))))) else (let idx = (pool_add ((get (em) ((String "pool")))) (name)) in (let () = ignore ((emit_op (em) ((Number 21.0)))) in (emit_u16 (em) (idx))))))))

(* compile-quote *)
and compile_quote em args =
  (if sx_truthy ((empty_p (args))) then (emit_op (em) ((Number 2.0))) else (emit_const (em) ((first (args)))))

(* compile-cond *)
and compile_cond em args scope tail_p =
  (let () = ignore ((String "Compile (cond test1 body1 test2 body2 ... :else fallback).")) in (if sx_truthy ((prim_call "<" [(len (args)); (Number 2.0)])) then (emit_op (em) ((Number 2.0))) else (let test = (first (args)) in let body = (nth (args) ((Number 1.0))) in let rest_clauses = (if sx_truthy ((prim_call ">" [(len (args)); (Number 2.0)])) then (prim_call "slice" [args; (Number 2.0)]) else (List [])) 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 (prim_call "=" [test; (Bool true)]))) then (compile_expr (em) (body) (scope) (tail_p)) else (let () = ignore ((compile_expr (em) (test) (scope) ((Bool false)))) in (let () = ignore ((emit_op (em) ((Number 33.0)))) in (let skip = (current_offset (em)) in (let () = ignore ((emit_i16 (em) ((Number 0.0)))) in (let () = ignore ((compile_expr (em) (body) (scope) (tail_p))) in (let () = ignore ((emit_op (em) ((Number 32.0)))) in (let end_jump = (current_offset (em)) in (let () = ignore ((emit_i16 (em) ((Number 0.0)))) in (let () = ignore ((patch_i16 (em) (skip) ((prim_call "-" [(current_offset (em)); (prim_call "+" [skip; (Number 2.0)])])))) in (let () = ignore ((compile_cond (em) (rest_clauses) (scope) (tail_p))) in (patch_i16 (em) (end_jump) ((prim_call "-" [(current_offset (em)); (prim_call "+" [end_jump; (Number 2.0)])])))))))))))))))))

(* compile-case *)
and compile_case em args scope tail_p =
  (let () = ignore ((String "Compile (case expr val1 body1 val2 body2 ... :else fallback).")) in (let () = ignore ((compile_expr (em) ((first (args))) (scope) ((Bool false)))) in (let clauses = (rest (args)) in (compile_case_clauses (em) (clauses) (scope) (tail_p)))))

(* compile-case-clauses *)
and compile_case_clauses em clauses scope tail_p =
  (if sx_truthy ((prim_call "<" [(len (clauses)); (Number 2.0)])) then (let () = ignore ((emit_op (em) ((Number 5.0)))) in (emit_op (em) ((Number 2.0)))) else (let test = (first (clauses)) in let body = (nth (clauses) ((Number 1.0))) in let rest_clauses = (if sx_truthy ((prim_call ">" [(len (clauses)); (Number 2.0)])) then (prim_call "slice" [clauses; (Number 2.0)]) else (List [])) 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 (prim_call "=" [test; (Bool true)]))) then (let () = ignore ((emit_op (em) ((Number 5.0)))) in (compile_expr (em) (body) (scope) (tail_p))) else (let () = ignore ((emit_op (em) ((Number 6.0)))) in (let () = ignore ((compile_expr (em) (test) (scope) ((Bool false)))) in (let () = ignore ((let name_idx = (pool_add ((get (em) ((String "pool")))) ((String "="))) in (let () = ignore ((emit_op (em) ((Number 52.0)))) in (let () = ignore ((emit_u16 (em) (name_idx))) in (emit_byte (em) ((Number 2.0))))))) in (let () = ignore ((emit_op (em) ((Number 33.0)))) in (let skip = (current_offset (em)) in (let () = ignore ((emit_i16 (em) ((Number 0.0)))) in (let () = ignore ((emit_op (em) ((Number 5.0)))) in (let () = ignore ((compile_expr (em) (body) (scope) (tail_p))) in (let () = ignore ((emit_op (em) ((Number 32.0)))) in (let end_jump = (current_offset (em)) in (let () = ignore ((emit_i16 (em) ((Number 0.0)))) in (let () = ignore ((patch_i16 (em) (skip) ((prim_call "-" [(current_offset (em)); (prim_call "+" [skip; (Number 2.0)])])))) in (let () = ignore ((compile_case_clauses (em) (rest_clauses) (scope) (tail_p))) in (patch_i16 (em) (end_jump) ((prim_call "-" [(current_offset (em)); (prim_call "+" [end_jump; (Number 2.0)])])))))))))))))))))))

(* compile-thread *)
and compile_thread em args scope tail_p =
  (let () = ignore ((String "Compile (-> val (f1 a) (f2 b)) by desugaring to nested calls.")) in (if sx_truthy ((empty_p (args))) then (emit_op (em) ((Number 2.0))) else (if sx_truthy ((prim_call "=" [(len (args)); (Number 1.0)])) then (compile_expr (em) ((first (args))) (scope) (tail_p)) else (let val_expr = (first (args)) in let forms = (rest (args)) in (compile_thread_step (em) (val_expr) (forms) (scope) (tail_p))))))

(* compile-thread-step *)
and compile_thread_step em val_expr forms scope tail_p =
  (if sx_truthy ((empty_p (forms))) then (compile_expr (em) (val_expr) (scope) (tail_p)) else (let form = (first (forms)) in let rest_forms = (rest (forms)) in let is_tail = (let _and = tail_p in if not (sx_truthy _and) then _and else (empty_p (rest_forms))) in (let call_expr = (if sx_truthy ((list_p (form))) then (prim_call "concat" [(List [(first (form)); val_expr]); (rest (form))]) else (List [form; val_expr])) in (if sx_truthy ((empty_p (rest_forms))) then (compile_expr (em) (call_expr) (scope) (is_tail)) else (let () = ignore ((compile_expr (em) (call_expr) (scope) ((Bool false)))) in (compile_thread_step (em) (call_expr) (rest_forms) (scope) (tail_p)))))))

(* compile-defcomp *)
and compile_defcomp em args scope =
  (let () = ignore ((String "Compile defcomp/defisland — delegates to runtime via GLOBAL_GET + CALL.")) in (let () = ignore ((let name_idx = (pool_add ((get (em) ((String "pool")))) ((String "eval-defcomp"))) in (let () = ignore ((emit_op (em) ((Number 20.0)))) in (emit_u16 (em) (name_idx))))) in (let () = ignore ((emit_const (em) ((prim_call "concat" [(List [(make_symbol ((String "defcomp")))]); args])))) in (let () = ignore ((emit_op (em) ((Number 48.0)))) in (emit_byte (em) ((Number 1.0)))))))

(* compile-defmacro *)
and compile_defmacro em args scope =
  (let () = ignore ((String "Compile defmacro — delegates to runtime via GLOBAL_GET + CALL.")) in (let () = ignore ((let name_idx = (pool_add ((get (em) ((String "pool")))) ((String "eval-defmacro"))) in (let () = ignore ((emit_op (em) ((Number 20.0)))) in (emit_u16 (em) (name_idx))))) in (let () = ignore ((emit_const (em) ((prim_call "concat" [(List [(make_symbol ((String "defmacro")))]); args])))) in (let () = ignore ((emit_op (em) ((Number 48.0)))) in (emit_byte (em) ((Number 1.0)))))))

(* compile-quasiquote *)
and compile_quasiquote em expr scope =
  (let () = ignore ((String "Compile quasiquote inline — walks the template at compile time,\n     emitting code that builds the structure at runtime. Unquoted\n     expressions are compiled normally (resolving locals/upvalues),\n     avoiding the qq-expand-runtime env-lookup limitation.")) in (compile_qq_expr (em) (expr) (scope)))

(* compile-qq-expr *)
and compile_qq_expr em expr scope =
  (let () = ignore ((String "Compile a quasiquote sub-expression.")) in (if sx_truthy ((Bool (not (sx_truthy ((prim_call "=" [(type_of (expr)); (String "list")])))))) then (emit_const (em) (expr)) else (if sx_truthy ((empty_p (expr))) then (let () = ignore ((emit_op (em) ((Number 64.0)))) in (emit_u16 (em) ((Number 0.0)))) else (let head = (first (expr)) 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 (compile_expr (em) ((nth (expr) ((Number 1.0)))) (scope) ((Bool false))) else (compile_qq_list (em) (expr) (scope)))))))

(* compile-qq-list *)
and compile_qq_list em items scope =
  (let () = ignore ((String "Compile a quasiquote list. Handles splice-unquote by building\n     segments and concatenating them.")) in (let has_splice = (Bool (List.exists (fun item -> 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")])))))) (sx_to_list items))) in (if sx_truthy ((Bool (not (sx_truthy (has_splice))))) then (let () = ignore ((List.iter (fun item -> ignore ((compile_qq_expr (em) (item) (scope)))) (sx_to_list items); Nil)) in (let () = ignore ((emit_op (em) ((Number 64.0)))) in (emit_u16 (em) ((len (items)))))) else (let segment_count = ref ((Number 0.0)) in let pending = ref ((Number 0.0)) in (let () = ignore ((List.iter (fun item -> ignore ((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 () = ignore ((if sx_truthy ((prim_call ">" [!pending; (Number 0.0)])) then (let () = ignore ((emit_op (em) ((Number 64.0)))) in (let () = ignore ((emit_u16 (em) (!pending))) in (let () = ignore ((segment_count := (prim_call "+" [!segment_count; (Number 1.0)]); Nil)) in (pending := (Number 0.0); Nil)))) else Nil)) in (let () = ignore ((compile_expr (em) ((nth (item) ((Number 1.0)))) (scope) ((Bool false)))) in (segment_count := (prim_call "+" [!segment_count; (Number 1.0)]); Nil))) else (let () = ignore ((compile_qq_expr (em) (item) (scope))) in (pending := (prim_call "+" [!pending; (Number 1.0)]); Nil))))) (sx_to_list items); Nil)) in (let () = ignore ((if sx_truthy ((prim_call ">" [!pending; (Number 0.0)])) then (let () = ignore ((emit_op (em) ((Number 64.0)))) in (let () = ignore ((emit_u16 (em) (!pending))) in (segment_count := (prim_call "+" [!segment_count; (Number 1.0)]); Nil))) else Nil)) in (if sx_truthy ((prim_call ">" [!segment_count; (Number 1.0)])) then (let concat_idx = (pool_add ((get (em) ((String "pool")))) ((String "concat"))) in (let () = ignore ((emit_op (em) ((Number 52.0)))) in (let () = ignore ((emit_u16 (em) (concat_idx))) in (emit_byte (em) (!segment_count))))) else Nil)))))))

(* compile-call *)
and compile_call em head args scope tail_p =
  (let is_prim = (let _and = (prim_call "=" [(type_of (head)); (String "symbol")]) in if not (sx_truthy _and) then _and else (let name = (symbol_name (head)) in (let _and = (Bool (not (sx_truthy ((prim_call "=" [(get ((scope_resolve (scope) (name))) ((String "type"))); (String "local")]))))) in if not (sx_truthy _and) then _and else (let _and = (Bool (not (sx_truthy ((prim_call "=" [(get ((scope_resolve (scope) (name))) ((String "type"))); (String "upvalue")]))))) in if not (sx_truthy _and) then _and else (is_primitive (name)))))) in (if sx_truthy (is_prim) then (let name = (symbol_name (head)) in let argc = (len (args)) in let name_idx = (pool_add ((get (em) ((String "pool")))) (name)) in (let () = ignore ((List.iter (fun a -> ignore ((compile_expr (em) (a) (scope) ((Bool false))))) (sx_to_list args); Nil)) in (let () = ignore ((emit_op (em) ((Number 52.0)))) in (let () = ignore ((emit_u16 (em) (name_idx))) in (emit_byte (em) (argc)))))) else (let () = ignore ((compile_expr (em) (head) (scope) ((Bool false)))) in (let () = ignore ((List.iter (fun a -> ignore ((compile_expr (em) (a) (scope) ((Bool false))))) (sx_to_list args); Nil)) in (if sx_truthy (tail_p) then (let () = ignore ((emit_op (em) ((Number 49.0)))) in (emit_byte (em) ((len (args))))) else (let () = ignore ((emit_op (em) ((Number 48.0)))) in (emit_byte (em) ((len (args))))))))))

(* compile *)
and compile expr =
  (let () = ignore ((String "Compile a single SX expression to a bytecode module.")) in (let em = (make_emitter ()) in let scope = (make_scope (Nil)) in (let () = ignore ((compile_expr (em) (expr) (scope) ((Bool false)))) in (let () = ignore ((emit_op (em) ((Number 50.0)))) in (let _d = Hashtbl.create 3 in let () = ignore (Hashtbl.replace _d "arity" (get (scope) (String "next-slot"))) in Hashtbl.replace _d "constants" (get ((get (em) ((String "pool")))) ((String "entries"))); Hashtbl.replace _d "bytecode" (get (em) ((String "bytecode"))); Dict _d)))))

(* compile-module *)
and compile_module exprs =
  (let () = ignore ((String "Compile a list of top-level expressions to a bytecode module.")) in (let em = (make_emitter ()) in let scope = (make_scope (Nil)) in (let () = ignore ((List.iter (fun expr -> ignore ((let () = ignore ((compile_expr (em) (expr) (scope) ((Bool false)))) in (emit_op (em) ((Number 5.0)))))) (sx_to_list (init (exprs))); Nil)) in (let () = ignore ((compile_expr (em) ((last (exprs))) (scope) ((Bool false)))) in (let () = ignore ((emit_op (em) ((Number 50.0)))) in (let _d = Hashtbl.create 3 in let () = ignore (Hashtbl.replace _d "arity" (get (scope) (String "next-slot"))) in Hashtbl.replace _d "constants" (get ((get (em) ((String "pool")))) ((String "entries"))); Hashtbl.replace _d "bytecode" (get (em) ((String "bytecode"))); Dict _d))))))