(** SX coroutine subprocess server.

    Persistent process that accepts commands on stdin and writes
    responses on stdout.  All messages are single-line SX expressions,
    newline-delimited.

    Protocol:
      Python → OCaml: (ping), (load path), (load-source src),
                       (eval src), (render src), (reset),
                       (io-response value)
      OCaml → Python: (ready), (ok), (ok value), (error msg),
                       (io-request name args...)

    IO primitives (query, action, request-arg, request-method, ctx)
    yield (io-request ...) and block on stdin for (io-response ...). *)

(* Modules accessed directly — library is unwrapped *)

open Sx_types

(* Force-link Sx_vm_extensions so its module-init runs: installs the
   extension dispatch fallthrough and registers the `extension-opcode-id`
   SX primitive. Without a reference here OCaml dead-code-eliminates the
   module from sx_server.exe (it's only otherwise reached from run_tests),
   leaving guest-language opcode extensions (Erlang Phase 9, etc.)
   invisible to the runtime. The applied call is a harmless lookup. *)
let () = ignore (Sx_vm_extensions.id_of_name "")

(* Register the Erlang opcode extension (Phase 9h) so
   `extension-opcode-id "erlang.OP_*"` resolves to the host ids the SX
   stub dispatcher consults. Guarded: a double-register raises Failure,
   which we swallow so a re-entered server process doesn't die. *)
let () = try Erlang_ext.register () with Failure _ -> ()

(* ====================================================================== *)
(* Font measurement via otfm — reads OpenType/TrueType font tables         *)
(* ====================================================================== *)

(* Font cache: font-family → (units_per_em, glyph_id_map, advance_width_map) *)
let _font_cache : (string, (int * (int, int) Hashtbl.t * (int, int) Hashtbl.t)) Hashtbl.t = Hashtbl.create 4

(* Map font-family names to file paths *)
let _font_base = ref "shared/static/fonts"

let font_path_for family =
  let base = !_font_base in
  let try_paths paths =
    List.find_opt Sys.file_exists paths in
  match String.lowercase_ascii family with
  | "serif" | "times" | "times new roman" ->
    try_paths [base ^ "/DejaVuSerif.ttf";
               "/usr/share/fonts/truetype/dejavu/DejaVuSerif.ttf"]
  | "sans-serif" | "sans" | "arial" | "helvetica" ->
    try_paths [base ^ "/DejaVuSans.ttf";
               "/usr/share/fonts/truetype/dejavu/DejaVuSans.ttf"]
  | "monospace" | "mono" | "courier" ->
    try_paths [base ^ "/DejaVuSansMono-Bold.ttf";
               "/usr/share/fonts/truetype/dejavu/DejaVuSansMono-Bold.ttf"]
  | path when Sys.file_exists path -> Some path
  | _ -> try_paths [base ^ "/DejaVuSerif.ttf";
                     "/usr/share/fonts/truetype/dejavu/DejaVuSerif.ttf"]

(* Load a font file and extract cmap + hmtx tables *)
let load_font family =
  match Hashtbl.find_opt _font_cache family with
  | Some cached -> Some cached
  | None ->
    match font_path_for family with
    | None -> None
    | Some path ->
      try
        let ic = open_in_bin path in
        let n = in_channel_length ic in
        let buf = Bytes.create n in
        really_input ic buf 0 n;
        close_in ic;
        let s = Bytes.to_string buf in
        let d = Otfm.decoder (`String s) in
        (* Get units_per_em from head table *)
        let upm = match Otfm.head d with
          | Error _ -> 2048
          | Ok h -> h.Otfm.head_units_per_em in
        (* Build char→glyph_id map from cmap.
           cmap folds: (acc -> map_kind -> (u0,u1) -> glyph_id -> acc) *)
        let cmap_tbl = Hashtbl.create 256 in
        let _ = Otfm.cmap d (fun acc kind (u0, u1) gid ->
          (match kind with
           | `Glyph ->
             (* Single mapping: u0 -> gid (u0 = u1) *)
             Hashtbl.replace cmap_tbl u0 gid
           | `Glyph_range ->
             (* Range: u0..u1 -> gid..(gid + u1 - u0) *)
             for i = 0 to u1 - u0 do
               Hashtbl.replace cmap_tbl (u0 + i) (gid + i)
             done);
          acc) () in
        (* Build glyph_id→advance_width map from hmtx.
           hmtx folds: (acc -> glyph_id -> adv_width -> lsb -> acc) *)
        let hmtx_tbl = Hashtbl.create 256 in
        let _ = Otfm.hmtx d (fun acc gid adv _lsb ->
          Hashtbl.replace hmtx_tbl gid adv; acc) () in
        let result = (upm, cmap_tbl, hmtx_tbl) in
        Printf.eprintf "[font] loaded %s: %d glyphs, %d metrics, upm=%d\n%!"
          (Filename.basename path) (Hashtbl.length cmap_tbl) (Hashtbl.length hmtx_tbl) upm;
        Hashtbl.replace _font_cache family result;
        Some result
      with e ->
        Printf.eprintf "[font] error loading %s: %s\n%!" path (Printexc.to_string e);
        None

(* Measure text width using font tables *)
let measure_text_otfm family size text =
  match load_font family with
  | None ->
    (* Fallback to monospace approximation *)
    let w = size *. 0.6 *. (float_of_int (String.length text)) in
    (w, size, size *. 0.8, size *. 0.2)
  | Some (upm, cmap_tbl, hmtx_tbl) ->
    let scale = size /. (float_of_int upm) in
    let width = ref 0.0 in
    (* Iterate over UTF-8 codepoints *)
    let i = ref 0 in
    let len = String.length text in
    while !i < len do
      let byte = Char.code text.[!i] in
      let cp, advance =
        if byte < 0x80 then (byte, 1)
        else if byte < 0xC0 then (byte, 1)  (* continuation — skip *)
        else if byte < 0xE0 then
          ((byte land 0x1F) lsl 6 lor (Char.code text.[min (!i+1) (len-1)] land 0x3F), 2)
        else if byte < 0xF0 then
          ((byte land 0x0F) lsl 12
           lor (Char.code text.[min (!i+1) (len-1)] land 0x3F) lsl 6
           lor (Char.code text.[min (!i+2) (len-1)] land 0x3F), 3)
        else
          ((byte land 0x07) lsl 18
           lor (Char.code text.[min (!i+1) (len-1)] land 0x3F) lsl 12
           lor (Char.code text.[min (!i+2) (len-1)] land 0x3F) lsl 6
           lor (Char.code text.[min (!i+3) (len-1)] land 0x3F), 4)
      in
      let gid = match Hashtbl.find_opt cmap_tbl cp with
        | Some g -> g | None -> 0 in
      let adv = match Hashtbl.find_opt hmtx_tbl gid with
        | Some a -> a | None -> upm / 2 in
      width := !width +. (float_of_int adv) *. scale;
      i := !i + advance
    done;
    let ascent = size *. 0.8 in  (* approximate — could read OS/2 table *)
    let descent = size *. 0.2 in
    (!width, size, ascent, descent)


(* ====================================================================== *)
(* Output helpers                                                          *)
(* ====================================================================== *)

(** Escape a string for embedding in an SX string literal. *)
let escape_sx_string s =
  let len = String.length s in
  let buf = Buffer.create (len + 16) in
  for i = 0 to len - 1 do
    match s.[i] with
    | '"'  -> Buffer.add_string buf "\\\""
    | '\\' -> Buffer.add_string buf "\\\\"
    | '\n' -> Buffer.add_string buf "\\n"
    | '\r' -> Buffer.add_string buf "\\r"
    | '\t' -> Buffer.add_string buf "\\t"
    | '<' when i + 7 < len && s.[i + 1] = '/' &&
               (s.[i + 2] = 's' || s.[i + 2] = 'S') &&
               String.lowercase_ascii (String.sub s (i + 2) 6) = "script" ->
      (* Escape </script as <\\/script to prevent HTML parser closing the tag *)
      Buffer.add_string buf "<\\\\/"
    | c    -> Buffer.add_char buf c
  done;
  Buffer.contents buf

(** Serialize a value to SX text (for io-request args). *)
let rec serialize_value = function
  | Nil -> "nil"
  | Bool true -> "true"
  | Bool false -> "false"
  | Number n -> Sx_types.format_number n
  | String s -> "\"" ^ escape_sx_string s ^ "\""
  | Symbol s -> s
  | Keyword k -> ":" ^ k
  | List items | ListRef { contents = items } ->
    (* All lists: (items...) — no (list ...) wrapper.
       Matches Python serialize() exactly. The SX source code itself uses
       (list ...) where data lists are needed; the serializer preserves AST. *)
    "(" ^ String.concat " " (List.map serialize_value items) ^ ")"
  | Dict d ->
    let pairs = Hashtbl.fold (fun k v acc ->
      (Printf.sprintf ":%s %s" k (serialize_value v)) :: acc) d [] in
    "{" ^ String.concat " " pairs ^ "}"
  | RawHTML s -> "\"" ^ escape_sx_string s ^ "\""
  | SxExpr s -> s
  | Spread pairs ->
    let items = List.map (fun (k, v) ->
      Printf.sprintf ":%s %s" k (serialize_value v)) pairs in
    "(make-spread {" ^ String.concat " " items ^ "})"
  | _ -> "nil"

(** Collect all ~-prefixed symbol references from an AST value.
    Walks the tree recursively, returns a deduplicated list of symbol names
    like ["~card"; "~layout/base"]. Used for dependency analysis. *)
let collect_tilde_refs body =
  let seen = Hashtbl.create 16 in
  let rec walk = function
    | Symbol s when String.length s > 0 && s.[0] = '~' ->
      if not (Hashtbl.mem seen s) then Hashtbl.replace seen s ()
    | List items | ListRef { contents = items } ->
      List.iter walk items
    | Dict d ->
      Hashtbl.iter (fun _k v -> walk v) d
    | Spread pairs ->
      List.iter (fun (_k, v) -> walk v) pairs
    | _ -> ()
  in
  walk body;
  Hashtbl.fold (fun k () acc -> k :: acc) seen []

(** Serialize a value to SX text, replacing ~-prefixed symbol references
    with their content hashes from the index. Symbols not in the index
    are emitted verbatim (unknown ref or non-component symbol). *)
let rec serialize_value_hashed (index : (string, string) Hashtbl.t) = function
  | Nil -> "nil"
  | Bool true -> "true"
  | Bool false -> "false"
  | Number n -> Sx_types.format_number n
  | String s -> "\"" ^ escape_sx_string s ^ "\""
  | Symbol s when String.length s > 0 && s.[0] = '~' ->
    (match Hashtbl.find_opt index s with
     | Some h -> "@h:" ^ h
     | None -> s)
  | Symbol s -> s
  | Keyword k -> ":" ^ k
  | List items | ListRef { contents = items } ->
    "(" ^ String.concat " " (List.map (serialize_value_hashed index) items) ^ ")"
  | Dict d ->
    let pairs = Hashtbl.fold (fun k v acc ->
      (Printf.sprintf ":%s %s" k (serialize_value_hashed index v)) :: acc) d [] in
    "{" ^ String.concat " " (List.sort String.compare pairs) ^ "}"
  | RawHTML s -> "\"" ^ escape_sx_string s ^ "\""
  | SxExpr s -> s
  | Spread pairs ->
    let items = List.map (fun (k, v) ->
      Printf.sprintf ":%s %s" k (serialize_value_hashed index v)) pairs in
    "(make-spread {" ^ String.concat " " items ^ "})"
  | _ -> "nil"

(** Request epoch — monotonically increasing, set by (epoch N) from Python.
    All responses are tagged with the current epoch so Python can discard
    stale messages from previous requests. Makes pipe desync impossible. *)
let current_epoch = ref 0

let send line =
  print_string line;
  print_char '\n';
  flush stdout

let send_ok () = send (Printf.sprintf "(ok %d)" !current_epoch)
let send_ok_value v = send (Printf.sprintf "(ok %d %s)" !current_epoch (serialize_value v))
let send_error msg = send (Printf.sprintf "(error %d \"%s\")" !current_epoch (escape_sx_string msg))

(** Length-prefixed binary send — handles any content without escaping.
    Sends: (ok-len EPOCH N)\n followed by exactly N bytes of raw data, then \n.
    Python reads the length line, then reads exactly N bytes. *)
let send_ok_blob s =
  let n = String.length s in
  Printf.printf "(ok-len %d %d)\n" !current_epoch n;
  print_string s;
  print_char '\n';
  flush stdout

(** Send a string value — use blob for anything that might contain
    newlines, quotes, or be large. *)
let send_ok_string s = send_ok_blob s

(** Send raw SX wire format — may contain newlines in string literals. *)
let send_ok_raw s = send_ok_blob s


(* ====================================================================== *)
(* IO bridge — primitives that yield to Python                             *)
(* ====================================================================== *)

(** Read a line from stdin (blocking). *)
let read_line_blocking () =
  try Some (input_line stdin)
  with End_of_file -> None

(** Read exactly N bytes from stdin (blocking). *)
let read_exact_bytes n =
  let buf = Bytes.create n in
  really_input stdin buf 0 n;
  Bytes.to_string buf

(** Read a length-prefixed blob from stdin.
    Expects the next line to be "(blob N)" where N is byte count,
    followed by exactly N bytes of raw data, then a newline. *)
let read_blob () =
  match read_line_blocking () with
  | None -> raise (Eval_error "read_blob: stdin closed")
  | Some line ->
    let line = String.trim line in
    match Sx_parser.parse_all line with
    | [List [Symbol "blob"; Number n]] ->
      let len = int_of_float n in
      let data = read_exact_bytes len in
      (* consume trailing newline *)
      (try ignore (input_line stdin) with End_of_file -> ());
      data
    | [List [Symbol "blob"; Integer n]] ->
      let data = read_exact_bytes n in
      (try ignore (input_line stdin) with End_of_file -> ());
      data
    | _ -> raise (Eval_error ("read_blob: expected (blob N), got: " ^ line))

(** Batch IO mode — collect requests during aser-slot, resolve after. *)
let io_batch_mode = ref false
let io_queue : (int * string * value list) list ref = ref []
let io_counter = ref 0

(* Scope stacks and cookies — primitives registered in sx_primitives.ml.
   We reference the shared state for the IO bridge. *)
let _request_cookies = Sx_primitives._request_cookies
let _scope_stacks = Sx_primitives._scope_stacks

(* ── App config ─────────────────────────────────────────────────────── *)
(* Populated from __app-config dict after SX files load.                *)
let _app_config : (string, value) Hashtbl.t option ref = ref None
let _defpage_paths : string list ref = ref []
(* Streaming pages: path → page name, for pages with :stream true *)
let _streaming_pages : (string, string) Hashtbl.t = Hashtbl.create 8
(* Mutex to serialize streaming renders — OCaml threads share the runtime
   lock, and concurrent CEK evaluations corrupt shared state. *)
let _stream_mutex = Mutex.create ()

let get_app_config key default =
  match !_app_config with
  | Some d -> (match Hashtbl.find_opt d key with Some v -> v | None -> default)
  | None -> default

let get_app_str key default =
  match get_app_config key (String default) with String s -> s | _ -> default

let get_app_list key default =
  match get_app_config key Nil with
  | List l | ListRef { contents = l } ->
    List.filter_map (function String s -> Some s | _ -> None) l
  | _ -> default

(** Helpers safe to defer — pure functions whose results are only used
    as rendering output (inlined into SX wire format), not in control flow. *)
let batchable_helpers = ref [
  "highlight"; "component-source"
]

let is_batchable name args =
  name = "helper" &&
  match args with
  | String h :: _ -> List.mem h !batchable_helpers
  | _ -> false

(** Read an io-response from stdin, discarding stale messages from old epochs. *)
let rec read_io_response () =
  match read_line_blocking () with
  | None -> raise (Eval_error "IO bridge: stdin closed while waiting for io-response")
  | Some line ->
    let exprs = Sx_parser.parse_all line in
    match exprs with
    (* Epoch-tagged: (io-response EPOCH value) *)
    | [List [Symbol "io-response"; Number n; value]]
      when int_of_float n = !current_epoch -> value
    | [List (Symbol "io-response" :: Number n :: values)]
      when int_of_float n = !current_epoch ->
      (match values with [v] -> v | _ -> List values)
    | [List [Symbol "io-response"; Integer n; value]]
      when n = !current_epoch -> value
    | [List (Symbol "io-response" :: Integer n :: values)]
      when n = !current_epoch ->
      (match values with [v] -> v | _ -> List values)
    (* Legacy untagged: (io-response value) — accept for backwards compat *)
    | [List [Symbol "io-response"; value]] -> value
    | [List (Symbol "io-response" :: values)] ->
      (match values with [v] -> v | _ -> List values)
    (* Stale epoch or unexpected — discard and retry *)
    | _ ->
      Printf.eprintf "[io] discarding stale message (%d chars, epoch=%d)\n%!"
        (String.length line) !current_epoch;
      read_io_response ()

(** Send an io-request — batch mode returns placeholder, else blocks. *)
let io_request name args =
  if !io_batch_mode && is_batchable name args then begin
    incr io_counter;
    let id = !io_counter in
    io_queue := (id, name, args) :: !io_queue;
    (* Return SxExpr so serialize/inspect passes it through unquoted *)
    SxExpr (Printf.sprintf "(\xc2\xabIO:%d\xc2\xbb)" id)
  end else begin
    let args_str = String.concat " " (List.map serialize_value args) in
    send (Printf.sprintf "(io-request %d \"%s\" %s)" !current_epoch name args_str);
    read_io_response ()
  end

(** Read a batched io-response, discarding stale epoch messages. *)
let read_batched_io_response () =
  let rec loop () =
    match read_line_blocking () with
    | None -> raise (Eval_error "IO batch: stdin closed")
    | Some line ->
      let exprs = Sx_parser.parse_all line in
      match exprs with
      (* Epoch-tagged: (io-response EPOCH value) *)
      | [List [Symbol "io-response"; Number n; String s]]
        when int_of_float n = !current_epoch -> s
      | [List [Symbol "io-response"; Number n; SxExpr s]]
        when int_of_float n = !current_epoch -> s
      | [List [Symbol "io-response"; Number n; v]]
        when int_of_float n = !current_epoch -> serialize_value v
      | [List [Symbol "io-response"; Integer n; String s]]
        when n = !current_epoch -> s
      | [List [Symbol "io-response"; Integer n; SxExpr s]]
        when n = !current_epoch -> s
      | [List [Symbol "io-response"; Integer n; v]]
        when n = !current_epoch -> serialize_value v
      (* Legacy untagged *)
      | [List [Symbol "io-response"; String s]]
      | [List [Symbol "io-response"; SxExpr s]] -> s
      | [List [Symbol "io-response"; v]] -> serialize_value v
      (* Stale — discard and retry *)
      | _ ->
        Printf.eprintf "[io-batch] discarding stale message (%d chars)\n%!"
          (String.length line);
        loop ()
  in
  loop ()

(** Flush batched IO: send all requests, read all responses, replace placeholders. *)
let flush_batched_io result_str =
  let queue = List.rev !io_queue in
  io_queue := [];
  io_counter := 0;
  if queue = [] then result_str
  else begin
    (* Send all batched requests with IDs, tagged with epoch *)
    List.iter (fun (id, name, args) ->
      let args_str = String.concat " " (List.map serialize_value args) in
      send (Printf.sprintf "(io-request %d %d \"%s\" %s)" !current_epoch id name args_str)
    ) queue;
    send (Printf.sprintf "(io-done %d %d)" !current_epoch (List.length queue));
    (* Read all responses and replace placeholders *)
    let final = ref result_str in
    List.iter (fun (id, _, _) ->
      let value_str = read_batched_io_response () in
      let placeholder = Printf.sprintf "(\xc2\xabIO:%d\xc2\xbb)" id in
      (* Replace all occurrences of this placeholder *)
      let plen = String.length placeholder in
      let buf = Buffer.create (String.length !final) in
      let pos = ref 0 in
      let s = !final in
      let slen = String.length s in
      while !pos <= slen - plen do
        if String.sub s !pos plen = placeholder then begin
          Buffer.add_string buf value_str;
          pos := !pos + plen
        end else begin
          Buffer.add_char buf s.[!pos];
          incr pos
        end
      done;
      if !pos < slen then
        Buffer.add_substring buf s !pos (slen - !pos);
      final := Buffer.contents buf
    ) queue;
    !final
  end

(** Resolve a library spec to a file path.
    (sx render) → spec/render.sx, (sx bytecode) → lib/bytecode.sx, etc.
    Returns Some path or None if unknown. *)
let _lib_base = ref "lib"
let _spec_base = ref "spec"
let _web_base = ref "web"

let resolve_library_path lib_spec =
  let parts = match lib_spec with List l | ListRef { contents = l } -> l | _ -> [] in
  match List.map (fun v -> match v with Symbol s -> s | String s -> s | _ -> "") parts with
  | ["sx"; name] ->
    (* Check spec/ first, then lib/, then web/lib/ (dom.sx, browser.sx live there) *)
    let spec_path = Filename.concat !_spec_base (name ^ ".sx") in
    let lib_path = Filename.concat !_lib_base (name ^ ".sx") in
    let web_lib_path = Filename.concat (Filename.concat !_web_base "lib") (name ^ ".sx") in
    if Sys.file_exists spec_path then Some spec_path
    else if Sys.file_exists lib_path then Some lib_path
    else if Sys.file_exists web_lib_path then Some web_lib_path
    else None
  | ["web"; name] ->
    let path = Filename.concat !_web_base (name ^ ".sx") in
    let lib_path = Filename.concat (Filename.concat !_web_base "lib") (name ^ ".sx") in
    if Sys.file_exists path then Some path
    else if Sys.file_exists lib_path then Some lib_path
    else None
  | [prefix; name] ->
    (* Generic: try prefix/name.sx *)
    let path = Filename.concat prefix (name ^ ".sx") in
    if Sys.file_exists path then Some path else None
  | _ -> None

(** Load a library file — parse and evaluate all expressions in the global env.
    The file should contain a define-library form that registers itself. *)
let _import_env : env option ref = ref None

let rec load_library_file path =
  (* Use eval_expr_io for IO-aware loading (handles nested imports) *)
  let env = match !_import_env with Some e -> e | None -> Sx_types.make_env () in
  let exprs = Sx_parser.parse_file path in
  List.iter (fun expr ->
    try ignore (eval_expr_io expr (Env env))
    with Eval_error msg ->
      Printf.eprintf "[load-library] %s: %s\n%!" (Filename.basename path) msg
  ) exprs

(** IO-aware CEK run — handles suspension by dispatching IO requests.
    Import requests are handled locally (load .sx file).
    Other IO requests are sent to the Python bridge. *)
and cek_run_with_io state =
  let s = ref state in
  let is_terminal s = match Sx_ref.cek_terminal_p s with Bool true -> true | _ -> false in
  let is_suspended s = match Sx_runtime.get_val s (String "phase") with String "io-suspended" -> true | _ -> false in
  let rec loop () =
    while not (is_terminal !s) && not (is_suspended !s) do
      s := Sx_ref.cek_step !s
    done;
    if is_suspended !s then begin
      let request = Sx_runtime.get_val !s (String "request") in
      let op = match Sx_runtime.get_val request (String "op") with String s -> s | _ -> "" in
      let response = match op with
        | "import" ->
          (* Resolve library locally — load the .sx file *)
          let lib_spec = Sx_runtime.get_val request (String "library") in
          let key = Sx_ref.library_name_key lib_spec in
          if Sx_types.sx_truthy (Sx_ref.library_loaded_p key) then
            (* Already loaded — just resume *)
            Nil
          else begin
            (match resolve_library_path lib_spec with
             | Some path -> load_library_file path
             | None ->
               Printf.eprintf "[import] WARNING: no file for library %s\n%!"
                 (Sx_runtime.value_to_str lib_spec));
            Nil
          end
        | "text-measure" ->
          let args = let a = Sx_runtime.get_val request (String "args") in
            (match a with List l -> l | _ -> [a]) in
          let font = match args with String f :: _ -> f | _ -> "serif" in
          let size = match args with
            | [_font; Number sz; _text] -> sz
            | [_font; Number sz] -> sz
            | _ -> 16.0 in
          let text = match args with
            | [_font; _sz; String t] -> t
            | _ -> "" in
          let (w, h, asc, desc) = measure_text_otfm font size text in
          let d = Hashtbl.create 4 in
          Hashtbl.replace d "width" (Number w);
          Hashtbl.replace d "height" (Number h);
          Hashtbl.replace d "ascent" (Number asc);
          Hashtbl.replace d "descent" (Number desc);
          Dict d
        | _ ->
          let argsv = Sx_runtime.get_val request (String "args") in
          (match Sx_persist_store.handle_op op argsv with
           | Some resp -> resp
           | None ->
             let args = (match argsv with List l -> l | _ -> [argsv]) in
             io_request op args)
      in
      s := Sx_ref.cek_resume !s response;
      loop ()
    end else
      Sx_ref.cek_value !s
  in
  loop ()

(** IO-aware eval_expr — like eval_expr but handles IO suspension. *)
and eval_expr_io expr env =
  let state = Sx_ref.make_cek_state expr env (List []) in
  cek_run_with_io state

(** Bind IO primitives into the environment. *)
let setup_io_env env =
  let bind name fn =
    ignore (env_bind env name (NativeFn (name, fn)))
  in

  bind "query" (fun args ->
    match args with
    | service :: query_name :: rest ->
      io_request "query" (service :: query_name :: rest)
    | _ -> raise (Eval_error "query: expected (query service name ...)"));

  bind "action" (fun args ->
    match args with
    | service :: action_name :: rest ->
      io_request "action" (service :: action_name :: rest)
    | _ -> raise (Eval_error "action: expected (action service name ...)"));

  bind "request-arg" (fun args ->
    match args with
    | [name] -> io_request "request-arg" [name]
    | [name; default] ->
      let result = io_request "request-arg" [name] in
      if result = Nil then default else result
    | _ -> raise (Eval_error "request-arg: expected 1-2 args"));

  bind "request-method" (fun _args ->
    io_request "request-method" []);

  bind "ctx" (fun args ->
    match args with
    | [key] -> io_request "ctx" [key]
    | _ -> raise (Eval_error "ctx: expected 1 arg"));

  bind "call-lambda" (fun args ->
    (* Use cek_call instead of eval_expr to avoid re-evaluating
       already-evaluated args.  eval_expr copies Dict values (signals)
       during evaluation, so mutations in the lambda body would affect
       the copy, not the original. *)
    match args with
    | [fn_val; List call_args; Env _e] ->
      Sx_ref.cek_call fn_val (List call_args)
    | [fn_val; List call_args] ->
      Sx_ref.cek_call fn_val (List call_args)
    | _ -> raise (Eval_error "call-lambda: expected (fn args env?)"));

  (* Register HO forms as callable NativeFn — the CEK machine handles them
     as special forms, but the VM needs them as callable values in globals. *)
  let ho_via_cek name =
    bind name (fun args ->
      Sx_ref.eval_expr (List (Symbol name :: args)) (Env env))
  in
  List.iter ho_via_cek [
    "map"; "map-indexed"; "filter"; "reduce"; "some"; "every?"; "for-each";
  ];

  (* Generic helper call — dispatches to Python page helpers *)
  bind "helper" (fun args ->
    io_request "helper" args)


(* ====================================================================== *)
(* Environment setup                                                       *)
(* ====================================================================== *)

(* ---- Browser API stubs (no-op for SSR) ---- *)
let setup_browser_stubs env =
  let bind name fn = ignore (env_bind env name (NativeFn (name, fn))) in
  bind "local-storage-get" (fun _args -> Nil);
  bind "local-storage-set" (fun _args -> Nil);
  bind "dom-listen" (fun _args -> NativeFn ("noop", fun _ -> Nil));
  bind "dom-dispatch" (fun _args -> Nil);
  bind "dom-set-data" (fun _args -> Nil);
  bind "dom-get-data" (fun _args -> Nil);
  bind "event-detail" (fun _args -> Nil);
  bind "promise-then" (fun _args -> Nil);
  bind "promise-delayed" (fun args ->
    match args with _ :: [v] -> v | _ -> Nil);
  bind "schedule-idle" (fun _args -> Nil);
  bind "dom-query" (fun _args -> Nil);
  bind "dom-query-all" (fun _args -> List []);
  bind "dom-set-prop" (fun _args -> Nil);
  bind "dom-get-attr" (fun _args -> Nil);
  bind "dom-set-attr" (fun _args -> Nil);
  bind "dom-text-content" (fun _args -> String "");
  bind "dom-set-text-content" (fun _args -> Nil);
  bind "dom-body" (fun _args -> Nil);
  bind "dom-create-element" (fun _args -> Nil);
  bind "dom-append" (fun _args -> Nil);
  bind "create-text-node" (fun args -> match args with [String s] -> String s | [v] -> String (value_to_string v) | _ -> Nil);
  bind "render-to-dom" (fun _args -> Nil);
  bind "set-render-active!" (fun _args -> Nil);
  bind "render-active?" (fun _args -> Bool true);
  (* host-* platform primitives — browser-only, but boot-helpers.sx
     references them so they need server-side stubs *)
  bind "host-get" (fun args ->
    match args with
    | [Dict d; String key] -> (match Hashtbl.find_opt d key with Some v -> v | None -> Nil)
    | _ -> Nil);
  bind "host-set!" (fun _args -> Nil);
  bind "host-call" (fun _args -> Nil);
  bind "host-typeof" (fun _args -> String "nil");
  bind "host-callback" (fun args ->
    match args with [fn] -> fn | _ -> NativeFn ("noop", fun _ -> Nil));
  bind "host-await" (fun _args -> Nil);
  bind "host-new" (fun _args -> Nil);
  bind "host-global" (fun _args -> Nil);
  bind "host-object" (fun _args -> Dict (Hashtbl.create 0))

(* ---- Scope primitives: bind into env for VM visibility ---- *)
let setup_scope_env env =
  List.iter (fun name ->
    try ignore (env_bind env name (Sx_primitives.get_primitive name))
    with _ -> ()
  ) ["scope-push!"; "scope-pop!"; "scope-peek"; "context";
     "collect!"; "collected"; "clear-collected!";
     "scope-emit!"; "emit!"; "emitted"; "scope-emitted";
     "scope-collected"; "scope-clear-collected!";
     "provide-push!"; "provide-pop!";
     "get-cookie"; "set-cookie"];
  ignore (env_bind env "sx-context" (Sx_primitives.get_primitive "context"))

(* ---- CEK evaluator bridge ---- *)
let setup_evaluator_bridge env =
  let bind name fn = ignore (env_bind env name (NativeFn (name, fn))) in
  bind "eval-expr" (fun args ->
    match args with
    | [expr; e] -> Sx_ref.eval_expr expr (Env (Sx_runtime.unwrap_env e))
    | [expr] -> Sx_ref.eval_expr expr (Env env)
    | _ -> raise (Eval_error "eval-expr: expected (expr env?)"));
  (* eval-in-env: (env expr) → result.  Evaluates expr in the given env. *)
  Sx_primitives.register "eval-in-env" (fun args ->
    match args with
    | [e; expr] -> Sx_ref.eval_expr expr e
    | _ -> raise (Eval_error "eval-in-env: (env expr)"));

  (* fed-sx Milestone 1 Step 8 transport. NATIVE ONLY — sockets +
     threads; deliberately absent from the WASM kernel (registered
     here in bin/, never in lib/sx_primitives.ml). Minimal HTTP/1.1,
     Connection: close. handler : req-dict -> resp-dict where
     req = {:method :path :query :headers :body},
     resp = {:status :headers :body}. Never returns. *)
  Sx_primitives.register "http-listen" (fun args ->
    let strip_cr s =
      let n = String.length s in
      if n > 0 && s.[n - 1] = '\r' then String.sub s 0 (n - 1) else s
    in
    match args with
    | [port_v; handler] ->
      let port = match port_v with
        | Integer n -> n
        | Number f -> int_of_float f
        | _ -> raise (Eval_error "http-listen: (port handler)") in
      let sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
      Unix.setsockopt sock Unix.SO_REUSEADDR true;
      Unix.bind sock
        (Unix.ADDR_INET (Unix.inet_addr_loopback, port));
      Unix.listen sock 64;
      (* SX runtime is shared across threads — serialize handler calls. *)
      let mtx = Mutex.create () in
      let reason = function
        | 200 -> "OK" | 201 -> "Created" | 204 -> "No Content"
        | 301 -> "Moved Permanently" | 302 -> "Found"
        | 400 -> "Bad Request" | 401 -> "Unauthorized"
        | 403 -> "Forbidden" | 404 -> "Not Found"
        | 405 -> "Method Not Allowed" | 500 -> "Internal Server Error"
        | _ -> "OK" in
      let handle fd =
        (try
          let ic = Unix.in_channel_of_descr fd in
          let oc = Unix.out_channel_of_descr fd in
          let reqline = strip_cr (input_line ic) in
          (match String.split_on_char ' ' reqline with
           | meth :: target :: _ ->
             let path, query =
               match String.index_opt target '?' with
               | Some i ->
                 String.sub target 0 i,
                 String.sub target (i + 1)
                   (String.length target - i - 1)
               | None -> target, "" in
             let headers = Sx_types.make_dict () in
             let clen = ref 0 in
             let rec rdh () =
               let h = strip_cr (input_line ic) in
               if h = "" then ()
               else begin
                 (match String.index_opt h ':' with
                  | Some i ->
                    let name =
                      String.lowercase_ascii
                        (String.trim (String.sub h 0 i)) in
                    let value =
                      String.trim
                        (String.sub h (i + 1)
                           (String.length h - i - 1)) in
                    Hashtbl.replace headers name (String value);
                    if name = "content-length" then
                      (try clen := int_of_string value with _ -> ())
                  | None -> ());
                 rdh ()
               end in
             rdh ();
             let body =
               if !clen > 0 then begin
                 let b = Bytes.create !clen in
                 really_input ic b 0 !clen;
                 Bytes.unsafe_to_string b
               end else "" in
             let req = Sx_types.make_dict () in
             Hashtbl.replace req "method" (String meth);
             Hashtbl.replace req "path" (String path);
             Hashtbl.replace req "query" (String query);
             Hashtbl.replace req "headers" (Dict headers);
             Hashtbl.replace req "body" (String body);
             Mutex.lock mtx;
             let resp =
               (try Sx_runtime.sx_call handler [Dict req]
                with e -> Mutex.unlock mtx; raise e) in
             Mutex.unlock mtx;
             let getk k = match resp with
               | Dict h -> Hashtbl.find_opt h k | _ -> None in
             let status = match getk "status" with
               | Some (Integer n) -> n
               | Some (Number f) -> int_of_float f
               | _ -> 200 in
             let rbody = match getk "body" with
               | Some (String s) -> s
               | Some v -> Sx_types.value_to_string v
               | None -> "" in
             let rhdrs = match getk "headers" with
               | Some (Dict h) ->
                 Hashtbl.fold (fun k v acc ->
                   (k, (match v with
                        | String s -> s
                        | v -> Sx_types.value_to_string v)) :: acc)
                   h []
               | _ -> [] in
             let buf = Buffer.create 256 in
             Buffer.add_string buf
               (Printf.sprintf "HTTP/1.1 %d %s\r\n" status
                  (reason status));
             List.iter (fun (k, v) ->
               Buffer.add_string buf
                 (Printf.sprintf "%s: %s\r\n" k v)) rhdrs;
             if not (List.exists
                       (fun (k, _) ->
                          String.lowercase_ascii k = "content-type")
                       rhdrs)
             then Buffer.add_string buf
                 "Content-Type: text/plain\r\n";
             Buffer.add_string buf
               (Printf.sprintf "Content-Length: %d\r\n"
                  (String.length rbody));
             Buffer.add_string buf "Connection: close\r\n\r\n";
             Buffer.add_string buf rbody;
             output_string oc (Buffer.contents buf);
             flush oc
           | _ -> ())
         with _ -> ());
        (try Unix.close fd with _ -> ())
      in
      while true do
        let fd, _ = Unix.accept sock in
        ignore (Thread.create handle fd)
      done;
      Nil
    | _ -> raise (Eval_error "http-listen: (port handler)"));

  (* fed-sx Milestone 1 client direction (Phase J). NATIVE ONLY —
     Unix sockets + DNS; absent from the WASM kernel. HTTP/1.1
     request: TCP connect, write request line + headers + body,
     read status + headers + body, return {:status :headers :body}.
     URL must be http://...; HTTPS is a later phase (needs TLS).
     Body read: Content-Length first, else read to EOF (we send
     Connection: close). Transfer-Encoding: chunked is rejected —
     fed-sx Phase 8 wires this for inter-server POSTs which will
     all carry Content-Length. *)
  Sx_primitives.register "http-request" (fun args ->
    let strip_cr s =
      let n = String.length s in
      if n > 0 && s.[n - 1] = '\r' then String.sub s 0 (n - 1) else s
    in
    match args with
    | [String meth; String url; headers_v; body_v] ->
      let body = match body_v with
        | String s -> s
        | Nil -> ""
        | v -> Sx_types.value_to_string v in
      let prefix = "http://" in
      let plen = String.length prefix in
      let ulen = String.length url in
      if ulen < plen || String.sub url 0 plen <> prefix
      then raise (Eval_error "http-request: URL must start with http://");
      let rest = String.sub url plen (ulen - plen) in
      let host_port, path =
        match String.index_opt rest '/' with
        | Some i ->
          String.sub rest 0 i,
          String.sub rest i (String.length rest - i)
        | None -> rest, "/" in
      if host_port = "" then
        raise (Eval_error "http-request: missing host");
      let host, port =
        match String.index_opt host_port ':' with
        | Some i ->
          let h = String.sub host_port 0 i in
          let ps = String.sub host_port (i + 1)
                     (String.length host_port - i - 1) in
          (h,
           (try int_of_string ps with _ ->
              raise (Eval_error "http-request: bad port")))
        | None -> host_port, 80 in
      let addr =
        (try (Unix.gethostbyname host).h_addr_list.(0)
         with Not_found ->
           raise (Eval_error ("http-request: dns: " ^ host))) in
      let sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
      let cleanup () = try Unix.close sock with _ -> () in
      let result =
        (try
          (try Unix.connect sock (Unix.ADDR_INET (addr, port))
           with Unix.Unix_error (e, _, _) ->
             raise (Eval_error
                      ("http-request: connect: " ^ Unix.error_message e)));
          let oc = Unix.out_channel_of_descr sock in
          let ic = Unix.in_channel_of_descr sock in
          let buf = Buffer.create 256 in
          Buffer.add_string buf
            (Printf.sprintf "%s %s HTTP/1.1\r\n" meth path);
          let host_hdr_sent = ref false in
          let clen_sent = ref false in
          let conn_sent = ref false in
          (match headers_v with
           | Dict h ->
             Hashtbl.iter (fun k v ->
               let kl = String.lowercase_ascii k in
               if kl = "host" then host_hdr_sent := true;
               if kl = "content-length" then clen_sent := true;
               if kl = "connection" then conn_sent := true;
               let vs = match v with
                 | String s -> s
                 | x -> Sx_types.value_to_string x in
               Buffer.add_string buf
                 (Printf.sprintf "%s: %s\r\n" k vs)) h
           | Nil -> ()
           | _ -> raise (Eval_error "http-request: headers must be dict"));
          if not !host_hdr_sent then
            Buffer.add_string buf
              (Printf.sprintf "Host: %s\r\n" host_port);
          if not !clen_sent then
            Buffer.add_string buf
              (Printf.sprintf "Content-Length: %d\r\n"
                 (String.length body));
          if not !conn_sent then
            Buffer.add_string buf "Connection: close\r\n";
          Buffer.add_string buf "\r\n";
          Buffer.add_string buf body;
          output_string oc (Buffer.contents buf);
          flush oc;
          let sl =
            (try strip_cr (input_line ic)
             with End_of_file ->
               raise (Eval_error
                        "http-request: connection closed before status")) in
          let status =
            match String.split_on_char ' ' sl with
            | _ver :: code :: _ ->
              (try int_of_string code with _ ->
                 raise (Eval_error "http-request: bad status code"))
            | _ -> raise (Eval_error "http-request: bad status line") in
          let rhdrs = Sx_types.make_dict () in
          let clen = ref (-1) in
          let chunked = ref false in
          let rec rdh () =
            let h =
              (try strip_cr (input_line ic)
               with End_of_file -> "") in
            if h = "" then ()
            else begin
              (match String.index_opt h ':' with
               | Some i ->
                 let name =
                   String.lowercase_ascii
                     (String.trim (String.sub h 0 i)) in
                 let value =
                   String.trim
                     (String.sub h (i + 1)
                        (String.length h - i - 1)) in
                 Hashtbl.replace rhdrs name (String value);
                 if name = "content-length" then
                   (try clen := int_of_string value with _ -> ())
                 else if name = "transfer-encoding" &&
                         String.lowercase_ascii value = "chunked"
                 then chunked := true
               | None -> ());
              rdh ()
            end in
          rdh ();
          if !chunked then
            raise (Eval_error
                     "http-request: chunked transfer-encoding not supported");
          let rbody =
            if !clen >= 0 then begin
              let b = Bytes.create !clen in
              really_input ic b 0 !clen;
              Bytes.unsafe_to_string b
            end else begin
              let b = Buffer.create 256 in
              (try
                 while true do
                   Buffer.add_channel b ic 4096
                 done; assert false
               with End_of_file -> ());
              Buffer.contents b
            end in
          let resp = Sx_types.make_dict () in
          Hashtbl.replace resp "status" (Integer status);
          Hashtbl.replace resp "headers" (Dict rhdrs);
          Hashtbl.replace resp "body" (String rbody);
          Dict resp
        with e -> cleanup (); raise e) in
      cleanup ();
      result
    | _ -> raise (Eval_error "http-request: (method url headers body)"));

  bind "trampoline" (fun args ->
    match args with
    | [v] ->
      let rec resolve v = match v with
        | Thunk (expr, env) -> resolve (Sx_ref.eval_expr expr (Env env))
        | _ -> v
      in resolve v
    | _ -> raise (Eval_error "trampoline: expected 1 arg"));
  bind "call-lambda" (fun args ->
    (* Use cek_call instead of eval_expr to avoid re-evaluating
       already-evaluated args.  eval_expr copies Dict values (signals)
       during evaluation, so mutations in the lambda body would affect
       the copy, not the original. *)
    match args with
    | [fn_val; List call_args; Env _e] ->
      Sx_ref.cek_call fn_val (List call_args)
    | [fn_val; List call_args] ->
      Sx_ref.cek_call fn_val (List call_args)
    | _ -> raise (Eval_error "call-lambda: expected (fn args env?)"));
  bind "cek-try" (fun args ->
    match args with
    | [thunk; handler] ->
      (try Sx_ref.cek_call thunk Nil
       with Eval_error msg ->
         let enhanced = Sx_ref.enhance_error_with_trace msg in
         Sx_ref.cek_call handler (List [String enhanced]))
    | [thunk] ->
      (try let r = Sx_ref.cek_call thunk Nil in
        List [Symbol "ok"; r]
       with Eval_error msg ->
         let enhanced = Sx_ref.enhance_error_with_trace msg in
         List [Symbol "error"; String enhanced])
    | _ -> Nil);
  bind "cek-call" (fun args ->
    match args with
    | [fn_val; List call_args] -> Sx_ref.cek_call fn_val (List call_args)
    | [fn_val; Nil] -> Sx_ref.cek_call fn_val (List [])
    | [fn_val] -> Sx_ref.cek_call fn_val (List [])
    | _ -> Nil);
  bind "expand-macro" (fun args ->
    match args with
    | [Macro m; List macro_args; Env e] ->
      let body_env = { bindings = Hashtbl.create 16; parent = Some e } in
      List.iteri (fun i p ->
        let v = if i < List.length macro_args then List.nth macro_args i else Nil in
        Hashtbl.replace body_env.bindings (Sx_types.intern p) v
      ) m.m_params;
      Sx_ref.eval_expr m.m_body (Env body_env)
    | _ -> raise (Eval_error "expand-macro: expected (macro args env)"));
  bind "qq-expand-runtime" (fun args ->
    match args with
    | [template] -> Sx_ref.qq_expand template (Env env)
    | [template; Env e] -> Sx_ref.qq_expand template (Env e)
    | _ -> Nil);
  bind "register-special-form!" (fun args ->
    match args with
    | [String name; handler] ->
      ignore (Sx_ref.register_special_form (String name) handler); Nil
    | _ -> raise (Eval_error "register-special-form!: expected (name handler)"));
  ignore (env_bind env "*custom-special-forms*" Sx_ref.custom_special_forms);
  ignore (Sx_ref.register_special_form (String "<>") (NativeFn ("<>", fun args ->
    List (List.map (fun a -> Sx_ref.eval_expr a (Env env)) args))));
  (* current-env: special form — returns current lexical env as a first-class value *)
  ignore (Sx_ref.register_special_form (String "current-env")
    (NativeFn ("current-env", fun args ->
      match args with
      | [_arg_list; env_val] -> env_val
      | _ -> Nil)))

(* ---- Type predicates and introspection ---- *)
let setup_introspection env =
  let bind name fn = ignore (env_bind env name (NativeFn (name, fn))) in
  bind "thunk?" (fun args -> match args with [Thunk _] -> Bool true | _ -> Bool false);
  bind "thunk-expr" (fun args -> match args with [v] -> thunk_expr v | _ -> Nil);
  bind "thunk-env" (fun args -> match args with [v] -> thunk_env v | _ -> Nil);
  bind "lambda?" (fun args -> match args with [Lambda _] -> Bool true | _ -> Bool false);
  bind "macro?" (fun args -> match args with [Macro _] -> Bool true | _ -> Bool false);
  bind "island?" (fun args -> match args with [Island _] -> Bool true | _ -> Bool false);
  bind "component?" (fun args ->
    match args with [Component _] | [Island _] -> Bool true | _ -> Bool false);
  bind "callable?" (fun args ->
    match args with [NativeFn _] | [Lambda _] | [Component _] | [Island _] -> Bool true | _ -> Bool false);
  bind "spread?" (fun args -> match args with [Spread _] -> Bool true | _ -> Bool false);
  bind "continuation?" (fun args ->
    match args with [Continuation _] -> Bool true | [_] -> Bool false | _ -> Bool false);
  bind "lambda-params" (fun args ->
    match args with [Lambda l] -> List (List.map (fun s -> String s) l.l_params) | _ -> List []);
  bind "lambda-body" (fun args -> match args with [Lambda l] -> l.l_body | _ -> Nil);
  bind "lambda-closure" (fun args ->
    match args with [Lambda l] -> Env l.l_closure | _ -> Dict (Hashtbl.create 0));
  bind "component-name" (fun args ->
    match args with [Component c] -> String c.c_name | [Island i] -> String i.i_name | _ -> String "");
  bind "component-closure" (fun args ->
    match args with [Component c] -> Env c.c_closure | [Island i] -> Env i.i_closure | _ -> Dict (Hashtbl.create 0));
  bind "component-params" (fun args ->
    match args with
    | [Component c] -> List (List.map (fun s -> String s) c.c_params)
    | [Island i] -> List (List.map (fun s -> String s) i.i_params)
    | _ -> Nil);
  bind "component-body" (fun args ->
    match args with [Component c] -> c.c_body | [Island i] -> i.i_body | _ -> Nil);
  let has_children_impl = NativeFn ("component-has-children?", fun args ->
    match args with [Component c] -> Bool c.c_has_children | [Island i] -> Bool i.i_has_children | _ -> Bool false) in
  ignore (env_bind env "component-has-children" has_children_impl);
  ignore (env_bind env "component-has-children?" has_children_impl);
  bind "component-affinity" (fun args ->
    match args with [Component c] -> String c.c_affinity | [Island _] -> String "client" | _ -> String "auto");
  bind "spread-attrs" (fun args ->
    match args with
    | [Spread pairs] ->
      let d = Hashtbl.create 4 in List.iter (fun (k, v) -> Hashtbl.replace d k v) pairs; Dict d
    | _ -> Dict (Hashtbl.create 0));
  bind "make-spread" (fun args ->
    match args with
    | [Dict d] -> Spread (Hashtbl.fold (fun k v acc -> (k, v) :: acc) d [])
    | _ -> Nil)

(* ---- Type operations, string/number/env helpers ---- *)
(* ---- Core runtime operations (assert, append!, apply, etc.) ---- *)
let setup_core_operations env =
  let bind name fn = ignore (env_bind env name (NativeFn (name, fn))) in
  bind "assert" (fun args ->
    match args with
    | [cond] -> if not (sx_truthy cond) then raise (Eval_error "Assertion failed"); Bool true
    | [cond; String msg] -> if not (sx_truthy cond) then raise (Eval_error ("Assertion error: " ^ msg)); Bool true
    | [cond; msg] -> if not (sx_truthy cond) then raise (Eval_error ("Assertion error: " ^ value_to_string msg)); Bool true
    | _ -> raise (Eval_error "assert: expected 1-2 args"));
  bind "append!" (fun args ->
    match args with
    | [ListRef r; v] -> r := !r @ [v]; ListRef r
    | [List items; v] -> List (items @ [v])
    | _ -> raise (Eval_error "append!: expected list and value"));
  bind "make-raw-html" (fun args ->
    match args with [String s] -> RawHTML s | [v] -> RawHTML (value_to_string v) | _ -> Nil);
  bind "raw-html-content" (fun args ->
    match args with [RawHTML s] -> String s | [String s] -> String s | _ -> String "");
  bind "empty-dict?" (fun args ->
    match args with [Dict d] -> Bool (Hashtbl.length d = 0) | _ -> Bool true);
  bind "for-each-indexed" (fun args ->
    match args with
    | [fn_val; List items] | [fn_val; ListRef { contents = items }] ->
      List.iteri (fun i item ->
        ignore (Sx_ref.eval_expr (List [fn_val; Number (float_of_int i); item]) (Env env))
      ) items; Nil
    | _ -> Nil);
  bind "equal?" (fun args -> match args with [a; b] -> Bool (a = b) | _ -> raise (Eval_error "equal?: expected 2 args"));
  bind "identical?" (fun args -> match args with [a; b] -> Bool (a == b) | _ -> raise (Eval_error "identical?: expected 2 args"));
  bind "apply" (fun args ->
    match args with
    | f :: rest ->
      let all_args = match List.rev rest with List last :: prefix -> List.rev prefix @ last | _ -> rest in
      Sx_runtime.sx_call f all_args
    | _ -> raise (Eval_error "apply: expected function and args"));
  bind "cond-scheme?" (fun args -> match args with [clauses] -> Sx_ref.cond_scheme_p clauses | _ -> Bool false);
  bind "is-else-clause?" (fun args -> match args with [test] -> Sx_ref.is_else_clause test | _ -> Bool false);
  bind "primitive?" (fun args ->
    match args with
    | [String name] -> Bool (Sx_primitives.is_primitive name ||
        (try (match env_get env name with NativeFn _ -> true | _ -> false) with _ -> false))
    | _ -> Bool false);
  bind "get-primitive" (fun args ->
    match args with
    | [String name] -> (try Sx_primitives.get_primitive name with _ -> try env_get env name with _ -> Nil)
    | _ -> Nil);
  bind "make-continuation" (fun args ->
    match args with [f] -> Continuation ((fun v -> Sx_runtime.sx_call f [v]), None) | _ -> raise (Eval_error "make-continuation: expected 1 arg"))

(* ---- Type constructors and symbol operations ---- *)
let setup_type_constructors env =
  let bind name fn = ignore (env_bind env name (NativeFn (name, fn))) in
  bind "upcase" (fun args -> match args with [String s] -> String (String.uppercase_ascii s) | _ -> raise (Eval_error "upcase: expected string"));
  bind "downcase" (fun args -> match args with [String s] -> String (String.lowercase_ascii s) | _ -> raise (Eval_error "downcase: expected string"));
  bind "make-keyword" (fun args -> match args with [String s] -> Keyword s | _ -> raise (Eval_error "make-keyword: expected string"));
  bind "keyword-name" (fun args -> match args with [Keyword k] -> String k | _ -> raise (Eval_error "keyword-name: expected keyword"));
  bind "symbol-name" (fun args -> match args with [Symbol s] -> String s | _ -> raise (Eval_error "symbol-name: expected symbol"));
  bind "make-symbol" (fun args -> match args with [String s] -> Symbol s | [v] -> Symbol (value_to_string v) | _ -> raise (Eval_error "make-symbol: expected 1 arg"));
  bind "make-sx-expr" (fun args -> match args with [String s] -> SxExpr s | _ -> raise (Eval_error "make-sx-expr: expected string"));
  bind "sx-expr-source" (fun args -> match args with [SxExpr s] -> String s | [String s] -> String s | _ -> raise (Eval_error "sx-expr-source: expected sx-expr or string"));
  bind "sx-serialize" (fun args -> match args with [v] -> String (inspect v) | _ -> raise (Eval_error "sx-serialize: expected 1 arg"));
  bind "is-html-tag?" (fun args -> match args with [String s] -> Bool (Sx_render.is_html_tag s) | _ -> Bool false);
  bind "string-length" (fun args -> match args with [String s] -> Number (float_of_int (String.length s)) | _ -> raise (Eval_error "string-length: expected string"));
  bind "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: expected dict and key"));
  bind "escape-string" (fun args ->
    match args with
    | [String s] ->
      let buf = Buffer.create (String.length s) in
      String.iter (fun c -> match c with
        | '"' -> Buffer.add_string buf "\\\"" | '\\' -> Buffer.add_string buf "\\\\"
        | '\n' -> Buffer.add_string buf "\\n" | '\r' -> Buffer.add_string buf "\\r"
        | '\t' -> Buffer.add_string buf "\\t" | c -> Buffer.add_char buf c) s;
      String (Buffer.contents buf)
    | _ -> raise (Eval_error "escape-string: expected string"));
  bind "random-int" (fun args ->
    match args with
    | [Number lo; Number hi] ->
      let lo = int_of_float lo and hi = int_of_float hi in
      Number (float_of_int (lo + Random.int (max 1 (hi - lo + 1))))
    | _ -> raise (Eval_error "random-int: expected (low high)"));
  bind "parse" (fun args ->
    match args with
    | [String s] | [SxExpr s] ->
      let exprs = Sx_parser.parse_all s in
      (match exprs with [e] -> e | _ -> List exprs)
    | [v] ->
      (* Already a value — return as-is *)
      v
    | _ -> raise (Eval_error "parse: expected string"));
  (* Native bytecode compiler — bootstrapped from lib/compiler.sx *)
  bind "compile" (fun args ->
    match args with [expr] -> Sx_compiler.compile expr | _ -> Nil);
  bind "compile-module" (fun args ->
    match args with [exprs] -> Sx_compiler.compile_module exprs | _ -> Nil);
  bind "parse-int" (fun args ->
    match args with
    | [String s] -> (try Number (float_of_int (int_of_string s)) with _ -> Nil)
    | [String s; default_val] -> (try Number (float_of_int (int_of_string s)) with _ -> default_val)
    | [Number n] | [Number n; _] -> Number (Float.round n)
    | [_; default_val] -> default_val | _ -> Nil);
  bind "parse-number" (fun args -> match args with [String s] -> (try Number (float_of_string s) with _ -> Nil) | _ -> Nil)

(* ---- Character classification (platform primitives for spec/parser.sx) ---- *)
let setup_character_classification env =
  let bind name fn = ignore (env_bind env name (NativeFn (name, fn))) in
  bind "ident-start?" (fun args ->
    match args with
    | [String s] when String.length s = 1 ->
      let c = s.[0] in
      Bool (c >= 'a' && c <= 'z' || c >= 'A' && c <= 'Z' || c = '_' || c = '~'
            || c = '!' || c = '?' || c = '+' || c = '-' || c = '*' || c = '/'
            || c = '=' || c = '<' || c = '>' || c = '&' || c = '|' || c = '%'
            || c = '^' || c = '$' || c = '#')
    | _ -> Bool false);
  bind "ident-char?" (fun args ->
    match args with
    | [String s] when String.length s = 1 ->
      let c = s.[0] in
      Bool (c >= 'a' && c <= 'z' || c >= 'A' && c <= 'Z' || c = '_' || c = '~'
            || c = '!' || c = '?' || c = '+' || c = '-' || c = '*' || c = '/'
            || c = '=' || c = '<' || c = '>' || c = '&' || c = '|' || c = '%'
            || c = '^' || c = '$' || c = '#'
            || c >= '0' && c <= '9' || c = '.' || c = ':')
    | _ -> Bool false);
  bind "char-numeric?" (fun args ->
    match args with [String s] when String.length s = 1 -> Bool (s.[0] >= '0' && s.[0] <= '9') | _ -> Bool false)

(* ---- Env operations (env-get, env-has?, env-bind!, etc.) ---- *)
let setup_env_operations env =
  let bind name fn = ignore (env_bind env name (NativeFn (name, fn))) in
  let uw = Sx_runtime.unwrap_env in
  bind "env-get" (fun args -> match args with [e; String k] -> Sx_types.env_get (uw e) k | [e; Keyword k] -> Sx_types.env_get (uw e) k | _ -> raise (Eval_error "env-get: expected env and string"));
  bind "env-has?" (fun args -> match args with [e; String k] -> Bool (Sx_types.env_has (uw e) k) | [e; Keyword k] -> Bool (Sx_types.env_has (uw e) k) | _ -> raise (Eval_error "env-has?: expected env and string"));
  bind "env-bind!" (fun args -> match args with [e; String k; v] -> Sx_types.env_bind (uw e) k v | [e; Keyword k; v] -> Sx_types.env_bind (uw e) k v | _ -> raise (Eval_error "env-bind!: expected env, key, value"));
  bind "env-set!" (fun args -> match args with [e; String k; v] -> Sx_types.env_set (uw e) k v | [e; Keyword k; v] -> Sx_types.env_set (uw e) k v | _ -> raise (Eval_error "env-set!: expected env, key, value"));
  bind "env-extend" (fun args ->
    match args with
    | e :: pairs ->
      let child = Sx_types.env_extend (uw e) in
      let rec go = function
        | [] -> ()
        | k :: v :: rest ->
          ignore (Sx_types.env_bind child (Sx_runtime.value_to_str k) v); go rest
        | [_] -> raise (Eval_error "env-extend: odd number of key-val pairs") in
      go pairs; Env child
    | _ -> raise (Eval_error "env-extend: expected env"));
  bind "env-lookup" (fun args ->
    match args with
    | [e; key] ->
      let k = Sx_runtime.value_to_str key in
      let raw = uw e in
      if Sx_types.env_has raw k then Sx_types.env_get raw k else Nil
    | _ -> raise (Eval_error "env-lookup: (env key)"));
  bind "env-merge" (fun args -> match args with [a; b] -> Sx_runtime.env_merge a b | _ -> raise (Eval_error "env-merge: expected 2 envs"))

(* ---- Strict mode (gradual type system support) ---- *)
let setup_strict_mode env =
  let bind name fn = ignore (env_bind env name (NativeFn (name, fn))) in
  ignore (env_bind env "*strict*" (Bool false));
  ignore (env_bind env "*prim-param-types*" Nil);
  bind "set-strict!" (fun args -> match args with [v] -> Sx_ref._strict_ref := v; ignore (env_set env "*strict*" v); Nil | _ -> raise (Eval_error "set-strict!: expected 1 arg"));
  bind "set-prim-param-types!" (fun args -> match args with [v] -> Sx_ref._prim_param_types_ref := v; ignore (env_set env "*prim-param-types*" v); Nil | _ -> raise (Eval_error "set-prim-param-types!: expected 1 arg"));
  bind "component-param-types" (fun _args -> Nil);
  bind "component-set-param-types!" (fun _args -> Nil);
  bind "component-file" (fun args -> match args with [v] -> component_file v | _ -> Nil);
  bind "component-set-file!" (fun args -> match args with [v; f] -> component_set_file v f | _ -> Nil)

(* ---- IO helpers routed to Python bridge ---- *)
let _pending_response_status = ref 200
let setup_io_bridges env =
  let bind name fn = ignore (env_bind env name (NativeFn (name, fn))) in
  bind "json-encode" (fun args -> io_request "helper" (String "json-encode" :: args));
  bind "into" (fun args -> io_request "helper" (String "into" :: args));
  bind "sleep" (fun args -> io_request "sleep" args);
  bind "set-response-status" (fun args -> match args with
    | [Number n] -> _pending_response_status := int_of_float n; Nil
    | [Integer n] -> _pending_response_status := n; Nil
    | _ -> Nil);
  bind "set-response-header" (fun args -> io_request "set-response-header" args)

(* ---- HTML tag functions (div, span, h1, ...) ---- *)
let setup_html_tags env =
  List.iter (fun tag ->
    ignore (env_bind env tag
      (NativeFn ("html:" ^ tag, fun args -> List (Symbol tag :: args))))
  ) Sx_render.html_tags


(* ====================================================================== *)
(* Compose environment                                                      *)
(* ====================================================================== *)

(** Convert int-keyed env.bindings to string-keyed Hashtbl for VM globals *)
(* Shared VM globals table — one live table, all JIT closures share
   the same reference.  Kept in sync via env_bind hook so late-bound
   values (shell statics, page functions, defines) are always visible. *)
let _shared_vm_globals : (string, Sx_types.value) Hashtbl.t = Hashtbl.create 2048

let env_to_vm_globals _env = _shared_vm_globals

let () =
  (* Hook env_bind so top-level bindings (defines, component defs, shell statics)
     are mirrored to vm globals. Only sync when binding in a root env (no parent)
     to avoid polluting globals with lambda parameter bindings, which would break
     closure isolation for factory functions like make-page-fn. *)
  Sx_types._env_bind_hook := Some (fun env name v ->
    if env.parent = None then
      (* Don't let SX definitions (from loaded .sx files) overwrite native
         primitives in vm_globals — the native versions are authoritative. *)
      if not (Sx_primitives.is_primitive name) then
        Hashtbl.replace _shared_vm_globals name v)

(* Import hook — resolves (import ...) suspensions inside eval_expr/cek_run.
   Loads the .sx file for the library, registers it, and returns true.
   Re-entry guard prevents infinite loops from circular or failing imports. *)
let _loading_libs : (string, bool) Hashtbl.t = Hashtbl.create 8
let () =
  Sx_types._import_hook := Some (fun lib_spec ->
    if Sx_types.sx_truthy (Sx_ref.library_loaded_p lib_spec) then true
    else
    let key = Sx_types.inspect lib_spec in
    if Hashtbl.mem _loading_libs key then false  (* already loading — break cycle *)
    else begin
    Hashtbl.replace _loading_libs key true;
    let result = match resolve_library_path lib_spec with
      | Some path ->
        (try load_library_file path;
          (* Verify the library actually registered *)
          Sx_types.sx_truthy (Sx_ref.library_loaded_p lib_spec)
         with e ->
          Printf.eprintf "[import-hook] FAIL %s from %s: %s\n%!"
            key path (Printexc.to_string e);
          false)
      | None -> false in
    (* Don't remove — keep as "attempted" guard to prevent retries *)
    result
    end)

let make_server_env () =
  let env = make_env () in
  Sx_render.setup_render_env env;
  setup_browser_stubs env;
  setup_scope_env env;
  setup_evaluator_bridge env;
  setup_introspection env;
  setup_core_operations env;
  setup_type_constructors env;
  setup_character_classification env;
  setup_env_operations env;
  setup_strict_mode env;
  setup_io_bridges env;
  setup_html_tags env;
  setup_io_env env;
  (* defhandler — native special form. Called by CEK as (handler [raw-args; Env eval-env]).
     Registers handler as handler:name in the eval env. *)
  ignore (Sx_ref.register_special_form (String "defhandler") (NativeFn ("defhandler", fun sf_args ->
    (* Custom special forms receive [List args; Env eval_env] *)
    let raw_args, eval_env = match sf_args with
      | [List a; Env e] | [ListRef { contents = a }; Env e] -> (a, e)
      | _ -> ([], env) in
    match raw_args with
    | name_sym :: rest ->
      let name = match name_sym with Symbol s -> s | String s -> s | _ -> Sx_types.inspect name_sym in
      let rec parse_opts acc = function
        | Keyword k :: v :: rest -> Hashtbl.replace acc k v; parse_opts acc rest
        | rest -> (acc, rest) in
      let opts = Hashtbl.create 4 in
      let (_, remaining) = parse_opts opts rest in
      let params, body = match remaining with
        | List p :: b :: _ -> (p, b) | List p :: [] -> (p, Nil) | _ -> ([], Nil) in
      let hdef = Hashtbl.create 8 in
      Hashtbl.replace hdef "__type" (String "handler");
      Hashtbl.replace hdef "name" (String name);
      Hashtbl.replace hdef "params" (List params);
      Hashtbl.replace hdef "body" body;
      Hashtbl.replace hdef "closure" (Env eval_env);
      Hashtbl.replace hdef "method" (match Hashtbl.find_opt opts "method" with
        | Some (Keyword m) -> String m | Some v -> v | None -> String "get");
      Hashtbl.replace hdef "path" (match Hashtbl.find_opt opts "path" with Some v -> v | None -> Nil);
      Hashtbl.replace hdef "csrf" (match Hashtbl.find_opt opts "csrf" with Some v -> v | None -> Bool true);
      Hashtbl.replace hdef "returns" (match Hashtbl.find_opt opts "returns" with Some v -> v | None -> String "element");
      ignore (env_bind eval_env ("handler:" ^ name) (Dict hdef));
      Dict hdef
    | _ -> Nil)));
  (* Initialize trampoline ref so HO primitives (map, filter, etc.)
     can call SX lambdas. Must be done here because Sx_ref is only
     available at the binary level, not in the library. *)
  Sx_primitives._sx_trampoline_fn := (fun v ->
    match v with
    | Thunk (body, closure_env) -> Sx_ref.eval_expr body (Env closure_env)
    | other -> other);
  (* client? returns false on server — overridden in browser via K.eval *)
  ignore (env_bind env "client?" (NativeFn ("client?", fun _ -> Bool false)));
  (* Seed vm_globals with ALL primitives as NativeFn values.
     Native primitives override SX definitions (e.g. has-key? from stdlib.sx)
     because the native versions are correct and fast. HO forms (map, filter, etc.)
     keep their ho_via_cek wrappers since those are set up after this seeding
     via the env_bind_hook when SX files are loaded. *)
  Hashtbl.iter (fun name fn ->
    Hashtbl.replace _shared_vm_globals name (NativeFn (name, fn))
  ) Sx_primitives.primitives;
  env


(* ====================================================================== *)
(* SX render-to-html — calls adapter-html.sx via CEK                       *)
(* ====================================================================== *)

(** Render an SX expression to HTML using the SX adapter (adapter-html.sx).
    Falls back to Sx_render.sx_render_to_html if the SX adapter isn't loaded. *)
let sx_render_to_html expr env =
  if env_has env "render-to-html" then
    let fn = env_get env "render-to-html" in
    let result = Sx_ref.cek_call fn (List [expr; Env env]) in
    match result with String s -> s | _ -> Sx_runtime.value_to_str result
  else
    Sx_render.sx_render_to_html env expr env


(* ====================================================================== *)
(* JIT hook registration                                                    *)
(* ====================================================================== *)

(** Register the JIT call hook.  Called once after the compiler is loaded
    into the kernel env.  The hook handles both cached execution (bytecode
    already compiled) and first-call compilation (invoke compiler.sx via
    CEK, cache result).  cek_call checks this before CEK dispatch. *)
(* Re-entrancy guard lives in Sx_vm._jit_compiling (shared with vm_call path) *)

(* JIT compilation is lazy-only: every named lambda gets one compile
   attempt on first call. Failures are sentineled (never retried). *)

let _jit_warned : (string, bool) Hashtbl.t = Hashtbl.create 16

let rec make_vm_suspend_marker request saved_vm =
  let d = Hashtbl.create 3 in
  Hashtbl.replace d "__vm_suspended" (Bool true);
  Hashtbl.replace d "request" request;
  (* Create a resume function that continues this specific VM.
     May raise VmSuspended again — caller must handle. *)
  Hashtbl.replace d "resume" (NativeFn ("vm-resume", fun args ->
    match args with
    | [result] ->
      (try Sx_vm.resume_vm saved_vm result
       with Sx_vm.VmSuspended (req2, vm2) ->
         make_vm_suspend_marker req2 vm2)
    | _ -> raise (Eval_error "vm-resume: expected 1 arg")));
  Dict d

let register_jit_hook env =
  Sx_runtime._jit_try_call_fn := Some (fun f args ->
    match f with
    | Lambda l ->
      (match l.l_compiled with
       | Some cl when not (Sx_vm.is_jit_failed cl) ->
         (* Skip during CEK-based compilation — helpers are called inside
            the VM when compile has bytecode, no need for the hook. *)
         if !(Sx_vm._jit_compiling) then None
         else
         (try Some (Sx_vm.call_closure cl args cl.vm_env_ref)
          with
          | Sx_vm.VmSuspended (request, saved_vm) ->
            (* Try inline IO resolution; fall back to suspend marker *)
            (match !Sx_types._cek_io_resolver with
             | Some resolver ->
               let rec resolve_loop req vm =
                 let result = resolver req (Nil) in
                 (try Some (Sx_vm.resume_vm vm result)
                  with Sx_vm.VmSuspended (req2, vm2) -> resolve_loop req2 vm2)
               in
               resolve_loop request saved_vm
             | None -> Some (make_vm_suspend_marker request saved_vm))
          | e ->
            let fn_name = match l.l_name with Some n -> n | None -> "?" in
            if not (Hashtbl.mem _jit_warned fn_name) then begin
              Hashtbl.replace _jit_warned fn_name true;
              Printf.eprintf "[jit] %s runtime fallback to CEK: %s\n%!" fn_name (Printexc.to_string e)
            end;
            l.l_compiled <- Some Sx_vm.jit_failed_sentinel;
            None)
       | Some _ -> None
       | None ->
         let fn_name = match l.l_name with Some n -> n | None -> "?" in
         if !(Sx_vm._jit_compiling) then None
         else if Hashtbl.mem _jit_warned fn_name then None
         else begin
           let t0 = Unix.gettimeofday () in
           let compiled = Sx_vm.jit_compile_lambda l (env_to_vm_globals env) in
           let dt = Unix.gettimeofday () -. t0 in
           Printf.eprintf "[jit] %s compile in %.3fs\n%!" fn_name dt;
           match compiled with
           | Some cl ->
             l.l_compiled <- Some cl;
             (try Some (Sx_vm.call_closure cl args cl.vm_env_ref)
              with
              | Sx_vm.VmSuspended (request, saved_vm) ->
                (match !Sx_types._cek_io_resolver with
                 | Some resolver ->
                   let rec resolve_loop req vm =
                     let result = resolver req (Nil) in
                     (try Some (Sx_vm.resume_vm vm result)
                      with Sx_vm.VmSuspended (req2, vm2) -> resolve_loop req2 vm2)
                   in
                   resolve_loop request saved_vm
                 | None -> Some (make_vm_suspend_marker request saved_vm))
              | e ->
                Printf.eprintf "[jit] %s first-call fallback to CEK: %s\n%!" fn_name (Printexc.to_string e);
                Hashtbl.replace _jit_warned fn_name true;
                l.l_compiled <- Some Sx_vm.jit_failed_sentinel;
                None)
           | None ->
             l.l_compiled <- Some Sx_vm.jit_failed_sentinel;
             None
         end)
    | _ -> None)


(* ====================================================================== *)
(* Re-assert host-provided extension points after loading .sx files.
   evaluator.sx defines *custom-special-forms* and register-special-form!
   which shadow the native bindings from setup_evaluator_bridge. *)
let rebind_host_extensions env =
  Hashtbl.replace env.bindings (Sx_types.intern "register-special-form!")
    (NativeFn ("register-special-form!", fun args ->
      match args with
      | [String name; handler] ->
        ignore (Sx_ref.register_special_form (String name) handler); Nil
      | _ -> raise (Eval_error "register-special-form!: expected (name handler)")));
  ignore (env_bind env "*custom-special-forms*" Sx_ref.custom_special_forms)

(* Path-based naming for unnamed definitions                               *)
(* ====================================================================== *)

let def_keywords = ["defcomp"; "defisland"; "defmacro"; "define";
                     "defhandler"; "defstyle"; "deftype"; "defeffect";
                     "defrelation"; "deftest"; "defpage"]

(* Inject path-derived name into unnamed definitions.
   (defcomp (params) body) -> (defcomp ~path/name (params) body)
   Only applied when base_dir is provided (service components). *)
let inject_path_name expr path base_dir =
  match expr with
  | List (Symbol kw :: rest) when List.mem kw def_keywords ->
    (match rest with
     | Symbol _ :: _ -> expr  (* Already named *)
     | _ ->
       (* Unnamed — derive name from file path relative to base_dir *)
       let rel = if String.length path > String.length base_dir + 1
         then String.sub path (String.length base_dir + 1)
                (String.length path - String.length base_dir - 1)
         else Filename.basename path in
       let stem = if Filename.check_suffix rel ".sx"
         then String.sub rel 0 (String.length rel - 3)
         else rel in
       (* Strip _islands/ convention directories from the path *)
       let stem = let parts = String.split_on_char '/' stem in
         String.concat "/" (List.filter (fun p -> p <> "_islands") parts) in
       (* index files are known by their directory *)
       let name = if Filename.basename stem = "index"
         then let d = Filename.dirname stem in
              if d = "." then "index" else d
         else stem in
       (* Components/islands get ~ prefix *)
       let prefixed = if kw = "defcomp" || kw = "defisland"
         then "~" ^ name else name in
       List (Symbol kw :: Symbol prefixed :: rest))
  | _ -> expr

(* Command dispatch                                                        *)
(* ====================================================================== *)

let rec dispatch env cmd =
  match cmd with
  | List [Symbol "ping"] ->
    send_ok_string "ocaml-cek"

  | List [Symbol "load"; String path]
  | List [Symbol "load"; String path; String _] ->
    let base_dir = match cmd with
      | List [_; _; String b] -> b | _ -> "" in
    (try
      let exprs = Sx_parser.parse_file path in
      let prev_file = if Sx_types.env_has env "*current-file*" then Some (Sx_types.env_get env "*current-file*") else None in
      ignore (Sx_types.env_bind env "*current-file*" (String path));
      let count = ref 0 in
      List.iter (fun expr ->
        let expr' = if base_dir <> "" then inject_path_name expr path base_dir else expr in
        (try ignore (eval_expr_io expr' (Env env))
         with Eval_error msg ->
           Printf.eprintf "[load] %s: %s\n%!" (Filename.basename path) msg);
        incr count
      ) exprs;
      (* Rebind host extension points after .sx load — evaluator.sx
         defines *custom-special-forms* which shadows the native dict *)
      rebind_host_extensions env;
      (match prev_file with
       | Some v -> ignore (Sx_types.env_bind env "*current-file*" v)
       | None -> ());
      send_ok_value (Number (float_of_int !count))
    with
    | Eval_error msg -> send_error msg
    | Sys_error msg -> send_error ("File error: " ^ msg)
    | exn -> send_error (Printexc.to_string exn))

  | List [Symbol "load-source"; String src] ->
    (try
      let exprs = Sx_parser.parse_all src in
      let count = ref 0 in
      List.iter (fun expr ->
        ignore (Sx_ref.eval_expr expr (Env env));
        incr count
      ) exprs;
      send_ok_value (Number (float_of_int !count))
    with
    | Eval_error msg -> send_error msg
    | exn -> send_error (Printexc.to_string exn))

  | List [Symbol "eval-blob"] ->
    let src = read_blob () in
    dispatch env (List [Symbol "eval"; String src])

  | List [Symbol "compile-blob"] ->
    (* Read source as blob, parse natively in OCaml, compile via SX compile-module.
       Returns the bytecode dict as SX text. Much faster than JS kernel. *)
    let src = read_blob () in
    (try
      let exprs = Sx_parser.parse_all src in
      let compile_module = env_get env "compile-module" in
      let result = Sx_ref.cek_call compile_module (List [List exprs]) in
      let rec raw_serialize = function
        | Nil -> "nil"
        | Bool true -> "true" | Bool false -> "false"
        | Number n -> Sx_types.format_number n
        | String s -> "\"" ^ escape_sx_string s ^ "\""
        | Symbol s -> s | Keyword k -> ":" ^ k
        | List items | ListRef { contents = items } -> "(" ^ String.concat " " (List.map raw_serialize items) ^ ")"
        | Dict d -> let pairs = Hashtbl.fold (fun k v acc -> (Printf.sprintf ":%s %s" k (raw_serialize v)) :: acc) d [] in "{" ^ String.concat " " pairs ^ "}"
        | SxExpr s -> s | _ -> "nil"
      in
      send_ok_raw (raw_serialize result)
    with
    | Eval_error msg -> send_error msg
    | exn -> send_error (Printexc.to_string exn))

  | List [Symbol "eval"; String src] ->
    (try
      let exprs = Sx_parser.parse_all src in
      let result = List.fold_left (fun _acc expr ->
        (* Use import-aware eval — handles define-library/import locally
           but does NOT send other IO to the Python bridge (would deadlock
           on stdin which carries batch commands). *)
        let state = Sx_ref.make_cek_state expr (Env env) (List []) in
        let s = ref (Sx_ref.cek_step_loop state) in
        while Sx_types.sx_truthy (Sx_ref.cek_suspended_p !s) do
          let request = Sx_ref.cek_io_request !s in
          let op = match request with
            | Dict d -> (match Hashtbl.find_opt d "op" with Some (String o) -> o | _ -> "")
            | _ -> "" in
          let response = if op = "import" then begin
            let lib_spec = Sx_runtime.get_val request (String "library") in
            let key = Sx_ref.library_name_key lib_spec in
            if Sx_types.sx_truthy (Sx_ref.library_loaded_p key) then Nil
            else begin
              (match resolve_library_path lib_spec with
               | Some path -> load_library_file path | None -> ());
              Nil
            end
          end else
            (* durable-storage ops: service against on-disk store *)
            let args = Sx_runtime.get_val request (String "args") in
            (match Sx_persist_store.handle_op op args with
             | Some resp -> resp
             | None -> Nil (* non-import IO: resume with nil *)) in
          s := Sx_ref.cek_resume !s response
        done;
        Sx_ref.cek_value !s
      ) Nil exprs in
      (* Use ok-raw with natural list serialization — no (list ...) wrapping.
         This preserves the SX structure for Python to parse back. *)
      let rec raw_serialize = function
        | Nil -> "nil"
        | Bool true -> "true"
        | Bool false -> "false"
        | Number n -> Sx_types.format_number n
        | Integer n -> string_of_int n
        | String s -> "\"" ^ escape_sx_string s ^ "\""
        | Symbol s -> s
        | Keyword k -> ":" ^ k
        | List items | ListRef { contents = items } ->
          "(" ^ String.concat " " (List.map raw_serialize items) ^ ")"
        | Dict d ->
          let pairs = Hashtbl.fold (fun k v acc ->
            (Printf.sprintf ":%s %s" k (raw_serialize v)) :: acc) d [] in
          "{" ^ String.concat " " pairs ^ "}"
        | Component c -> "~" ^ c.c_name
        | Island i -> "~" ^ i.i_name
        | SxExpr s -> s
        | RawHTML s -> "\"" ^ escape_sx_string s ^ "\""
        | Char n -> Sx_types.inspect (Char n)
        | Eof -> Sx_types.inspect Eof
        | Port _ -> Sx_types.inspect result
        | Rational (n, d) -> Printf.sprintf "%d/%d" n d
        | _ -> "nil"
      in
      send_ok_raw (raw_serialize result)
    with
    | Eval_error msg -> send_error (Sx_ref.enhance_error_with_trace msg)
    | exn -> send_error (Printexc.to_string exn))

  | List [Symbol "vm-reset-fn"; String name] ->
    (* Reset a function's JIT-compiled bytecode, forcing CEK interpretation.
       Used to work around JIT compilation bugs in specific functions. *)
    (match Hashtbl.find_opt env.bindings (Sx_types.intern name) with
     | Some (Lambda l) ->
       l.l_compiled <- Some Sx_vm.jit_failed_sentinel;
       Printf.eprintf "[jit] reset %s (forced CEK)\n%!" name;
       send_ok ()
     | _ ->
       Printf.eprintf "[jit] reset %s: not found or not lambda\n%!" name;
       send_ok ())

  | List [Symbol "aser-blob"] ->
    (* Like aser but reads source as a binary blob. *)
    let src = read_blob () in
    dispatch env (List [Symbol "aser"; String src])

  | List [Symbol "aser-slot-blob"] ->
    (* Like aser-slot but reads source as a binary blob. *)
    let src = read_blob () in
    dispatch env (List [Symbol "aser-slot"; String src])

  | List [Symbol "aser"; String src] ->
    (* Evaluate and serialize as SX wire format.
       Calls the SX-defined aser function from adapter-sx.sx.
       aser is loaded into the kernel env via _ensure_components. *)
    (try
      let exprs = Sx_parser.parse_all src in
      let expr = match exprs with
        | [e] -> e
        | [] -> Nil
        | _ -> List (Symbol "<>" :: exprs)
      in
      (* Call (aser <quoted-expr> <env>) *)
      let call = List [Symbol "aser";
                        List [Symbol "quote"; expr];
                        Env env] in
      let result = Sx_ref.eval_expr call (Env env) in
      (* Send raw SX wire format without re-escaping.
         Use (ok-raw ...) so Python knows not to unescape. *)
      (match result with
       | String s | SxExpr s -> send_ok_raw s
       | List items | ListRef { contents = items } ->
         (* List of SxExprs from map/filter — join them as a fragment *)
         let parts = List.filter_map (fun v -> match v with
           | SxExpr s -> Some s
           | String s -> Some ("\"" ^ escape_sx_string s ^ "\"")
           | Nil -> None
           | v -> Some (serialize_value v)) items in
         if parts = [] then send_ok_raw ""
         else send_ok_raw (String.concat " " parts)
       | _ -> send_ok_value result)
    with
    | Eval_error msg -> send_error msg
    | exn -> send_error (Printexc.to_string exn))

  | List [Symbol "vm-compile-adapter"] ->
    (* Register lazy JIT hook — all named lambdas compile on first call.
       Pre-compile compiler internals so subsequent JIT compilations
       run at VM speed, not CEK speed. *)
    register_jit_hook env;
    let t0 = Unix.gettimeofday () in
    let count = ref 0 in
    (* Pre-compile compiler helpers AND compile itself.
       When compile has bytecode, jit_compile_lambda calls it directly via
       the VM — all helper calls happen inside the same VM execution with
       no per-call overhead. This is 10-100x faster than CEK dispatch. *)
    let compiler_names = [
      "compile"; "compile-module"; "compile-expr"; "compile-symbol";
      "compile-dict"; "compile-list"; "compile-if"; "compile-when";
      "compile-and"; "compile-or"; "compile-begin"; "compile-let";
      "compile-letrec"; "compile-lambda"; "compile-define"; "compile-set";
      "compile-quote"; "compile-cond"; "compile-case"; "compile-case-clauses";
      "compile-thread"; "compile-thread-step"; "compile-defcomp";
      "compile-defmacro"; "compile-quasiquote"; "compile-qq-expr";
      "compile-qq-list"; "compile-call";
      "make-emitter"; "make-pool"; "make-scope"; "pool-add";
      "scope-define-local"; "scope-resolve";
      "emit-byte"; "emit-u16"; "emit-i16"; "emit-op"; "emit-const";
      "current-offset"; "patch-i16";
    ] in
    List.iter (fun name ->
      match Hashtbl.find_opt env.bindings (Sx_types.intern name) with
      | Some (Lambda l) when l.l_compiled = None ->
        l.l_compiled <- Some Sx_vm.jit_failed_sentinel;
        (match Sx_vm.jit_compile_lambda l (env_to_vm_globals env) with
         | Some cl -> l.l_compiled <- Some cl; incr count
         | None -> ())
      | _ -> ()
    ) compiler_names;
    let dt = Unix.gettimeofday () -. t0 in
    Printf.eprintf "[jit] Pre-compiled %d compiler functions in %.3fs (lazy JIT active for all)\n%!" !count dt;
    send_ok ()

  | List [Symbol "jit-reset-name"; String name] ->
    (* Reset a function's JIT state back to uncompiled *)
    (match Hashtbl.find_opt env.bindings (Sx_types.intern name) with
     | Some (Lambda l) -> l.l_compiled <- None; send_ok_raw (Printf.sprintf "reset %s" name)
     | _ -> send_ok_raw (Printf.sprintf "not-found %s" name))

  | List [Symbol "set-request-cookies"; Dict cookies] ->
    (* Set request cookies for get-cookie primitive.
       Called by Python bridge before each page render. *)
    Hashtbl.clear _request_cookies;
    Hashtbl.iter (fun k v ->
      match v with String s -> Hashtbl.replace _request_cookies k s | _ -> ()
    ) cookies;
    send_ok ()

  | List [Symbol "aser-slot"; String src] ->
    (* Expand ALL components server-side. Uses batch IO mode.
       Calls aser via CEK — the JIT hook compiles it on first call. *)
    (try
      let exprs = Sx_parser.parse_all src in
      let expr = match exprs with
        | [e] -> e
        | [] -> Nil
        | _ -> List (Symbol "<>" :: exprs)
      in
      io_batch_mode := true;
      io_queue := [];
      io_counter := 0;
      let t0 = Unix.gettimeofday () in
      let expand_fn = NativeFn ("expand-components?", fun _args -> Bool true) in
      ignore (env_bind env "expand-components?" expand_fn);
      Printf.eprintf "[aser-slot] starting aser eval...\n%!";
      let result =
        let call = List [Symbol "aser";
                          List [Symbol "quote"; expr];
                          Env env] in
        let r = Sx_ref.eval_expr call (Env env) in
        Printf.eprintf "[aser-slot] aser eval returned\n%!";
        r
      in
      let t1 = Unix.gettimeofday () in
      io_batch_mode := false;
      Hashtbl.remove env.bindings (Sx_types.intern "expand-components?");
      let result_str = match result with
        | String s | SxExpr s -> s
        | _ -> serialize_value result
      in
      let n_batched = List.length !io_queue in
      (* Flush batched IO: send requests, receive responses, replace placeholders *)
      let final = flush_batched_io result_str in
      let t2 = Unix.gettimeofday () in
      Printf.eprintf "[aser-slot] eval=%.1fs io_flush=%.1fs batched=%d result=%d chars\n%!"
        (t1 -. t0) (t2 -. t1) n_batched (String.length final);
      send_ok_raw final
    with
    | Eval_error msg ->
      io_batch_mode := false;
      io_queue := [];
      Hashtbl.remove env.bindings (Sx_types.intern "expand-components?");
      send_error msg
    | exn ->
      io_batch_mode := false;
      io_queue := [];
      Hashtbl.remove env.bindings (Sx_types.intern "expand-components?");
      send_error (Printexc.to_string exn))

  | List (Symbol "sx-page-full-blob" :: shell_kwargs) ->
    (* Like sx-page-full but reads page source as a length-prefixed blob
       from the next line(s), avoiding string-escape round-trip issues. *)
    let page_src = read_blob () in
    dispatch env (List (Symbol "sx-page-full" :: String page_src :: shell_kwargs))

  | List (Symbol "sx-page-full" :: String page_src :: shell_kwargs) ->
    (* Full page render: aser-slot body + render-to-html shell in ONE call.
       shell_kwargs are keyword pairs: :title "..." :csrf "..." etc.
       These are passed directly to ~shared:shell/sx-page-shell. *)
    (try
      (* Phase 1: aser-slot the page body *)
      let exprs = Sx_parser.parse_all page_src in
      let expr = match exprs with
        | [e] -> e | [] -> Nil | _ -> List (Symbol "<>" :: exprs)
      in
      io_batch_mode := true;
      io_queue := [];
      io_counter := 0;
      let t0 = Unix.gettimeofday () in
      let expand_fn = NativeFn ("expand-components?", fun _args -> Bool true) in
      ignore (env_bind env "expand-components?" expand_fn);
      let body_result =
          let call = List [Symbol "aser";
                            List [Symbol "quote"; expr];
                            Env env] in
          Sx_ref.eval_expr call (Env env)
      in
      let t1 = Unix.gettimeofday () in
      io_batch_mode := false;
      Hashtbl.remove env.bindings (Sx_types.intern "expand-components?");
      let body_str = match body_result with
        | String s | SxExpr s -> s
        | _ -> serialize_value body_result
      in
      let body_final = flush_batched_io body_str in
      let t2 = Unix.gettimeofday () in
      (* Phase 1b: render the aser'd SX to HTML for isomorphic SSR.
         The aser output is flat (all components expanded, just HTML tags),
         so render-to-html is cheap — no component lookups needed. *)
      let body_html =
        try
          let body_exprs = Sx_parser.parse_all body_final in
          let body_expr = match body_exprs with
            | [e] -> e | [] -> Nil | _ -> List (Symbol "<>" :: body_exprs)
          in
          sx_render_to_html body_expr env
        with e ->
          Printf.eprintf "[ssr] render-to-html failed: %s\n%!" (Printexc.to_string e);
          ""  (* fallback: client renders from SX source. Islands with
                 reactive state may fail SSR — client hydrates them. *)
      in
      let t2b = Unix.gettimeofday () in
      (* Phase 2: render shell with body + all kwargs.
         Resolve symbol references (e.g. __shell-component-defs) to their
         values from the env — these were pre-injected by the bridge. *)
      let resolved_kwargs = List.map (fun v ->
        match v with
        | Symbol s ->
          (try env_get env s
           with _ -> try Sx_primitives.get_primitive s with _ -> v)
        | _ -> v
      ) shell_kwargs in
      let shell_args = Keyword "page-sx" :: String body_final
                     :: Keyword "body-html" :: String body_html
                     :: resolved_kwargs in
      let shell_call = List (Symbol "~shared:shell/sx-page-shell" :: shell_args) in
      let html = sx_render_to_html shell_call env in
      let t3 = Unix.gettimeofday () in
      Printf.eprintf "[sx-page-full] aser=%.3fs io=%.3fs ssr=%.3fs shell=%.3fs total=%.3fs body=%d ssr=%d html=%d\n%!"
        (t1 -. t0) (t2 -. t1) (t2b -. t2) (t3 -. t2b) (t3 -. t0)
        (String.length body_final) (String.length body_html) (String.length html);
      send_ok_string html
    with
    | Eval_error msg ->
      io_batch_mode := false;
      io_queue := [];
      Hashtbl.remove env.bindings (Sx_types.intern "expand-components?");
      send_error msg
    | exn ->
      io_batch_mode := false;
      io_queue := [];
      Hashtbl.remove env.bindings (Sx_types.intern "expand-components?");
      send_error (Printexc.to_string exn))

  | List [Symbol "render"; String src] ->
    (try
      let exprs = Sx_parser.parse_all src in
      let expr = match exprs with
        | [e] -> e
        | [] -> Nil
        | _ -> List (Symbol "do" :: exprs)
      in
      let html = sx_render_to_html expr env in
      send_ok_string html
    with
    | Eval_error msg -> send_error msg
    | exn -> send_error (Printexc.to_string exn))

  | List [Symbol "vm-exec"; code_val] ->
    (* Execute a bytecode module on the VM.
       code_val is a dict with {bytecode, pool} from compiler.sx *)
    (try
      let code = Sx_vm.code_from_value code_val in
      let globals = env_to_vm_globals env in
      let result = Sx_vm_ref.execute_module code globals in
      send_ok_value result
    with
    | Eval_error msg -> send_error msg
    | exn -> send_error (Printexc.to_string exn))

  | List [Symbol "vm-load-module"; code_val] ->
    (* Execute a compiled module on the VM. The module's defines
       are stored in the kernel env, replacing Lambda values with
       NativeFn VM closures. This is how compiled code gets wired
       into the CEK dispatch — the CEK calls NativeFn directly. *)
    (try
      let code = Sx_vm.code_from_value code_val in
      (* VM uses the LIVE kernel env — defines go directly into it *)
      let globals = env_to_vm_globals env in
      let _result = Sx_vm_ref.execute_module code globals in
      (* Copy defines back into env *)
      Hashtbl.iter (fun k v -> Hashtbl.replace env.bindings (Sx_types.intern k) v) globals;
      send_ok ()
    with
    | Eval_error msg -> send_error msg
    | exn -> send_error (Printexc.to_string exn))

  (* ---- Debugging / introspection commands ---- *)

  | List [Symbol "jit-enable"] ->
    register_jit_hook env;
    send_ok_value (String "jit enabled")

  | List [Symbol "vm-counters"] ->
    let d = Hashtbl.create 8 in
    Hashtbl.replace d "vm_insns" (Number (float_of_int !(Sx_vm._vm_insn_count)));
    Hashtbl.replace d "vm_calls" (Number (float_of_int !(Sx_vm._vm_call_count)));
    Hashtbl.replace d "vm_cek_fallbacks" (Number (float_of_int !(Sx_vm._vm_cek_count)));
    Hashtbl.replace d "comp_jit" (Number (float_of_int !(Sx_vm._vm_comp_jit_count)));
    Hashtbl.replace d "comp_cek" (Number (float_of_int !(Sx_vm._vm_comp_cek_count)));
    Hashtbl.replace d "jit_hit" (Number (float_of_int !(Sx_runtime._jit_hit)));
    Hashtbl.replace d "jit_miss" (Number (float_of_int !(Sx_runtime._jit_miss)));
    Hashtbl.replace d "jit_skip" (Number (float_of_int !(Sx_runtime._jit_skip)));
    send_ok_value (Dict d)

  | List [Symbol "vm-counters-reset"] ->
    Sx_vm.vm_reset_counters ();
    Sx_runtime.jit_reset_counters ();
    send_ok_value (String "reset")

  | List [Symbol "vm-trace"; String src] ->
    (* Compile and trace-execute an SX expression, returning step-by-step
       trace entries with opcode names, stack snapshots, and frame depth. *)
    (try
      let result = Sx_vm.trace_run src (env_to_vm_globals env) in
      send_ok_value result
    with
    | Eval_error msg -> send_error msg
    | exn -> send_error (Printexc.to_string exn))

  | List [Symbol "bytecode-inspect"; String name] ->
    (* Disassemble a named function's compiled bytecode.
       Returns a dict with arity, num_locals, constants, bytecode instructions. *)
    (try
      let v = try Sx_types.env_get env name
        with Not_found -> raise (Eval_error ("bytecode-inspect: not found: " ^ name)) in
      let code = match v with
        | Lambda l ->
          (match l.l_compiled with
           | Some cl when not (Sx_vm.is_jit_failed cl) -> cl.vm_code
           | _ -> raise (Eval_error ("bytecode-inspect: " ^ name ^ " has no compiled bytecode")))
        | VmClosure cl -> cl.vm_code
        | NativeFn _ -> raise (Eval_error ("bytecode-inspect: " ^ name ^ " is a native function"))
        | _ -> raise (Eval_error ("bytecode-inspect: " ^ name ^ " is not a function"))
      in
      send_ok_value (Sx_vm.disassemble code)
    with
    | Eval_error msg -> send_error msg
    | exn -> send_error (Printexc.to_string exn))

  | List [Symbol "deps-check"; String src] ->
    (* Walk parsed AST to find all symbol references and check resolution. *)
    (try
      let exprs = Sx_parser.parse_all src in
      let special_forms = [
        "if"; "when"; "cond"; "case"; "let"; "let*"; "lambda"; "fn";
        "define"; "defcomp"; "defisland"; "defmacro";
        "quote"; "quasiquote"; "begin"; "do"; "set!"; "->"; "and"; "or"
      ] in
      let seen = Hashtbl.create 64 in
      let rec walk = function
        | Symbol s ->
          if not (Hashtbl.mem seen s) then Hashtbl.replace seen s true
        | List items | ListRef { contents = items } ->
          List.iter walk items
        | Dict d -> Hashtbl.iter (fun _ v -> walk v) d
        | _ -> ()
      in
      List.iter walk exprs;
      let resolved = ref [] in
      let unresolved = ref [] in
      Hashtbl.iter (fun name _ ->
        if List.mem name special_forms
           || Sx_types.env_has env name
           || Hashtbl.mem Sx_primitives.primitives name
           || name = "true" || name = "false" || name = "nil"
        then resolved := String name :: !resolved
        else unresolved := String name :: !unresolved
      ) seen;
      let result = Hashtbl.create 2 in
      Hashtbl.replace result "resolved" (List !resolved);
      Hashtbl.replace result "unresolved" (List !unresolved);
      send_ok_value (Dict result)
    with
    | Eval_error msg -> send_error msg
    | exn -> send_error (Printexc.to_string exn))

  | List [Symbol "prim-check"; String name] ->
    (* Scan a compiled function's bytecode for CALL_PRIM opcodes
       and verify each referenced primitive exists. *)
    (try
      let v = try Sx_types.env_get env name
        with Not_found -> raise (Eval_error ("prim-check: not found: " ^ name)) in
      let code = match v with
        | Lambda l ->
          (match l.l_compiled with
           | Some cl when not (Sx_vm.is_jit_failed cl) -> cl.vm_code
           | _ -> raise (Eval_error ("prim-check: " ^ name ^ " has no compiled bytecode")))
        | VmClosure cl -> cl.vm_code
        | _ -> raise (Eval_error ("prim-check: " ^ name ^ " is not a compiled function"))
      in
      let bc = code.vc_bytecode in
      let consts = code.vc_constants in
      let len = Array.length bc in
      let valid = ref [] in
      let invalid = ref [] in
      let ip = ref 0 in
      while !ip < len do
        let op = bc.(!ip) in
        ip := !ip + 1;
        if op = 52 (* OP_CALL_PRIM *) && !ip + 2 < len then begin
          let lo = bc.(!ip) in let hi = bc.(!ip + 1) in
          let idx = lo lor (hi lsl 8) in
          let _argc = bc.(!ip + 2) in
          ip := !ip + 3;
          let prim_name = if idx < Array.length consts
            then (match consts.(idx) with String s -> s | _ -> "?") else "?" in
          if Hashtbl.mem Sx_primitives.primitives prim_name
          then valid := String prim_name :: !valid
          else invalid := String prim_name :: !invalid
        end else begin
          (* Skip operand bytes for other opcodes *)
          let skip = Sx_vm.opcode_operand_size op in
          ip := !ip + skip
        end
      done;
      let result = Hashtbl.create 2 in
      Hashtbl.replace result "valid" (List !valid);
      Hashtbl.replace result "invalid" (List !invalid);
      send_ok_value (Dict result)
    with
    | Eval_error msg -> send_error msg
    | exn -> send_error (Printexc.to_string exn))

  | List [Symbol "reset"] ->
    (* Clear all bindings and rebuild env.
       We can't reassign env, so clear and re-populate. *)
    Hashtbl.clear env.bindings;
    let fresh = make_server_env () in
    Hashtbl.iter (fun k v -> Hashtbl.replace env.bindings k v) fresh.bindings;
    send_ok ()

  | _ ->
    send_error ("Unknown command: " ^ inspect cmd)


(* ====================================================================== *)
(* Main loop                                                               *)
(* ====================================================================== *)

(* ====================================================================== *)
(* CLI mode — one-shot render/aser from stdin                              *)
(* ====================================================================== *)

let cli_load_files env files =
  List.iter (fun path ->
    if Sys.file_exists path then begin
      let exprs = Sx_parser.parse_file path in
      List.iter (fun expr ->
        ignore (Sx_ref.eval_expr expr (Env env))
      ) exprs
    end
  ) files;
  (* Rebind after load in case .sx files shadowed host extension points *)
  rebind_host_extensions env

let cli_mode mode =
  let env = make_server_env () in
  (* Load spec + adapter files for aser modes *)
  let spec_base = try Sys.getenv "SX_SPEC_DIR" with Not_found -> "spec" in
  let lib_base = try Sys.getenv "SX_LIB_DIR" with Not_found -> "lib" in
  let web_base = try Sys.getenv "SX_WEB_DIR" with Not_found -> "web" in
  let render_files = [
    Filename.concat spec_base "parser.sx";
    Filename.concat spec_base "render.sx";
    Filename.concat web_base "adapter-html.sx";
    Filename.concat web_base "adapter-sx.sx";
    Filename.concat web_base "web-forms.sx";
  ] in
  (* Load spec + adapter files for rendering CLI modes *)
  (if mode = "aser" || mode = "aser-slot" || mode = "render" then
    cli_load_files env render_files);
  ignore lib_base; (* available for --load paths *)
  (* Load any files passed via --load *)
  let load_files = ref [] in
  let args = Array.to_list Sys.argv in
  let rec scan = function
    | "--load" :: path :: rest -> load_files := path :: !load_files; scan rest
    | _ :: rest -> scan rest
    | [] -> ()
  in scan args;
  cli_load_files env (List.rev !load_files);
  (* Read SX from stdin *)
  let buf = Buffer.create 4096 in
  (try while true do
    let line = input_line stdin in
    Buffer.add_string buf line;
    Buffer.add_char buf '\n'
  done with End_of_file -> ());
  let src = String.trim (Buffer.contents buf) in
  if src = "" then exit 0;
  (try
    match mode with
    | "render" ->
      let exprs = Sx_parser.parse_all src in
      let expr = match exprs with
        | [e] -> e | [] -> Nil | _ -> List (Symbol "do" :: exprs) in
      let html = sx_render_to_html expr env in
      print_string html; flush stdout
    | "aser" ->
      let exprs = Sx_parser.parse_all src in
      let expr = match exprs with
        | [e] -> e | [] -> Nil | _ -> List (Symbol "<>" :: exprs) in
      let call = List [Symbol "aser";
                        List [Symbol "quote"; expr];
                        Env env] in
      let result = Sx_ref.eval_expr call (Env env) in
      (match result with
       | String s | SxExpr s -> print_string s
       | Dict d when Hashtbl.mem d "__aser_sx" ->
         (match Hashtbl.find d "__aser_sx" with
          | String s | SxExpr s -> print_string s
          | v -> print_string (serialize_value v))
       | _ -> print_string (serialize_value result));
      flush stdout
    | "aser-slot" ->
      ignore (env_bind env "expand-components?" (NativeFn ("expand-components?", fun _args -> Bool true)));
      let exprs = Sx_parser.parse_all src in
      let expr = match exprs with
        | [e] -> e | [] -> Nil | _ -> List (Symbol "<>" :: exprs) in
      let call = List [Symbol "aser";
                        List [Symbol "quote"; expr];
                        Env env] in
      let result = Sx_ref.eval_expr call (Env env) in
      (match result with
       | String s | SxExpr s -> print_string s
       | Dict d when Hashtbl.mem d "__aser_sx" ->
         (match Hashtbl.find d "__aser_sx" with
          | String s | SxExpr s -> print_string s
          | v -> print_string (serialize_value v))
       | _ -> print_string (serialize_value result));
      flush stdout
    | _ ->
      Printf.eprintf "Unknown CLI mode: %s\n" mode; exit 1
  with
  | Eval_error msg ->
    Printf.eprintf "Error: %s\n" msg; exit 1
  | exn ->
    Printf.eprintf "Error: %s\n" (Printexc.to_string exn); exit 1)


let test_mode () =
  let env = make_server_env () in
  (* Load spec + lib + adapter stack *)
  let spec_base = try Sys.getenv "SX_SPEC_DIR" with Not_found -> "spec" in
  let lib_base = try Sys.getenv "SX_LIB_DIR" with Not_found -> "lib" in
  let web_base = try Sys.getenv "SX_WEB_DIR" with Not_found -> "web" in
  let files = [
    Filename.concat spec_base "parser.sx";
    Filename.concat spec_base "render.sx";
    Filename.concat lib_base "compiler.sx";
    Filename.concat spec_base "signals.sx";
    Filename.concat web_base "signals.sx";
    Filename.concat web_base "adapter-html.sx";
    Filename.concat web_base "adapter-sx.sx";
    Filename.concat web_base "web-forms.sx";
  ] in
  cli_load_files env files;
  (* Register JIT *)
  register_jit_hook env;
  (* Load any --load files *)
  let load_files = ref [] in
  let eval_exprs = ref [] in
  let args = Array.to_list Sys.argv in
  let rec scan = function
    | "--load" :: path :: rest -> load_files := path :: !load_files; scan rest
    | "--eval" :: expr :: rest -> eval_exprs := expr :: !eval_exprs; scan rest
    | _ :: rest -> scan rest
    | [] -> ()
  in scan args;
  cli_load_files env (List.rev !load_files);
  if !eval_exprs <> [] then
    List.iter (fun src ->
      try
        let exprs = Sx_parser.parse_all src in
        let result = List.fold_left (fun _ e ->
          Sx_ref.eval_expr e (Env env)) Nil exprs in
        Printf.printf "%s\n%!" (serialize_value result)
      with
      | Eval_error msg -> Printf.eprintf "Error: %s\n%!" msg; exit 1
      | exn -> Printf.eprintf "Error: %s\n%!" (Printexc.to_string exn); exit 1
    ) (List.rev !eval_exprs)
  else begin
    (* Read from stdin *)
    let buf = Buffer.create 4096 in
    (try while true do
      let line = input_line stdin in
      Buffer.add_string buf line; Buffer.add_char buf '\n'
    done with End_of_file -> ());
    let src = String.trim (Buffer.contents buf) in
    if src <> "" then begin
      try
        let exprs = Sx_parser.parse_all src in
        let result = List.fold_left (fun _ e ->
          Sx_ref.eval_expr e (Env env)) Nil exprs in
        Printf.printf "%s\n%!" (serialize_value result)
      with
      | Eval_error msg -> Printf.eprintf "Error: %s\n%!" msg; exit 1
      | exn -> Printf.eprintf "Error: %s\n%!" (Printexc.to_string exn); exit 1
    end
  end

(* ====================================================================== *)
(* HTTP server mode (--http PORT)                                          *)
(* ====================================================================== *)

let http_response ?(status=200) ?(content_type="text/html; charset=utf-8") body =
  let status_text = match status with
    | 200 -> "OK" | 301 -> "Moved Permanently" | 304 -> "Not Modified"
    | 404 -> "Not Found" | 405 -> "Method Not Allowed"
    | 500 -> "Internal Server Error" | _ -> "Unknown"
  in
  Printf.sprintf "HTTP/1.1 %d %s\r\nContent-Type: %s\r\nContent-Length: %d\r\nConnection: keep-alive\r\n\r\n%s"
    status status_text content_type (String.length body) body

let http_redirect url =
  Printf.sprintf "HTTP/1.1 301 Moved Permanently\r\nLocation: %s\r\nContent-Length: 0\r\nConnection: keep-alive\r\n\r\n" url

(* Chunked transfer encoding helpers for streaming responses *)
let http_chunked_header ?(status=200) ?(content_type="text/html; charset=utf-8") () =
  let status_text = match status with
    | 200 -> "OK" | 404 -> "Not Found" | 500 -> "Internal Server Error" | _ -> "Unknown" in
  Printf.sprintf "HTTP/1.1 %d %s\r\nContent-Type: %s\r\nTransfer-Encoding: chunked\r\nConnection: keep-alive\r\nX-Accel-Buffering: no\r\nCache-Control: no-cache, no-transform\r\n\r\n"
    status status_text content_type

let write_chunk fd data =
  if String.length data > 0 then begin
    let chunk = Printf.sprintf "%x\r\n%s\r\n" (String.length data) data in
    let bytes = Bytes.of_string chunk in
    let total = Bytes.length bytes in
    let written = ref 0 in
    try
      while !written < total do
        let n = Unix.write fd bytes !written (total - !written) in
        written := !written + n
      done;
      true
    with Unix.Unix_error _ -> false
  end else true

let end_chunked fd =
  (try ignore (Unix.write_substring fd "0\r\n\r\n" 0 5) with Unix.Unix_error _ -> ());
  (try Unix.close fd with _ -> ())

let parse_http_request data =
  match String.index_opt data '\r' with
  | None -> (match String.index_opt data '\n' with
    | None -> None
    | Some i -> let line = String.sub data 0 i in
      (match String.split_on_char ' ' line with
       | m :: p :: _ -> Some (m, p) | _ -> None))
  | Some i -> let line = String.sub data 0 i in
    (match String.split_on_char ' ' line with
     | m :: p :: _ -> Some (m, p) | _ -> None)

let url_decode s =
  let buf = Buffer.create (String.length s) in
  let i = ref 0 in
  while !i < String.length s do
    if s.[!i] = '%' && !i + 2 < String.length s then begin
      (try
        let hex = String.sub s (!i + 1) 2 in
        Buffer.add_char buf (Char.chr (int_of_string ("0x" ^ hex)))
      with _ -> Buffer.add_char buf s.[!i]);
      i := !i + 3
    end else if s.[!i] = '+' then begin
      Buffer.add_char buf ' ';
      i := !i + 1
    end else begin
      Buffer.add_char buf s.[!i];
      i := !i + 1
    end
  done;
  Buffer.contents buf

let parse_http_headers data =
  let lines = String.split_on_char '\n' data in
  let headers = ref [] in
  List.iter (fun line ->
    let line = if String.length line > 0 && line.[String.length line - 1] = '\r'
      then String.sub line 0 (String.length line - 1) else line in
    match String.index_opt line ':' with
    | Some i when i > 0 ->
      let key = String.trim (String.sub line 0 i) in
      let value = String.trim (String.sub line (i + 1) (String.length line - i - 1)) in
      headers := (key, value) :: !headers
    | _ -> ()
  ) (match lines with _ :: rest -> rest | [] -> []);
  !headers

(* IO-aware eval for rendering — handles perform (text-measure, sleep, import).
   Used by aser and SSR so components can call measure-text via perform. *)
let eval_with_io_render expr env =
  let state = ref (Sx_ref.cek_step_loop (Sx_ref.make_cek_state expr (Env env) Nil)) in
  while sx_truthy (Sx_ref.cek_suspended_p !state) do
    let request = Sx_ref.cek_io_request !state in
    let op = match request with
      | Dict d -> (match Hashtbl.find_opt d "op" with Some (String s) -> s | Some (Symbol s) -> s | _ -> "")
      | _ -> "" in
    let args = match request with
      | Dict d -> (match Hashtbl.find_opt d "args" with Some v -> v | None -> Nil)
      | _ -> Nil in
    let result = match op with
      | "text-measure" ->
        let font = match args with
          | List (String f :: _) -> f | _ -> "serif" in
        let size = match args with
          | List [_font; Number sz; _text] -> sz
          | List [_font; Number sz] -> sz
          | _ -> 16.0 in
        let text = match args with
          | List [_font; _sz; String t] -> t
          | _ -> "" in
        let (w, h, asc, desc) = measure_text_otfm font size text in
        let d = Hashtbl.create 4 in
        Hashtbl.replace d "width" (Number w);
        Hashtbl.replace d "height" (Number h);
        Hashtbl.replace d "ascent" (Number asc);
        Hashtbl.replace d "descent" (Number desc);
        Dict d
      | "io-sleep" | "sleep" ->
        let ms = match args with
          | List (Number n :: _) -> n | Number n -> n | _ -> 0.0 in
        Unix.sleepf (ms /. 1000.0); Nil
      | "import" -> Nil
      | _ -> Nil
    in
    state := Sx_ref.cek_step_loop (Sx_ref.cek_resume !state result)
  done;
  if sx_truthy (Sx_ref.cek_terminal_p !state) then Sx_ref.cek_value !state
  else Nil

(** Render a page. Routing + AJAX detection in SX (request-handler.sx),
    render pipeline (aser → SSR → shell) in OCaml for reliable env access. *)
let http_render_page env path headers =
  let t0 = Unix.gettimeofday () in
  (* Phase 0: Route via SX handler — returns {:is-ajax :nav-path :page-ast} *)
  let handler = try env_get env "sx-handle-request" with _ -> Nil in
  if handler = Nil then (Printf.eprintf "[http] sx-handle-request not found\n%!"; None)
  else
    let headers_dict = Hashtbl.create 8 in
    List.iter (fun (k, v) ->
      Hashtbl.replace headers_dict (String.lowercase_ascii k) (String v)
    ) headers;
    let route_result =
      try Sx_ref.cek_call handler
            (List [String path; Dict headers_dict; Env env; Nil])
      with e ->
        Printf.eprintf "[http] route error for %s: %s\n%!" path (Printexc.to_string e);
        Nil
    in
    (* Build an error page AST that keeps the layout intact *)
    let error_page_ast msg =
      List [Symbol "div"; Keyword "class"; String "p-8 max-w-2xl mx-auto";
        List [Symbol "h2"; Keyword "class"; String "text-xl font-semibold text-rose-600 mb-4";
          String "Page Error"];
        List [Symbol "p"; Keyword "class"; String "text-stone-600 mb-2"; String path];
        List [Symbol "pre"; Keyword "class"; String "text-sm bg-stone-100 p-4 rounded overflow-x-auto text-stone-700";
          String msg]]
    in
    (* Normalize route result — Nil and non-Dict become error pages *)
    let is_ajax_req = List.exists (fun (k,_) -> String.lowercase_ascii k = "sx-request") headers in
    let route_dict = match route_result with
      | Dict d -> d
      | _ ->
        let d = Hashtbl.create 4 in
        Hashtbl.replace d "is-ajax" (Bool is_ajax_req);
        Hashtbl.replace d "nav-path" (String path);
        Hashtbl.replace d "page-ast" (error_page_ast "Page not found");
        d
    in
    let d = route_dict in
    let is_ajax = match Hashtbl.find_opt d "is-ajax" with Some (Bool true) -> true | _ -> false in
    let nav_path = match Hashtbl.find_opt d "nav-path" with Some (String s) -> s | _ -> path in
    let page_ast = match Hashtbl.find_opt d "page-ast" with Some v -> v | _ -> Nil in
    let page_ast = if page_ast = Nil then error_page_ast "Page returned empty content" else page_ast in
      begin
        let inner_layout = get_app_str "inner-layout" "~layouts/doc" in
        let wrapped = List [Symbol inner_layout; Keyword "path"; String nav_path; page_ast] in
        if is_ajax then begin
          (* AJAX: return SX wire format (aser output) with text/sx content type.
             Expand server-side components so the browser doesn't need their definitions.
             Islands stay as (~ ...) calls — the browser hydrates those. *)
          ignore (env_bind env "expand-components?" (NativeFn ("expand-components?", fun _args -> Bool true)));
          let body_result =
            let call = List [Symbol "aser"; List [Symbol "quote"; wrapped]; Env env] in
            eval_with_io_render call env in
          Hashtbl.remove env.bindings (Sx_types.intern "expand-components?");
          let body_str = match body_result with
            | String s | SxExpr s -> s | _ -> serialize_value body_result in
          let t1 = Unix.gettimeofday () in
          Printf.eprintf "[sx-http] %s (SX) aser=%.3fs body=%d\n%!" path (t1 -. t0) (String.length body_str);
          Some body_str
        end else begin
          (* Full page: aser → SSR → shell *)
          let outer_layout = get_app_str "outer-layout" "~shared:layout/app-body" in
          let full_ast = List [Symbol outer_layout; Keyword "content"; wrapped] in
          let page_source = serialize_value full_ast in
          let t1 = Unix.gettimeofday () in
          let body_result =
            let call = List [Symbol "aser"; List [Symbol "quote"; full_ast]; Env env] in
            eval_with_io_render call env in
          let body_str = match body_result with
            | String s | SxExpr s -> s | _ -> serialize_value body_result in
          let t2 = Unix.gettimeofday () in
          let body_html = try
            let body_expr = match Sx_parser.parse_all body_str with
              | [e] -> e | [] -> Nil | es -> List (Symbol "<>" :: es) in
            if env_has env "render-to-html" then
              let render_call = List [Symbol "render-to-html";
                                      List [Symbol "quote"; body_expr]; Env env] in
              (match eval_with_io_render render_call env with
               | String s | RawHTML s -> s | v -> Sx_runtime.value_to_str v)
            else Sx_render.sx_render_to_html env body_expr env
          with e -> Printf.eprintf "[http-ssr] failed for %s: %s\n%!" path (Printexc.to_string e); "" in
          let t3 = Unix.gettimeofday () in
          let get_shell name = try env_get env ("__shell-" ^ name) with _ -> Nil in
          let shell_args = [
            Keyword "title"; String (get_app_str "title" "SX"); Keyword "csrf"; String "";
            Keyword "page-sx"; String page_source;
            Keyword "body-html"; String body_html;
            Keyword "component-defs"; get_shell "component-defs";
            Keyword "component-hash"; get_shell "component-hash";
            Keyword "component-manifest"; get_shell "component-manifest";
            Keyword "pages-sx"; get_shell "pages-sx";
            Keyword "sx-css"; get_shell "sx-css";
            Keyword "asset-url"; get_shell "asset-url";
            Keyword "wasm-hash"; get_shell "wasm-hash";
            Keyword "platform-hash"; get_shell "platform-hash";
            Keyword "sxbc-hash"; get_shell "sxbc-hash";
            Keyword "inline-css"; get_shell "inline-css";
            Keyword "inline-head-js"; get_shell "inline-head-js";
            Keyword "init-sx"; get_shell "init-sx";
            Keyword "meta-html"; String "";
          ] in
          let shell_sym = get_app_str "shell" "~shared:shell/sx-page-shell" in
          let shell_call = List (Symbol shell_sym :: shell_args) in
          let html =
            if env_has env "render-to-html" then
              let render_call = List [Symbol "render-to-html";
                                      List [Symbol "quote"; shell_call]; Env env] in
              (match Sx_ref.eval_expr render_call (Env env) with
               | String s | RawHTML s -> s | v -> Sx_runtime.value_to_str v)
            else Sx_render.sx_render_to_html env shell_call env in
          let t4 = Unix.gettimeofday () in
          Printf.eprintf "[sx-http] %s route=%.3fs aser=%.3fs ssr=%.3fs shell=%.3fs total=%.3fs html=%d\n%!"
            path (t1 -. t0) (t2 -. t1) (t3 -. t2) (t4 -. t3) (t4 -. t0) (String.length html);
          Some html
        end
      end

(* JSON-encode a string for use in __sxResolve script tags *)
let json_encode_string s =
  let buf = Buffer.create (String.length s + 16) in
  Buffer.add_char buf '"';
  String.iter (fun c -> match c with
    | '"' -> Buffer.add_string buf "\\\""
    | '\\' -> Buffer.add_string buf "\\\\"
    | '\n' -> Buffer.add_string buf "\\n"
    | '\r' -> Buffer.add_string buf "\\r"
    | '\t' -> Buffer.add_string buf "\\t"
    | c when Char.code c < 0x20 ->
      Buffer.add_string buf (Printf.sprintf "\\u%04x" (Char.code c))
    | c -> Buffer.add_char buf c
  ) s;
  Buffer.add_char buf '"';
  Buffer.contents buf

(* Bootstrap script that queues resolves arriving before sx.js loads.
   Must match _SX_STREAMING_BOOTSTRAP in shared/sx/helpers.py *)
let _sx_streaming_bootstrap =
  "<script>window.__sxPending=[];window.__sxResolve=function(i,s){\
   if(window.Sx&&Sx.resolveSuspense){Sx.resolveSuspense(i,s)}\
   else{window.__sxPending.push({id:i,sx:s})}}</script>"

(* Build a resolve script tag. Must match _SX_STREAMING_RESOLVE in helpers.py *)
let sx_streaming_resolve_script id sx_source =
  Printf.sprintf "<script>window.__sxResolve&&window.__sxResolve(%s,%s)</script>"
    (json_encode_string id) (json_encode_string sx_source)

(* ====================================================================== *)
(* IO-resolving evaluator for streaming render                             *)
(* ====================================================================== *)

(* Evaluate an expression with IO suspension handling.
   Steps the CEK machine; when it suspends on an IO request, resolves
   the request locally and resumes. Supports: io-sleep, import, helper. *)
let eval_with_io expr env =
  let state = ref (Sx_ref.cek_step_loop (Sx_ref.make_cek_state expr (Env env) Nil)) in
  while sx_truthy (Sx_ref.cek_suspended_p !state) do
    let request = Sx_ref.cek_io_request !state in
    let op = match request with
      | Dict d -> (match Hashtbl.find_opt d "op" with Some (String s) -> s | Some (Symbol s) -> s | _ -> "")
      | _ -> "" in
    let args = match request with
      | Dict d -> (match Hashtbl.find_opt d "args" with Some v -> v | None -> Nil)
      | _ -> Nil in
    let result = match op with
      | "io-sleep" | "sleep" ->
        let ms = match args with
          | List (Number n :: _) -> n
          | Number n -> n
          | _ -> 0.0 in
        Unix.sleepf (ms /. 1000.0);
        Nil
      | "import" ->
        (* Library import — delegate to existing import hook *)
        (try
          let lib_name = match request with
            | Dict d -> (match Hashtbl.find_opt d "library" with Some v -> v | _ -> args)
            | _ -> args in
          ignore lib_name; (* import handled by _import_hook if registered *)
          Nil
        with _ -> Nil)
      | "text-measure" ->
        let font = match args with
          | List (String f :: _) -> f | _ -> "serif" in
        let size = match args with
          | List [_font; Number sz; _text] -> sz
          | List [_font; Number sz] -> sz
          | _ -> 16.0 in
        let text = match args with
          | List [_font; _sz; String t] -> t
          | _ -> "" in
        let (w, h, asc, desc) = measure_text_otfm font size text in
        let d = Hashtbl.create 4 in
        Hashtbl.replace d "width" (Number w);
        Hashtbl.replace d "height" (Number h);
        Hashtbl.replace d "ascent" (Number asc);
        Hashtbl.replace d "descent" (Number desc);
        Dict d
      | _ ->
        Printf.eprintf "[io] unhandled IO op: %s\n%!" op;
        Nil
    in
    state := Sx_ref.cek_step_loop (Sx_ref.cek_resume !state result)
  done;
  if sx_truthy (Sx_ref.cek_terminal_p !state) then Sx_ref.cek_value !state
  else Nil

(* ====================================================================== *)
(* Streaming page render — shell-first with chunked transfer encoding      *)
(* ====================================================================== *)

let http_render_page_streaming env path _headers fd page_name =
  (* No send timeout for streaming — the alive check in write_chunk handles
     broken pipe. Streaming clients may be slow to receive large shell chunks
     while busy parsing/downloading other resources. *)
  (try Unix.setsockopt_float fd Unix.SO_SNDTIMEO 30.0 with _ -> ());
  let t0 = Unix.gettimeofday () in
  let page_def = try
    match env_get env ("page:" ^ page_name) with Dict d -> d | _ -> raise Not_found
  with _ ->
    Printf.eprintf "[sx-stream] page def not found: page:%s\n%!" page_name;
    let err = http_response ~status:500 "<h1>Streaming page def not found</h1>" in
    let bytes = Bytes.of_string err in
    (try ignore (Unix.write fd bytes 0 (Bytes.length bytes)) with _ -> ());
    (try Unix.close fd with _ -> ());
    raise Exit
  in

  (* Extract streaming fields from page def *)
  let shell_ast = match Hashtbl.find_opt page_def "shell" with Some v -> v | None -> Nil in
  let data_ast = match Hashtbl.find_opt page_def "data" with Some v -> v | None -> Nil in
  let content_ast = match Hashtbl.find_opt page_def "content" with Some v -> v | None -> Nil in

  (* Phase 1: Evaluate shell AST — contains ~suspense placeholders with fallbacks.
     The :shell expression already includes the inner layout (e.g. ~layouts/doc),
     so we only wrap in the outer layout (~shared:layout/app-body) for gutters.
     NO inner layout wrapping — shell_ast already has it. *)
  let shell_html = try
    let outer_layout = get_app_str "outer-layout" "~shared:layout/app-body" in
    let full_ast = List [Symbol outer_layout; Keyword "content"; shell_ast] in
    let page_source = serialize_value full_ast in
    (* aser → SSR *)
    let body_result =
      let call = List [Symbol "aser"; List [Symbol "quote"; full_ast]; Env env] in
      Sx_ref.eval_expr call (Env env) in
    let body_str = match body_result with
      | String s | SxExpr s -> s | _ -> serialize_value body_result in
    let body_html = try
      let body_expr = match Sx_parser.parse_all body_str with
        | [e] -> e | [] -> Nil | es -> List (Symbol "<>" :: es) in
      if env_has env "render-to-html" then
        let render_call = List [Symbol "render-to-html";
                                List [Symbol "quote"; body_expr]; Env env] in
        (match Sx_ref.eval_expr render_call (Env env) with
         | String s | RawHTML s -> s | v -> Sx_runtime.value_to_str v)
      else Sx_render.sx_render_to_html env body_expr env
    with e -> Printf.eprintf "[sx-stream] SSR failed: %s\n%!" (Printexc.to_string e); "" in

    (* Build full page shell with body HTML *)
    let get_shell name = try env_get env ("__shell-" ^ name) with _ -> Nil in
    let shell_args = [
      Keyword "title"; String (get_app_str "title" "SX"); Keyword "csrf"; String "";
      Keyword "page-sx"; String page_source;
      Keyword "body-html"; String body_html;
      Keyword "component-defs"; get_shell "component-defs";
      Keyword "component-hash"; get_shell "component-hash";
      Keyword "component-manifest"; get_shell "component-manifest";
      Keyword "client-libs"; get_shell "client-libs";
      Keyword "pages-sx"; get_shell "pages-sx";
      Keyword "sx-css"; get_shell "sx-css";
      Keyword "asset-url"; get_shell "asset-url";
      Keyword "wasm-hash"; get_shell "wasm-hash";
      Keyword "platform-hash"; get_shell "platform-hash";
      Keyword "sxbc-hash"; get_shell "sxbc-hash";
      Keyword "inline-css"; get_shell "inline-css";
      Keyword "inline-head-js"; get_shell "inline-head-js";
      Keyword "init-sx"; get_shell "init-sx";
      Keyword "meta-html"; String "";
    ] in
    let shell_sym = get_app_str "shell" "~shared:shell/sx-page-shell" in
    let shell_call = List (Symbol shell_sym :: shell_args) in
    if env_has env "render-to-html" then
      let render_call = List [Symbol "render-to-html";
                              List [Symbol "quote"; shell_call]; Env env] in
      (match Sx_ref.eval_expr render_call (Env env) with
       | String s | RawHTML s -> s | v -> Sx_runtime.value_to_str v)
    else Sx_render.sx_render_to_html env shell_call env
  with e ->
    Printf.eprintf "[sx-stream] shell render failed: %s\n%!" (Printexc.to_string e);
    "<html><body><h1>Streaming shell render failed</h1></body></html>"
  in
  let t1 = Unix.gettimeofday () in

  (* Phase 2: Send chunked header + shell HTML.
     Strip closing </body></html> from shell — resolve scripts must go INSIDE
     the body, otherwise the browser's HTML parser ignores them. *)
  let shell_body, shell_tail =
    (* Find last </body> and split there *)
    let s = shell_html in
    let body_close = "</body>" in
    let rec find_last i found =
      if i < 0 then found
      else if i + String.length body_close <= String.length s
              && String.sub s i (String.length body_close) = body_close
      then find_last (i - 1) i
      else find_last (i - 1) found
    in
    let pos = find_last (String.length s - String.length body_close) (-1) in
    if pos >= 0 then
      (String.sub s 0 pos, String.sub s pos (String.length s - pos))
    else
      (s, "")
  in
  let header = http_chunked_header () in
  let header_bytes = Bytes.of_string header in
  (try ignore (Unix.write fd header_bytes 0 (Bytes.length header_bytes)) with _ -> ());
  let alive = ref true in
  alive := write_chunk fd shell_body;
  (* Bootstrap resolve script — must come after shell so suspense elements exist *)
  if !alive then alive := write_chunk fd _sx_streaming_bootstrap;
  let t2 = Unix.gettimeofday () in

  (* Phase 3: Evaluate :data, render :content, flush resolve scripts.
     Uses eval_with_io so :data expressions can perform IO (e.g. sleep, fetch).
     Each data item is resolved independently — IO in one item doesn't block others
     from being flushed as they complete. Bails out early on broken pipe. *)
  let resolve_count = ref 0 in
  if !alive && data_ast <> Nil && content_ast <> Nil then begin
    (try
      let data_result = eval_with_io data_ast env in
      let t3_data = Unix.gettimeofday () in

      (* Determine single-stream vs multi-stream *)
      let data_items =
        let extract_items items = List.map (fun item ->
          let stream_id = match item with
            | Dict d -> (match Hashtbl.find_opt d "stream-id" with
              | Some (String s) -> s | _ -> "stream-content")
            | _ -> "stream-content" in
          (item, stream_id)) items in
        match data_result with
        | Dict _ -> [(data_result, "stream-content")]
        | List items -> extract_items items
        | ListRef { contents = items } -> extract_items items
        | _ ->
          Printf.eprintf "[sx-stream] :data returned %s, expected dict or list\n%!"
            (Sx_runtime.type_of data_result |> Sx_runtime.value_to_str);
          []
      in

      (* For each data item, bind values and render :content.
         If the item has a "delay" field, perform IO sleep before resolving.
         Each item flushes its resolve script independently — the client sees
         content appear progressively as each IO completes. *)
      List.iter (fun (item, stream_id) ->
        if !alive then
        (try
          (* IO sleep if delay specified — demonstrates async streaming *)
          (match item with
           | Dict d -> (match Hashtbl.find_opt d "delay" with
             | Some (Number ms) when ms > 0.0 ->
               Printf.eprintf "[sx-stream] %s: sleeping %.0fms for IO...\n%!" stream_id ms;
               Unix.sleepf (ms /. 1000.0)
             | _ -> ())
           | _ -> ());
          (* Create fresh env with data bindings *)
          let content_env = { bindings = Hashtbl.create 16; parent = Some env } in
          (match item with
           | Dict d ->
             Hashtbl.iter (fun k v ->
               if k <> "stream-id" && k <> "__type" && k <> "delay" then begin
                 (* Normalize: underscores → hyphens *)
                 let norm_k = String.map (fun c -> if c = '_' then '-' else c) k in
                 ignore (env_bind content_env norm_k v);
                 if norm_k <> k then ignore (env_bind content_env k v)
               end
             ) d
           | _ -> ());

          (* aser :content in the data-bound env — also with IO resolution *)
          let content_result =
            let call = List [Symbol "aser"; List [Symbol "quote"; content_ast]; Env content_env] in
            eval_with_io call content_env in
          let sx_source = match content_result with
            | String s | SxExpr s -> s | _ -> serialize_value content_result in
          let resolve_script = sx_streaming_resolve_script stream_id sx_source in
          alive := write_chunk fd resolve_script;
          incr resolve_count
        with e ->
          (* Error boundary: emit error fallback for this slot *)
          let msg = Printexc.to_string e in
          Printf.eprintf "[sx-stream] resolve error for %s: %s\n%!" stream_id msg;
          let error_sx = Printf.sprintf "(div :class \"text-rose-600 p-4 text-sm\" \"Error: %s\")"
            (String.map (fun c -> if c = '"' then '\'' else c) msg) in
          alive := write_chunk fd (sx_streaming_resolve_script stream_id error_sx);
          incr resolve_count)
      ) data_items;
      let t3 = Unix.gettimeofday () in
      Printf.eprintf "[sx-stream] %s shell=%.3fs flush=%.3fs data=%.3fs resolve=%.3fs total=%.3fs chunks=%d\n%!"
        path (t1 -. t0) (t2 -. t1) (t3_data -. t2) (t3 -. t3_data) (t3 -. t0) !resolve_count
    with e ->
      Printf.eprintf "[sx-stream] data eval failed: %s\n%!" (Printexc.to_string e))
  end else
    Printf.eprintf "[sx-stream] %s shell=%.3fs (no :data/:content)\n%!" path (t1 -. t0);

  (* Phase 4: Send closing tags + end chunked response *)
  if !alive && shell_tail <> "" then ignore (write_chunk fd shell_tail);
  end_chunked fd

(* ====================================================================== *)
(* Static file serving + file hashing                                      *)
(* ====================================================================== *)

let mime_type_of path =
  if Filename.check_suffix path ".css" then "text/css; charset=utf-8"
  else if Filename.check_suffix path ".js" then "application/javascript; charset=utf-8"
  else if Filename.check_suffix path ".wasm" then "application/wasm"
  else if Filename.check_suffix path ".json" then "application/json"
  else if Filename.check_suffix path ".svg" then "image/svg+xml"
  else if Filename.check_suffix path ".png" then "image/png"
  else if Filename.check_suffix path ".jpg" || Filename.check_suffix path ".jpeg" then "image/jpeg"
  else if Filename.check_suffix path ".ico" then "image/x-icon"
  else if Filename.check_suffix path ".map" then "application/json"
  else if Filename.check_suffix path ".woff2" then "font/woff2"
  else if Filename.check_suffix path ".woff" then "font/woff"
  else if Filename.check_suffix path ".sx" then "text/sx; charset=utf-8"
  else if Filename.check_suffix path ".sxbc" then "text/sx; charset=utf-8"
  else "application/octet-stream"

let static_cache : (string, string) Hashtbl.t = Hashtbl.create 256

let serve_static_file static_dir url_path =
  match Hashtbl.find_opt static_cache url_path with
  | Some cached -> cached
  | None ->
    let rel = String.sub url_path 8 (String.length url_path - 8) in
    let rel = match String.index_opt rel '?' with
      | Some i -> String.sub rel 0 i | None -> rel in
    let has_substring s sub =
      let slen = String.length s and sublen = String.length sub in
      if sublen > slen then false
      else let rec check i = if i > slen - sublen then false
        else if String.sub s i sublen = sub then true else check (i + 1)
      in check 0
    in
    if String.contains rel '\x00' || (String.length rel > 1 && String.sub rel 0 2 = "..")
       (* Block source maps but allow .wasm files from assets *)
       || Filename.check_suffix rel ".map"
       || (has_substring rel ".assets/" && not (Filename.check_suffix rel ".wasm")) then
      http_response ~status:403 "Forbidden"
    else
      let file_path = static_dir ^ "/" ^ rel in
      if Sys.file_exists file_path && not (Sys.is_directory file_path) then begin
        let content_type = mime_type_of file_path in
        let body = In_channel.with_open_bin file_path In_channel.input_all in
        let resp = Printf.sprintf
          "HTTP/1.1 200 OK\r\nContent-Type: %s\r\nContent-Length: %d\r\nCache-Control: public, max-age=31536000, immutable\r\nConnection: keep-alive\r\n\r\n%s"
          content_type (String.length body) body in
        Hashtbl.replace static_cache url_path resp;
        resp
      end else
        http_response ~status:404 "Not Found"

let file_hash path =
  if Sys.file_exists path then
    String.sub (Digest.string (In_channel.with_open_bin path In_channel.input_all) |> Digest.to_hex) 0 12
  else ""

let sxbc_combined_hash dir =
  let sxbc_dir = dir ^ "/sx" in
  if Sys.file_exists sxbc_dir && Sys.is_directory sxbc_dir then begin
    let files = Array.to_list (Sys.readdir sxbc_dir) in
    let sxbc_files = List.filter (fun f -> Filename.check_suffix f ".sxbc") files in
    let sorted = List.sort String.compare sxbc_files in
    let buf = Buffer.create 65536 in
    List.iter (fun f ->
      let path = sxbc_dir ^ "/" ^ f in
      Buffer.add_string buf (In_channel.with_open_bin path In_channel.input_all)
    ) sorted;
    String.sub (Digest.string (Buffer.contents buf) |> Digest.to_hex) 0 12
  end else ""

let read_css_file path =
  if Sys.file_exists path then
    In_channel.with_open_text path In_channel.input_all
  else ""

(* ── Content-addressed hash index ────────────────────────────────
   Merkle DAG over all definitions in env.bindings.
   Each definition gets a SHA-256 hash of its *instantiated* form
   (component references replaced with their hashes). *)

type hash_index = {
  name_to_hash : (string, string) Hashtbl.t;   (** "~card" → "a1b2c3..." *)
  hash_to_def  : (string, string) Hashtbl.t;   (** hash → instantiated definition text *)
  hash_to_name : (string, string) Hashtbl.t;   (** hash → "~card" *)
  dependents   : (string, string list) Hashtbl.t; (** "~card" → ["~my-page", ...] *)
} [@@warning "-69"]

let _hash_index : hash_index option ref = ref None

(** Canonical form for hashing — name excluded (it's the key, not content).
    Includes params, affinity, has_children, and body with refs hashed. *)
let canonical_form_component (index : (string, string) Hashtbl.t) c =
  let ps = String.concat " " (
    "&key" :: c.c_params @
    (if c.c_has_children then ["&rest"; "children"] else [])) in
  Printf.sprintf "(defcomp (%s) :affinity \"%s\" %s)"
    ps c.c_affinity (serialize_value_hashed index c.c_body)

let canonical_form_island (index : (string, string) Hashtbl.t) i =
  let ps = String.concat " " (
    "&key" :: i.i_params @
    (if i.i_has_children then ["&rest"; "children"] else [])) in
  Printf.sprintf "(defisland (%s) %s)"
    ps (serialize_value_hashed index i.i_body)

let canonical_form_macro (index : (string, string) Hashtbl.t) m =
  let ps = String.concat " " (
    m.m_params @
    (match m.m_rest_param with Some r -> ["&rest"; r] | None -> [])) in
  Printf.sprintf "(defmacro (%s) %s)"
    ps (serialize_value_hashed index m.m_body)


(** Compute truncated SHA-256 hash (16 hex chars = 64 bits). *)
let hash_string s =
  String.sub (Digest.string s |> Digest.to_hex) 0 16

(** Build the Merkle hash index from env.bindings.
    Topological sort: hash leaves first (no ~deps), propagate up. *)
let build_hash_index env =
  let name_to_hash = Hashtbl.create 256 in
  let hash_to_def = Hashtbl.create 256 in
  let hash_to_name = Hashtbl.create 256 in
  let dependents = Hashtbl.create 256 in

  (* Phase 0: hash client library source files as whole units.
     Each file gets one hash. All (define name ...) forms in the file
     map to that hash so any symbol triggers loading the whole file. *)
  let project_dir = try Sys.getenv "SX_PROJECT_DIR" with Not_found -> "." in
  let templates_dir = project_dir ^ "/shared/sx/templates" in
  let client_lib_names = get_app_list "client-libs" ["tw-layout.sx"; "tw-type.sx"; "tw.sx"] in
  List.iter (fun lib_name ->
    let path = templates_dir ^ "/" ^ lib_name in
    if Sys.file_exists path then begin
      let src = In_channel.with_open_text path In_channel.input_all in
      let h = hash_string src in
      Hashtbl.replace hash_to_def h src;
      (* Extract all (define name ...) forms and map each name to this hash *)
      let exprs = try Sx_parser.parse_all src with _ -> [] in
      let first_name = ref "" in
      List.iter (fun expr ->
        match expr with
        | List (Symbol "define" :: Symbol name :: _) ->
          Hashtbl.replace name_to_hash name h;
          if !first_name = "" then first_name := name
        | _ -> ()
      ) exprs;
      (* Map the hash to the first define name for debuggability *)
      if !first_name <> "" then
        Hashtbl.replace hash_to_name h !first_name
    end
  ) client_lib_names;

  (* Phase 1: collect all component/island/macro definitions and their direct deps *)
  let defs : (string * [ `Comp of component | `Island of island
                        | `Macro of macro ]) list ref = ref [] in
  let deps : (string, string list) Hashtbl.t = Hashtbl.create 256 in

  Hashtbl.iter (fun sym v ->
    let name = Sx_types.unintern sym in
    match v with
    | Component c when String.length name > 0 && name.[0] = '~' ->
      let refs = collect_tilde_refs c.c_body in
      defs := (name, `Comp c) :: !defs;
      Hashtbl.replace deps name refs;
      (* Register reverse deps *)
      List.iter (fun dep ->
        let prev = try Hashtbl.find dependents dep with Not_found -> [] in
        Hashtbl.replace dependents dep (name :: prev)
      ) refs
    | Island i when String.length name > 0 && name.[0] = '~' ->
      let refs = collect_tilde_refs i.i_body in
      defs := (name, `Island i) :: !defs;
      Hashtbl.replace deps name refs;
      List.iter (fun dep ->
        let prev = try Hashtbl.find dependents dep with Not_found -> [] in
        Hashtbl.replace dependents dep (name :: prev)
      ) refs
    | Macro m when (match m.m_name with Some n -> String.length n > 0 | None -> false) ->
      let refs = collect_tilde_refs m.m_body in
      let mname = match m.m_name with Some n -> n | None -> name in
      defs := (mname, `Macro m) :: !defs;
      Hashtbl.replace deps mname refs;
      List.iter (fun dep ->
        let prev = try Hashtbl.find dependents dep with Not_found -> [] in
        Hashtbl.replace dependents dep (mname :: prev)
      ) refs
    | _ -> ()
  ) env.bindings;

  (* Phase 2: Kahn's topological sort *)
  let all_names = Hashtbl.create 256 in
  List.iter (fun (name, _) -> Hashtbl.replace all_names name true) !defs;
  (* In-degree: count how many of this def's deps are also in our set *)
  let in_degree = Hashtbl.create 256 in
  List.iter (fun (name, _) ->
    let d = try Hashtbl.find deps name with Not_found -> [] in
    let count = List.length (List.filter (fun dep -> Hashtbl.mem all_names dep) d) in
    Hashtbl.replace in_degree name count
  ) !defs;

  (* Queue: all defs with in-degree 0 (leaves) *)
  let queue = Queue.create () in
  List.iter (fun (name, _) ->
    if Hashtbl.find in_degree name = 0 then Queue.push name queue
  ) !defs;

  (* Lookup map for defs by name *)
  let def_map = Hashtbl.create 256 in
  List.iter (fun (name, def) -> Hashtbl.replace def_map name def) !defs;

  let processed = ref 0 in

  (* Phase 3: process in topological order *)
  while not (Queue.is_empty queue) do
    let name = Queue.pop queue in
    incr processed;
    (* All deps of this def are already hashed — compute canonical form *)
    let canonical = match Hashtbl.find_opt def_map name with
      | Some (`Comp c) -> canonical_form_component name_to_hash c
      | Some (`Island i) -> canonical_form_island name_to_hash i
      | Some (`Macro m) -> canonical_form_macro name_to_hash m
      | None -> ""
    in
    if canonical <> "" then begin
      let h = hash_string canonical in
      Hashtbl.replace name_to_hash name h;
      Hashtbl.replace hash_to_def h canonical;
      Hashtbl.replace hash_to_name h name
    end;
    (* Decrease in-degree of dependents, enqueue if zero *)
    let rev_deps = try Hashtbl.find dependents name with Not_found -> [] in
    List.iter (fun dep_name ->
      if Hashtbl.mem in_degree dep_name then begin
        let d = Hashtbl.find in_degree dep_name in
        Hashtbl.replace in_degree dep_name (d - 1);
        if d - 1 = 0 then Queue.push dep_name queue
      end
    ) rev_deps
  done;

  (* Any remaining defs with in-degree > 0 have circular deps — hash without ref replacement *)
  if !processed < List.length !defs then begin
    List.iter (fun (name, _) ->
      if not (Hashtbl.mem name_to_hash name) then begin
        let canonical = match Hashtbl.find_opt def_map name with
          | Some (`Comp c) -> canonical_form_component name_to_hash c
          | Some (`Island i) -> canonical_form_island name_to_hash i
          | Some (`Macro m) -> canonical_form_macro name_to_hash m
          | None -> ""
        in
        if canonical <> "" then begin
          let h = hash_string canonical in
          Hashtbl.replace name_to_hash name h;
          Hashtbl.replace hash_to_def h canonical;
          Hashtbl.replace hash_to_name h name
        end
      end
    ) !defs
  end;

  let idx = { name_to_hash; hash_to_def; hash_to_name; dependents } in
  Printf.eprintf "[hash-index] %d definitions, %d hashes\n%!"
    (List.length !defs) (Hashtbl.length name_to_hash);
  _hash_index := Some idx;
  idx


(** Pre-compute shell statics and inject into env as __shell-* vars. *)
let http_inject_shell_statics env static_dir sx_sxc =
  (* Component definitions for client.
     Client library sources FIRST (CSSX etc.) so defines are available
     before defcomp/defisland bodies that reference them. *)
  let buf = Buffer.create 65536 in
  let project_dir = try Sys.getenv "SX_PROJECT_DIR" with Not_found ->
    Filename.dirname (Filename.dirname static_dir) in
  let templates_dir = project_dir ^ "/shared/sx/templates" in
  let client_lib_names = get_app_list "client-libs" ["tw-layout.sx"; "tw-type.sx"; "tw.sx"] in
  let client_libs = List.map (fun name -> templates_dir ^ "/" ^ name) client_lib_names in
  List.iter (fun path ->
    if Sys.file_exists path then begin
      let src = In_channel.with_open_text path In_channel.input_all in
      Buffer.add_string buf src;
      Buffer.add_char buf '\n'
    end
  ) client_libs;
  (* Then component/island definitions *)
  Hashtbl.iter (fun _sym v ->
    match v with
    | Component c ->
      let ps = String.concat " " (
        "&key" :: c.c_params @
        (if c.c_has_children then ["&rest"; "children"] else [])) in
      Buffer.add_string buf (Printf.sprintf "(defcomp ~%s (%s) %s)\n"
        c.c_name ps (serialize_value c.c_body))
    | Island i ->
      let ps = String.concat " " (
        "&key" :: i.i_params @
        (if i.i_has_children then ["&rest"; "children"] else [])) in
      Buffer.add_string buf (Printf.sprintf "(defisland ~%s (%s) %s)\n"
        i.i_name ps (serialize_value i.i_body))
    | _ -> ()
  ) env.bindings;
  let raw_defs = Buffer.contents buf in
  (* Component-defs are inlined in <script type="text/sx">.
     Escape </ → <\/ to prevent HTML parser from matching </script>. *)
  let component_defs =
    let len = String.length raw_defs in
    let buf2 = Buffer.create (len + 64) in
    for i = 0 to len - 1 do
      if raw_defs.[i] = '<' && i + 1 < len && raw_defs.[i + 1] = '/' then begin
        Buffer.add_string buf2 "<\\/";
      end else if raw_defs.[i] = '/' && i > 0 && raw_defs.[i - 1] = '<' then
        () (* skip — already handled above *)
      else
        Buffer.add_char buf2 raw_defs.[i]
    done;
    Buffer.contents buf2
  in
  let component_hash = Digest.string component_defs |> Digest.to_hex in
  (* Compute per-file hashes for cache busting *)
  let wasm_hash = file_hash (static_dir ^ "/wasm/sx_browser.bc.wasm.js") in
  let platform_hash = file_hash (static_dir ^ "/wasm/sx-platform.js") in
  let sxbc_hash = sxbc_combined_hash (static_dir ^ "/wasm") in
  (* Read CSS for inline injection *)
  let css_file_names = get_app_list "css-files" ["basics.css"; "tw.css"] in
  let sx_css = String.concat "\n" (List.map (fun name ->
    read_css_file (static_dir ^ "/styles/" ^ name)) css_file_names) in
  ignore (env_bind env "__shell-component-defs" (String component_defs));
  ignore (env_bind env "__shell-component-hash" (String component_hash));
  (* Build content-addressed hash index *)
  let hidx = build_hash_index env in
  (* Hash each .sxbc module individually and add to the hash index.
     Each module's content is stored by hash; exported symbols map to the module hash. *)
  let sxbc_dir = static_dir ^ "/wasm/sx" in
  let module_manifest_path = sxbc_dir ^ "/module-manifest.sx" in
  let module_hashes : (string, string) Hashtbl.t = Hashtbl.create 32 in (* module key → hash *)
  (if Sys.file_exists module_manifest_path then begin
    (* Read each .sxbc file, hash it, store in hash_to_def *)
    if Sys.file_exists sxbc_dir && Sys.is_directory sxbc_dir then begin
      let files = Array.to_list (Sys.readdir sxbc_dir) in
      let sxbc_files = List.filter (fun f -> Filename.check_suffix f ".sxbc") files in
      List.iter (fun fname ->
        let fpath = sxbc_dir ^ "/" ^ fname in
        let content = In_channel.with_open_bin fpath In_channel.input_all in
        let h = hash_string content in
        Hashtbl.replace hidx.hash_to_def h content;
        Hashtbl.replace hidx.hash_to_name h fname;
        (* Map filename (without ext) to hash for the modules section *)
        Hashtbl.replace module_hashes fname h
      ) sxbc_files
    end
  end);
  (* Hash the WASM bootstrap files — these are the kernel scripts
     that must load before anything else. *)
  let wasm_dir = static_dir ^ "/wasm" in
  let boot_files = ["sx_browser.bc.wasm.js"; "sx-platform.js"] in
  let boot_hashes = List.filter_map (fun fname ->
    let fpath = wasm_dir ^ "/" ^ fname in
    if Sys.file_exists fpath then begin
      let content = In_channel.with_open_bin fpath In_channel.input_all in
      let h = hash_string content in
      Hashtbl.replace hidx.hash_to_def h content;
      Hashtbl.replace hidx.hash_to_name h fname;
      Some (fname, h)
    end else None
  ) boot_files in
  Printf.eprintf "[hash-index] %d module hashes, %d boot hashes\n%!"
    (Hashtbl.length module_hashes) (List.length boot_hashes);
  (* Build full manifest JSON:
     {"v":1,"defs":{...},"modules":{...},"boot":[["file","hash"],...]} *)
  let manifest_buf = Buffer.create 8192 in
  Buffer.add_string manifest_buf "{\"v\":1,\"defs\":{";
  let first = ref true in
  Hashtbl.iter (fun name hash ->
    if not !first then Buffer.add_char manifest_buf ',';
    first := false;
    Buffer.add_string manifest_buf (Printf.sprintf "\"%s\":\"%s\""
      (escape_sx_string name) hash)
  ) hidx.name_to_hash;
  Buffer.add_string manifest_buf "},\"modules\":{";
  first := true;
  Hashtbl.iter (fun fname hash ->
    if not !first then Buffer.add_char manifest_buf ',';
    first := false;
    Buffer.add_string manifest_buf (Printf.sprintf "\"%s\":\"%s\""
      (escape_sx_string fname) hash)
  ) module_hashes;
  Buffer.add_string manifest_buf "},\"boot\":[";
  first := true;
  List.iter (fun (_fname, h) ->
    if not !first then Buffer.add_char manifest_buf ',';
    first := false;
    Buffer.add_string manifest_buf (Printf.sprintf "\"%s\"" h)
  ) boot_hashes;
  Buffer.add_string manifest_buf "]}";
  let manifest_json = Buffer.contents manifest_buf in
  ignore (env_bind env "__shell-component-manifest" (String manifest_json));
  (* Build minimal pages-sx from defpage definitions in loaded .sx files.
     Scans all loaded .sx files in the component dirs for (defpage ...) forms. *)
  let pages_buf = Buffer.create 4096 in
  let scan_defpages dir =
    let rec scan d =
      if Sys.file_exists d && Sys.is_directory d then
        Array.iter (fun f ->
          let path = d ^ "/" ^ f in
          if Sys.is_directory path then scan path
          else if Filename.check_suffix f ".sx" then
            try
              let src = In_channel.with_open_text path In_channel.input_all in
              let exprs = Sx_parser.parse_all src in
              List.iter (function
                | List (Symbol "defpage" :: Symbol name :: rest) ->
                  let rec extract_kw key = function
                    | [] -> None
                    | Keyword k :: v :: _ when k = key -> Some v
                    | _ :: rest -> extract_kw key rest
                  in
                  let path_val = match extract_kw "path" rest with
                    | Some (String s) -> s | _ -> "" in
                  let content_val = match extract_kw "content" rest with
                    | Some v -> serialize_value v | _ -> "" in
                  let has_data = match extract_kw "data" rest with
                    | Some _ -> true | None -> false in
                  let is_stream = match extract_kw "stream" rest with
                    | Some (Symbol "true") | Some (Bool true) -> true | _ -> false in
                  if path_val <> "" then begin
                    _defpage_paths := path_val :: !_defpage_paths;
                    if is_stream then
                      Hashtbl.replace _streaming_pages path_val name;
                    Buffer.add_string pages_buf
                      (Printf.sprintf "{:name \"%s\" :path \"%s\" :auth \"public\" :has-data %s :content \"%s\"}\n"
                        name path_val (if has_data then "true" else "false")
                        (escape_sx_string content_val))
                  end
                | _ -> ()
              ) exprs
            with _ -> ()
        ) (Sys.readdir d)
    in scan dir
  in
  scan_defpages sx_sxc;
  let pages_sx = Buffer.contents pages_buf in
  Printf.eprintf "[sx-http] pages-sx: %d bytes (%d lines)\n%!"
    (String.length pages_sx)
    (List.length (String.split_on_char '\n' pages_sx));
  if Hashtbl.length _streaming_pages > 0 then
    Printf.eprintf "[sx-http] streaming pages: %s\n%!"
      (String.concat ", " (Hashtbl.fold (fun p n acc -> (p ^ "→" ^ n) :: acc) _streaming_pages []));
  ignore (env_bind env "__shell-pages-sx" (String pages_sx));
  ignore (env_bind env "__shell-sx-css" (String sx_css));
  ignore (env_bind env "__shell-asset-url" (String "/static"));
  ignore (env_bind env "__shell-wasm-hash" (String wasm_hash));
  ignore (env_bind env "__shell-platform-hash" (String platform_hash));
  ignore (env_bind env "__shell-sxbc-hash" (String sxbc_hash));
  ignore (env_bind env "__shell-inline-css" Nil);
  ignore (env_bind env "__shell-inline-head-js" Nil);
  (* init-sx: trigger client-side render when sx-root is empty (SSR failed). *)
  let default_init_sx =
    "document.addEventListener('sx:boot-done', function() { \
     var root = document.getElementById('sx-root'); \
     if (root && !root.innerHTML.trim() && typeof SX !== 'undefined' && SX.renderPage) { \
       SX.renderPage(); \
     } \
     });" in
  let init_sx = match get_app_config "init-script" (Keyword "default") with
    | String s -> s | _ -> default_init_sx in
  ignore (env_bind env "__shell-init-sx" (String init_sx));
  Printf.eprintf "[sx-http] Shell statics: defs=%d hash=%s css=%d wasm=%s platform=%s sxbc=%s\n%!"
    (String.length component_defs) component_hash (String.length sx_css) wasm_hash platform_hash sxbc_hash

let http_setup_declarative_stubs env =
  (* Stub declarative forms that are metadata-only — no-ops at render time. *)
  let noop name =
    ignore (env_bind env name (NativeFn (name, fun _args -> Nil))) in
  noop "define-module";
  noop "define-primitive";
  noop "deftype";
  noop "defeffect";
  noop "define-page-helper";
  (* defhandler — register as native special form so it works without web-forms.sx.
     Parses the handler args and stores as handler:name in the env. *)
  ignore (Sx_ref.register_special_form (String "defhandler") (NativeFn ("defhandler", fun args ->
    match args with
    | name_sym :: rest ->
      let name = match name_sym with Symbol s -> s | String s -> s | _ -> Sx_types.inspect name_sym in
      (* Parse keyword opts and find params/body *)
      let rec parse_opts acc = function
        | Keyword k :: v :: rest -> Hashtbl.replace acc k v; parse_opts acc rest
        | rest -> (acc, rest)
      in
      let opts = Hashtbl.create 4 in
      let (_, remaining) = parse_opts opts rest in
      let params, body = match remaining with
        | List p :: b :: _ -> (p, b)
        | List p :: [] -> (p, Nil)
        | _ -> ([], Nil)
      in
      let hdef = Hashtbl.create 8 in
      Hashtbl.replace hdef "__type" (String "handler");
      Hashtbl.replace hdef "name" (String name);
      Hashtbl.replace hdef "params" (List params);
      Hashtbl.replace hdef "body" body;
      Hashtbl.replace hdef "closure" (Env env);
      Hashtbl.replace hdef "method" (match Hashtbl.find_opt opts "method" with
        | Some (Keyword m) -> String m | Some v -> v | None -> String "get");
      Hashtbl.replace hdef "path" (match Hashtbl.find_opt opts "path" with
        | Some v -> v | None -> Nil);
      Hashtbl.replace hdef "csrf" (match Hashtbl.find_opt opts "csrf" with
        | Some v -> v | None -> Bool true);
      Hashtbl.replace hdef "returns" (match Hashtbl.find_opt opts "returns" with
        | Some v -> v | None -> String "element");
      let handler_key = "handler:" ^ name in
      ignore (env_bind env handler_key (Dict hdef));
      Dict hdef
    | _ -> Nil)));
  (* Also stub defquery/defaction/defrelation/defstyle as no-ops *)
  noop "defquery";
  noop "defaction";
  noop "defrelation";
  noop "defstyle";
  (* IO registry — spec-level defio populates *io-registry* in evaluator.
     Alias as __io-registry for backward compat. *)
  ignore (env_bind env "__io-registry" Sx_ref._io_registry_)

let http_setup_platform_constructors env =
  (* Platform constructor functions expected by evaluator.sx.
     The OCaml CEK evaluator handles lambda/component/etc as special forms
     natively, but when evaluator.sx's SX-level code processes these forms
     it calls make-lambda etc. by name. Bind them to the OCaml constructors. *)
  let bind name fn = ignore (env_bind env name (NativeFn (name, fn))) in
  bind "make-lambda" (fun args ->
    match args with
    | [params; body; env_val] -> Sx_types.make_lambda params body env_val
    | _ -> raise (Eval_error "make-lambda: expected (params body env)"));
  bind "make-component" (fun args ->
    match args with
    | [name; params; has_children; body; env_val; affinity] ->
      Sx_types.make_component name params has_children body env_val affinity
    | [name; params; has_children; body; env_val] ->
      Sx_types.make_component name params has_children body env_val (String "auto")
    | _ -> raise (Eval_error "make-component: expected (name params has-children body env [affinity])"));
  bind "make-island" (fun args ->
    match args with
    | [name; params; has_children; body; env_val] ->
      Sx_types.make_island name params has_children body env_val
    | _ -> raise (Eval_error "make-island: expected (name params has-children body env)"));
  bind "make-macro" (fun args ->
    match args with
    | [params; rest_param; body; closure; name] ->
      Sx_types.make_macro params rest_param body closure name
    | [params; body; Env _e] ->
      (* Simplified: no rest_param, no closure needed *)
      Sx_types.make_macro params Nil body Nil (String "anonymous")
    | _ -> raise (Eval_error "make-macro: expected (params rest-param body closure name)"));
  bind "make-thunk" (fun args ->
    match args with
    | [body; Env e] -> Thunk (body, e)
    | _ -> raise (Eval_error "make-thunk: expected (body env)"));
  bind "make-env" (fun args ->
    match args with
    | [] -> Env (make_env ())
    | [Env parent] -> Env { bindings = Hashtbl.create 8; parent = Some parent }
    | _ -> raise (Eval_error "make-env: expected () or (parent-env)"));
  (* Platform accessor functions — evaluator.sx expects these *)
  bind "lambda-name" (fun args -> match args with [v] -> Sx_types.lambda_name v | _ -> Nil);
  bind "lambda-params" (fun args -> match args with [v] -> Sx_types.lambda_params v | _ -> Nil);
  bind "lambda-body" (fun args -> match args with [v] -> Sx_types.lambda_body v | _ -> Nil);
  bind "lambda-closure" (fun args -> match args with [v] -> Sx_types.lambda_closure v | _ -> Nil);
  bind "set-lambda-name!" (fun args -> match args with [l; n] -> ignore (Sx_runtime.set_lambda_name l n); l | _ -> Nil);
  bind "env-has?" (fun args ->
    match args with [Env e; String k] | [Env e; Symbol k] -> Bool (env_has e k) | _ -> Bool false);
  bind "env-get" (fun args ->
    match args with [Env e; String k] | [Env e; Symbol k] -> (try env_get e k with _ -> Nil) | _ -> Nil);
  bind "env-set!" (fun args ->
    match args with
    | [Env e; String k; v] | [Env e; Symbol k; v] -> ignore (env_bind e k v); Nil
    | _ -> Nil);
  bind "env-bind!" (fun args ->
    match args with
    | [Env e; String k; v] | [Env e; Symbol k; v] -> ignore (env_bind e k v); Nil
    | _ -> Nil);
  bind "env-extend" (fun args ->
    match args with
    | [Env parent] -> Env { bindings = Hashtbl.create 8; parent = Some parent }
    | _ -> Env (make_env ()));
  bind "env-keys" (fun args ->
    match args with
    | [Env e] -> List (Hashtbl.fold (fun k _v acc -> String (Sx_types.unintern k) :: acc) e.bindings [])
    | _ -> List [])

let http_load_files ?(base_dir="") env files =
  (* Like cli_load_files but tolerant — logs errors, doesn't crash.
     When base_dir is set, unnamed definitions get path-derived names. *)
  List.iter (fun path ->
    if Sys.file_exists path then begin
      try
        let prev_file = if Sx_types.env_has env "*current-file*" then Some (Sx_types.env_get env "*current-file*") else None in
        ignore (Sx_types.env_bind env "*current-file*" (String path));
        let exprs = Sx_parser.parse_file path in
        List.iter (fun expr ->
          let expr' = if base_dir <> "" then inject_path_name expr path base_dir else expr in
          try ignore (eval_expr_io expr' (Env env))
          with e -> Printf.eprintf "[http-load] %s: %s\n%!" (Filename.basename path) (Printexc.to_string e)
        ) exprs;
        (match prev_file with
         | Some v -> ignore (Sx_types.env_bind env "*current-file*" v)
         | None -> ())
      with e -> Printf.eprintf "[http-load] parse error %s: %s\n%!" path (Printexc.to_string e)
    end
  ) files;
  rebind_host_extensions env

(* ====================================================================== *)
(* Request context — set per-request before rendering                      *)
(* ====================================================================== *)

let _req_method = ref "GET"
let _req_body = ref ""
let _req_query = ref ""
let _req_headers : (string * string) list ref = ref []
let _ephemeral_state : (string, value) Hashtbl.t = Hashtbl.create 64

let parse_urlencoded body =
  if body = "" then []
  else
    let pairs = String.split_on_char '&' body in
    List.filter_map (fun pair ->
      match String.index_opt pair '=' with
      | Some i ->
        let k = url_decode (String.sub pair 0 i) in
        let v = url_decode (String.sub pair (i + 1) (String.length pair - i - 1)) in
        Some (k, v)
      | None -> Some (url_decode pair, "")
    ) pairs

let parse_query_string path =
  match String.index_opt path '?' with
  | Some i -> String.sub path (i + 1) (String.length path - i - 1)
  | None -> ""

let extract_body data =
  (* Find double CRLF separating headers from body *)
  let rec find_sep s pat pat_len i =
    if i + pat_len > String.length s then -1
    else if String.sub s i pat_len = pat then i
    else find_sep s pat pat_len (i + 1) in
  let n = find_sep data "\r\n\r\n" 4 0 in
  if n >= 0 then String.sub data (n + 4) (String.length data - n - 4)
  else
    let n2 = find_sep data "\n\n" 2 0 in
    if n2 >= 0 then String.sub data (n2 + 2) (String.length data - n2 - 2)
    else ""

(* Pretty printer — AST value → formatted SX source string *)
let pp_atom = Sx_types.inspect

let rec est_width = function
  | Nil -> 3 | Bool true -> 4 | Bool false -> 5
  | Number n -> String.length (Sx_types.format_number n)
  | String s -> String.length s + 2
  | Symbol s -> String.length s
  | Keyword k -> String.length k + 1
  | SxExpr s -> String.length s + 2
  | List items | ListRef { contents = items } ->
    2 + List.fold_left (fun acc x -> acc + est_width x + 1) 0 items
  | _ -> 10

let pretty_print_value ?(max_width=80) v =
  let buf = Buffer.create 4096 in
  let rec pp indent v =
    match v with
    | List items | ListRef { contents = items } when items <> [] ->
      if est_width v <= max_width - indent then
        Buffer.add_string buf (pp_atom v)
      else begin
        Buffer.add_char buf '(';
        let head = List.hd items in
        Buffer.add_string buf (pp_atom head);
        let child_indent = indent + 2 in
        let rest = List.tl items in
        let rec emit = function
          | [] -> ()
          | Keyword k :: v :: rest ->
            Buffer.add_char buf '\n';
            Buffer.add_string buf (String.make child_indent ' ');
            Buffer.add_char buf ':';
            Buffer.add_string buf k;
            Buffer.add_char buf ' ';
            pp child_indent v;
            emit rest
          | item :: rest ->
            Buffer.add_char buf '\n';
            Buffer.add_string buf (String.make child_indent ' ');
            pp child_indent item;
            emit rest
        in
        emit rest;
        Buffer.add_char buf ')'
      end
    | _ -> Buffer.add_string buf (pp_atom v)
  in
  pp 0 v;
  Buffer.contents buf

let http_setup_page_helpers env =
  let bind name fn = ignore (env_bind env name (NativeFn (name, fn))) in

  (* Request primitives — use thread-local _req_* context *)
  bind "now" (fun args ->
    let open Unix in
    let t = gettimeofday () in
    let tm = localtime t in
    let fmt = match args with String f :: _ -> f | _ -> "%Y-%m-%d %H:%M:%S" in
    let result = Printf.sprintf "%04d-%02d-%02d %02d:%02d:%02d"
      (tm.tm_year + 1900) (tm.tm_mon + 1) tm.tm_mday
      tm.tm_hour tm.tm_min tm.tm_sec in
    (* Basic format substitution *)
    let r = if fmt = "%H:%M:%S" then
      Printf.sprintf "%02d:%02d:%02d" tm.tm_hour tm.tm_min tm.tm_sec
    else if fmt = "%Y-%m-%d" then
      Printf.sprintf "%04d-%02d-%02d" (tm.tm_year + 1900) (tm.tm_mon + 1) tm.tm_mday
    else if fmt = "%Y-%m-%d %H:%M:%S" then result
    else result in
    String r);

  bind "state-get" (fun args ->
    match args with
    | String key :: rest ->
      let default = match rest with v :: _ -> v | [] -> Nil in
      (match Hashtbl.find_opt _ephemeral_state key with
       | Some v -> v | None -> default)
    | _ -> Nil);

  bind "state-set!" (fun args ->
    match args with
    | String key :: value :: _ -> Hashtbl.replace _ephemeral_state key value; Nil
    | _ -> Nil);

  bind "state-clear!" (fun args ->
    match args with
    | [String key] -> Hashtbl.remove _ephemeral_state key; Nil
    | _ -> Nil);

  bind "request-method" (fun _args -> String !_req_method);
  bind "request-body" (fun _args -> String !_req_body);

  bind "request-form" (fun args ->
    match args with
    | String name :: rest ->
      let default = match rest with v :: _ -> v | [] -> String "" in
      let pairs = parse_urlencoded !_req_body in
      (match List.assoc_opt name pairs with
       | Some v -> String v | None -> default)
    | _ -> String "");

  bind "request-arg" (fun args ->
    match args with
    | String name :: rest ->
      let default = match rest with v :: _ -> v | [] -> Nil in
      let pairs = parse_urlencoded !_req_query in
      (match List.assoc_opt name pairs with
       | Some v -> String v | None -> default)
    | _ -> Nil);

  bind "request-form-all" (fun _args ->
    let pairs = parse_urlencoded !_req_body in
    let d = Hashtbl.create 8 in
    List.iter (fun (k, v) -> Hashtbl.replace d k (String v)) pairs;
    Dict d);

  bind "request-args-all" (fun _args ->
    let pairs = parse_urlencoded !_req_query in
    let d = Hashtbl.create 8 in
    List.iter (fun (k, v) -> Hashtbl.replace d k (String v)) pairs;
    Dict d);

  bind "request-form-list" (fun args ->
    match args with
    | [String name] ->
      let pairs = parse_urlencoded !_req_body in
      List (List.filter_map (fun (k, v) -> if k = name then Some (String v) else None) pairs)
    | _ -> List []);

  bind "request-json" (fun _args -> String !_req_body);

  bind "request-header" (fun args ->
    match args with
    | String name :: rest ->
      let default = match rest with v :: _ -> v | [] -> String "" in
      let lname = String.lowercase_ascii name in
      (match List.assoc_opt lname (List.map (fun (k,v) -> (String.lowercase_ascii k, v)) !_req_headers) with
       | Some v -> String v | None -> default)
    | _ -> String "");

  bind "request-headers-all" (fun _args ->
    let d = Hashtbl.create 8 in
    List.iter (fun (k, v) -> Hashtbl.replace d (String.lowercase_ascii k) (String v)) !_req_headers;
    Dict d);

  bind "request-content-type" (fun _args ->
    match List.assoc_opt "content-type" (List.map (fun (k,v) -> (String.lowercase_ascii k, v)) !_req_headers) with
    | Some v -> String v | None -> String "");

  bind "request-file-name" (fun _args -> String "");

  bind "into" (fun args ->
    match args with
    | [String "list"; Dict d] ->
      List (Hashtbl.fold (fun k v acc -> List [String k; v] :: acc) d [])
    | [String "dict"; List pairs] ->
      let d = Hashtbl.create 8 in
      List.iter (fun pair -> match pair with
        | List [String k; v] -> Hashtbl.replace d k v
        | _ -> ()) pairs;
      Dict d
    | _ -> Nil);

  (* Primitive 1: pretty-print — AST → formatted SX source *)
  bind "pretty-print" (fun args ->
    match args with
    | [v] -> String (pretty_print_value v)
    | _ -> raise (Eval_error "pretty-print: expected 1 argument"));

  (* Primitive 2: read-file — path → string contents or nil *)
  bind "read-file" (fun args ->
    match args with
    | [String path] ->
      (try
        let ic = open_in path in
        let n = in_channel_length ic in
        let s = Bytes.create n in
        really_input ic s 0 n;
        close_in ic;
        String (Bytes.to_string s)
      with _ -> Nil)
    | _ -> raise (Eval_error "read-file: expected string path"));

  (* Primitive 3: env-list-typed — list all bindings of a given type *)
  bind "env-list-typed" (fun args ->
    match args with
    | [String type_name] ->
      let matches = ref [] in
      Hashtbl.iter (fun id v ->
        let matches_type = match type_name, v with
          | "component", Component _ -> true
          | "island", Island _ -> true
          | "lambda", Lambda _ -> true
          | "macro", Macro _ -> true
          | "native", NativeFn _ -> true
          | _ -> false
        in
        if matches_type then
          matches := String (Sx_types.unintern id) :: !matches
      ) env.bindings;
      List (List.sort compare !matches)
    | _ -> raise (Eval_error "env-list-typed: expected type name string"));

  (* helper dispatcher — looks up named function in env, calls it directly.
     In coroutine mode this goes through the Python IO bridge.
     In HTTP mode we dispatch locally to functions defined by SX helpers. *)
  bind "helper" (fun args ->
    match args with
    | String name :: rest ->
      (try
        let fn = env_get env name in
        Sx_ref.cek_call fn (List rest)
      with Eval_error _ ->
        Printf.eprintf "[helper] not found: %s\n%!" name;
        Nil)
    | _ -> raise (Eval_error "helper: expected (helper \"name\" ...args)"));

  (* component-source — look up component/island from env, pretty-print its definition *)
  bind "component-source" (fun args ->
    match args with
    | [String name] ->
      let lookup = if String.length name > 0 && name.[0] = '~'
                   then name
                   else "~" ^ name in
      (try
        let comp = env_get env lookup in
        match comp with
        | Component c ->
          let params = List (List.map (fun s -> Symbol s) c.c_params) in
          let form = List [Symbol "defcomp"; Symbol ("~" ^ c.c_name);
                           params; c.c_body] in
          String (pretty_print_value form)
        | Island c ->
          let params = List (List.map (fun s -> Symbol s) c.i_params) in
          let form = List [Symbol "defisland"; Symbol ("~" ^ c.i_name);
                           params; c.i_body] in
          String (pretty_print_value form)
        | _ -> String (";; " ^ name ^ ": not a component")
      with _ -> String (";; component " ^ name ^ " not found"))
    | _ -> raise (Eval_error "component-source: expected (name)"));

  (* IO sleep primitive — used by streaming pages to simulate async IO delays.
     Application code calls (io-sleep ms) which raises CekPerformRequest;
     the streaming render's eval_with_io resolves it with Unix.sleepf. *)
  bind "io-sleep" (fun args ->
    let ms = match args with Number n :: _ -> n | _ -> 0.0 in
    raise (Sx_types.CekPerformRequest (
      let d = Hashtbl.create 2 in
      Hashtbl.replace d "op" (String "io-sleep");
      Hashtbl.replace d "args" (List [Number ms]);
      Dict d)));

  ignore bind (* suppress unused warning *)

let http_mode port =
  let env = make_server_env () in
  (* Stub declarative metadata forms — no-ops at render time *)
  http_setup_declarative_stubs env;
  (* Platform constructors expected by evaluator.sx *)
  http_setup_platform_constructors env;
  (* Page helpers *)
  http_setup_page_helpers env;
  (* Load all .sx files *)
  let project_dir = try Sys.getenv "SX_PROJECT_DIR" with Not_found ->
    try Sys.getenv "SX_ROOT" with Not_found ->
    if Sys.file_exists "/app/spec" then "/app" else Sys.getcwd () in
  let spec_base = try Sys.getenv "SX_SPEC_DIR" with Not_found ->
    project_dir ^ "/spec" in
  let lib_base = try Sys.getenv "SX_LIB_DIR" with Not_found ->
    project_dir ^ "/lib" in
  let web_base = try Sys.getenv "SX_WEB_DIR" with Not_found ->
    project_dir ^ "/web" in
  let shared_sx = try Sys.getenv "SX_SHARED_DIR" with Not_found ->
    project_dir ^ "/shared/sx/templates" in
  let sx_sx = try Sys.getenv "SX_COMPONENTS_DIR" with Not_found ->
    let docker_path = project_dir ^ "/sx" in
    let dev_path = project_dir ^ "/sx/sx" in
    if Sys.file_exists docker_path && Sys.is_directory docker_path
       && not (Sys.file_exists (docker_path ^ "/sx"))  (* avoid matching parent of sx/sx *)
    then docker_path
    else if Sys.file_exists dev_path && Sys.is_directory dev_path then dev_path
    else begin
      Printf.eprintf "[sx-http] WARNING: no components dir at %s or %s\n%!" docker_path dev_path;
      docker_path
    end in
  (* Expose project paths to SX helpers *)
  ignore (env_bind env "_project-dir" (String project_dir));
  ignore (env_bind env "_spec-dir" (String spec_base));
  ignore (env_bind env "_lib-dir" (String lib_base));
  ignore (env_bind env "_web-dir" (String web_base));
  (* Set import env so load_library_file (called by _import_hook) uses the main env *)
  _import_env := Some env;
  let t0 = Unix.gettimeofday () in
  (* Core spec + adapters.
     Skip: primitives.sx (declarative metadata — all prims native in OCaml),
           types.sx (gradual types — not needed for rendering),
           evaluator.sx (SX-level CEK — native evaluator already compiled in).
     The native CEK evaluator is faster — evaluator.sx adds a second SX-level
     stepper that's 100x slower. *)
  let core_files = [
    spec_base ^ "/parser.sx";
    spec_base ^ "/render.sx";
    spec_base ^ "/signals.sx";
    lib_base ^ "/compiler.sx";
    web_base ^ "/adapter-html.sx"; web_base ^ "/adapter-sx.sx";
    web_base ^ "/io.sx";
    web_base ^ "/web-forms.sx"; web_base ^ "/engine.sx";
    web_base ^ "/request-handler.sx";
    web_base ^ "/page-helpers.sx";
  ] in
  http_load_files env core_files;
  (* Libraries *)
  (* Files to skip — declarative metadata, not needed for rendering *)
  let skip_files = ["primitives.sx"; "types.sx"; "boundary.sx";
                     "harness.sx"; "eval-rules.sx"; "vm-inline.sx"] in
  let skip_dirs = ["tests"; "test"; "plans"; "essays"; "spec"; "client-libs"; "_test"] in
  let rec load_dir ?(base="") dir =
    if Sys.file_exists dir && Sys.is_directory dir then begin
      let entries = Sys.readdir dir in
      Array.sort String.compare entries;
      Array.iter (fun f ->
        let path = dir ^ "/" ^ f in
        if Sys.is_directory path then begin
          if not (List.mem f skip_dirs) then
            load_dir ~base path
        end
        else if Filename.check_suffix f ".sx"
                && not (List.mem f skip_files)
                && not (String.length f > 5 && String.sub f 0 5 = "test-")
                && not (Filename.check_suffix f ".test.sx") then
          http_load_files ~base_dir:base env [path]
      ) entries
    end
  in
  load_dir lib_base;
  load_dir shared_sx;
  (* sxc/ has core layout components like ~docs/page *)
  let sx_sxc = try Sys.getenv "SX_SXC_DIR" with Not_found ->
    let docker_path = project_dir ^ "/sxc" in
    let dev_path = project_dir ^ "/sx/sxc" in
    if Sys.file_exists docker_path then docker_path else dev_path in
  load_dir ~base:sx_sxc sx_sxc;
  load_dir ~base:sx_sx sx_sx;
  let t1 = Unix.gettimeofday () in
  Printf.eprintf "[sx-http] All files loaded in %.3fs\n%!" (t1 -. t0);
  (* Derive batchable_helpers from __io-registry *)
  (try match env_get env "__io-registry" with
    | Dict registry ->
      let batchable = Hashtbl.fold (fun name entry acc ->
        match entry with
        | Dict d -> (match Hashtbl.find_opt d "batchable" with
          | Some (Bool true) -> name :: acc | _ -> acc)
        | _ -> acc) registry [] in
      if batchable <> [] then batchable_helpers := batchable;
      Printf.eprintf "[sx-http] IO registry: %d ops, %d batchable\n%!"
        (Hashtbl.length registry) (List.length batchable);
      (* Validate: warn if bound IO ops are not declared *)
      let expected = ["query"; "action"; "request-arg"; "request-method";
        "ctx"; "helper"; "json-encode"; "into"; "sleep";
        "set-response-status"; "set-response-header"] in
      List.iter (fun name ->
        if not (Hashtbl.mem registry name) then
          Printf.eprintf "[sx-http] WARNING: IO '%s' bound but not in registry\n%!" name
      ) expected
    | _ -> ()
  with _ -> ());
  (* Extract app config from __app-config dict *)
  (try match env_get env "__app-config" with
    | Dict d ->
      _app_config := Some d;
      (* App config can add extra batchable helpers on top of registry *)
      let extra = get_app_list "batchable-helpers" [] in
      if extra <> [] then
        batchable_helpers := List.sort_uniq String.compare (!batchable_helpers @ extra);
      Printf.eprintf "[sx-http] App config loaded: title=%s prefix=%s\n%!"
        (get_app_str "title" "?") (get_app_str "path-prefix" "?")
    | _ -> Printf.eprintf "[sx-http] WARNING: __app-config is not a dict\n%!"
  with _ -> Printf.eprintf "[sx-http] No __app-config found, using defaults\n%!");
  (* SSR overrides — rebind browser-only functions AFTER .sx files load.
     effect and register-in-scope are no-ops on the server; the SX definitions
     from signals.sx are replaced so effect bodies never execute during SSR. *)
  let bind name fn = ignore (env_bind env name (NativeFn (name, fn))) in
  bind "effect" (fun _args -> Nil);
  bind "register-in-scope" (fun _args -> Nil);
  (* Re-bind component-source — data/helpers.sx overrides the native version
     with an SX version that calls env-get with wrong arity.  Native version
     uses env_get directly and handles pretty-printing in OCaml. *)
  bind "component-source" (fun args ->
    match args with
    | [String name] ->
      let lookup = if String.length name > 0 && name.[0] = '~'
                   then name
                   else "~" ^ name in
      (try
        let comp = env_get env lookup in
        match comp with
        | Component c ->
          let params = List (List.map (fun s -> Symbol s) c.c_params) in
          let form = List [Symbol "defcomp"; Symbol ("~" ^ c.c_name);
                           params; c.c_body] in
          String (pretty_print_value form)
        | Island c ->
          let params = List (List.map (fun s -> Symbol s) c.i_params) in
          let form = List [Symbol "defisland"; Symbol ("~" ^ c.i_name);
                           params; c.i_body] in
          String (pretty_print_value form)
        | _ -> String (";; " ^ name ^ ": not a component")
      with _ -> String (";; component " ^ name ^ " not found"))
    | _ -> raise (Eval_error "component-source: expected (name)"));
  let jt0 = Unix.gettimeofday () in
  let count = ref 0 in
  (* Pre-compile the entire compiler — compile + helpers.
     jit_compile_lambda calls compile directly via the VM when it has
     bytecode, so all helper calls happen in one VM execution. *)
  let compiler_names = [
    "compile"; "compile-module"; "compile-expr"; "compile-symbol";
    "compile-dict"; "compile-list"; "compile-if"; "compile-when";
    "compile-and"; "compile-or"; "compile-begin"; "compile-let";
    "compile-letrec"; "compile-lambda"; "compile-define"; "compile-set";
    "compile-quote"; "compile-cond"; "compile-case"; "compile-case-clauses";
    "compile-thread"; "compile-thread-step"; "compile-defcomp";
    "compile-defisland"; "compile-defmacro";
    "compile-quasiquote"; "compile-qq-expr"; "compile-qq-list"; "compile-call";
    "make-emitter"; "make-pool"; "make-scope"; "pool-add";
    "scope-define-local"; "scope-resolve";
    "emit-byte"; "emit-u16"; "emit-i16"; "emit-op"; "emit-const";
    "current-offset"; "patch-i16";
  ] in
  List.iter (fun name ->
    try
      match env_get env name with
      | Lambda l ->
        l.l_compiled <- Some Sx_vm.jit_failed_sentinel;
        (match Sx_vm.jit_compile_lambda l (env_to_vm_globals env) with
         | Some cl -> l.l_compiled <- Some cl; incr count
         | None -> ())
      | _ -> ()
    with _ -> ()
  ) compiler_names;
  let jt1 = Unix.gettimeofday () in
  Printf.eprintf "[sx-http] JIT pre-compiled %d compiler fns in %.3fs\n%!" !count (jt1 -. jt0);
  (* Re-bind native primitives that stdlib.sx may have overwritten with
     narrower SX versions. The native assoc handles variadic key/value pairs
     which evaluator.sx requires. *)
  rebind_host_extensions env;
  ignore (env_bind env "assoc" (NativeFn ("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"))));
  (* Also re-bind highlight from SX lib if loaded *)
  (try
    let hl = env_get env "highlight" in
    ignore hl  (* already bound by lib/highlight.sx *)
  with _ ->
    (* Fallback: passthrough highlight *)
    ignore (env_bind env "highlight" (NativeFn ("highlight", fun args ->
      match args with
      | String code :: _ -> SxExpr (Printf.sprintf "(pre :class \"text-sm overflow-x-auto\" (code \"%s\"))" (escape_sx_string code))
      | _ -> Nil))));
  (* Static file directory *)
  let static_dir = try Sys.getenv "SX_STATIC_DIR" with Not_found ->
    let docker_path = project_dir ^ "/static" in
    let dev_path = project_dir ^ "/shared/static" in
    if Sys.file_exists docker_path then docker_path else dev_path in
  Printf.eprintf "[sx-http] static_dir=%s\n%!" static_dir;
  _font_base := static_dir ^ "/fonts";
  (* HTTP mode always expands components — bind once, shared across domains *)
  ignore (env_bind env "expand-components?" (NativeFn ("expand-components?", fun _args -> Bool true)));
  (* Inject shell statics with real file hashes, CSS, and pages registry *)
  http_inject_shell_statics env static_dir sx_sxc;
  (* Init shared VM globals AFTER all files loaded + shell statics injected.
     The env_bind hook keeps it in sync with any future bindings. *)
  (* Enable lazy JIT — compile lambdas to bytecode on first call *)
  register_jit_hook env;
  (* Install global IO resolver so perform works inside aser/eval_expr.
     This lets components call measure-text during server-side rendering. *)
  Sx_types._cek_io_resolver := Some (fun request _state ->
    (* Extract op and args from either Dict {op, args} or raw List/ListRef (op-symbol args...) *)
    let op, args = match request with
      | Dict d ->
        let o = match Hashtbl.find_opt d "op" with Some (String s) -> s | Some (Symbol s) -> s | _ -> "" in
        let a = match Hashtbl.find_opt d "args" with Some v -> v | None -> Nil in
        (o, a)
      | List (Symbol op_sym :: rest) | ListRef { contents = Symbol op_sym :: rest } -> (op_sym, List rest)
      | List (String op_str :: rest) | ListRef { contents = String op_str :: rest } -> (op_str, List rest)
      | _ -> ("", Nil)
    in
    match op with
    | "text-measure" ->
      let font = match args with
        | List (String f :: _) -> f
        | _ -> "serif" in
      let size = match args with
        | List [_font; Number sz; _text] -> sz
        | List [_font; Number sz] -> sz
        | _ -> 16.0 in
      let text = match args with
        | List [_font; _sz; String t] -> t
        | _ -> "" in
      let (width, height, ascent, descent) = measure_text_otfm font size text in
      let d = Hashtbl.create 4 in
      Hashtbl.replace d "width" (Number width);
      Hashtbl.replace d "height" (Number height);
      Hashtbl.replace d "ascent" (Number ascent);
      Hashtbl.replace d "descent" (Number descent);
      Dict d
    | "io-sleep" | "sleep" -> Nil
    | "import" -> Nil
    | _ ->
      (match Sx_persist_store.handle_op op args with
       | Some resp -> resp
       | None -> Nil));
  (* Response cache — path → full HTTP response string.
     Populated during pre-warm, serves cached responses in <0.1ms.
     Thread-safe: reads are lock-free (Hashtbl.find_opt is atomic for
     immutable values), writes happen only during single-threaded startup. *)
  let response_cache : (string, string) Hashtbl.t = Hashtbl.create 128 in

  let cache_response path =
    match http_render_page env path [] with
    | Some html ->
      let resp = http_response html in
      Hashtbl.replace response_cache path resp;
      Printf.eprintf "[cache] %s → %d bytes\n%!" path (String.length html)
    | None ->
      Printf.eprintf "[cache] %s → not found\n%!" path
  in

  (* Pre-warm + cache key pages — from config or just homepage *)
  let warmup_paths = match get_app_config "warmup-paths" (Keyword "auto") with
    | Keyword "auto" -> [get_app_str "path-prefix" "/sx/"]
    | List l | ListRef { contents = l } ->
      List.filter_map (function String s -> Some s | _ -> None) l
    | _ -> [get_app_str "path-prefix" "/sx/"]
  in
  let t_warm = Unix.gettimeofday () in
  List.iter cache_response warmup_paths;
  let n_cached = Hashtbl.length response_cache in
  Printf.eprintf "[sx-http] Pre-warmed %d pages in %.3fs\n%!"
    n_cached (Unix.gettimeofday () -. t_warm);

  (* Write full response to a socket *)
  let write_response client response =
    let resp_bytes = Bytes.of_string response in
    let total = Bytes.length resp_bytes in
    let written = ref 0 in
    (try
      while !written < total do
        let n = Unix.write client resp_bytes !written (total - !written) in
        written := !written + n
      done
    with Unix.Unix_error _ -> ());
    (try Unix.close client with _ -> ())
  in

  (* Check if request has SX-Request header (SX AJAX navigation — return SX wire format)
     or HX-Request header (htmx AJAX — return rendered HTML). *)
  let has_substring s sub =
    let slen = String.length s and sublen = String.length sub in
    if sublen > slen then false
    else let rec check i = if i > slen - sublen then false
      else if String.sub s i sublen = sub then true else check (i + 1)
    in check 0
  in
  let is_sx_request data =
    let lower = String.lowercase_ascii data in
    has_substring lower "sx-request" || has_substring lower "hx-request"
  in
  let _is_hx_request data =
    let lower = String.lowercase_ascii data in
    has_substring lower "hx-request" && not (has_substring lower "sx-request")
  in

  (* Non-blocking event loop with render worker pool.
     - Main loop: Unix.select on listen socket + all connected clients
     - Cached responses: served immediately from main loop (microseconds)
     - Cache misses: queued to render workers (domain pool)
     - Never blocks on rendering — accept loop always responsive *)

  let n_workers = max 4 (Domain.recommended_domain_count ()) in

  (* Render queue: for cache misses that need full page render *)
  let render_queue : (Unix.file_descr * string * (string * string) list) list ref = ref [] in
  let render_mutex = Mutex.create () in
  let render_cond = Condition.create () in
  let shutdown = ref false in

  (* Render worker: processes cache misses in background *)
  let render_worker _id () =
    while not !shutdown do
      let work =
        Mutex.lock render_mutex;
        while !render_queue = [] && not !shutdown do
          Condition.wait render_cond render_mutex
        done;
        let w = match !render_queue with
          | item :: rest -> render_queue := rest; Some item
          | [] -> None
        in
        Mutex.unlock render_mutex;
        w
      in
      match work with
      | Some (fd, path, headers) ->
        let is_ajax = headers <> [] in
        let is_htmx = List.exists (fun (k,_) -> String.lowercase_ascii k = "hx-request") headers in
        let cache_key = if is_ajax then (if is_htmx then "htmx:" else "ajax:") ^ path else path in
        let response =
          try
            match http_render_page env path headers with
            | Some body ->
              (* htmx requests get HTML; SX requests get SX wire format *)
              let final_body = if is_htmx then
                (try
                  let exprs = Sx_parser.parse_all body in
                  let expr = match exprs with [e] -> e | [] -> Nil | _ -> List (Symbol "<>" :: exprs) in
                  Sx_render.sx_render_to_html env expr env
                with _ -> body)
              else body in
              let ct = if is_ajax && not is_htmx then "text/sx; charset=utf-8"
                       else "text/html; charset=utf-8" in
              let resp = http_response ~content_type:ct final_body in
              Hashtbl.replace response_cache cache_key resp;
              resp
            | None -> http_response ~status:404 "<h1>Not Found</h1>"
          with e ->
            Printf.eprintf "[render] Error for %s: %s\n%!" path (Printexc.to_string e);
            http_response ~status:500 "<h1>Internal Server Error</h1>"
        in
        write_response fd response
      | None -> ()
    done
  in

  (* Fast path: handle a request from the main loop.
     Returns true if handled immediately (cached), false if queued. *)
  let fast_handle fd data is_ajax =
    match parse_http_request data with
    | None -> write_response fd (http_response ~status:400 "Bad Request"); true
    | Some (method_, raw_path) ->
      begin
        let path = url_decode (match String.index_opt raw_path '?' with
          | Some i -> String.sub raw_path 0 i | None -> raw_path) in
        let query = parse_query_string raw_path in
        (* Set request context for primitives *)
        _req_method := method_;
        _req_query := query;
        _req_headers := parse_http_headers data;
        _req_body := (if method_ = "POST" || method_ = "PUT" || method_ = "PATCH"
                      then extract_body data else "");
        (* Parse Cookie header into request_cookies for get-cookie primitive *)
        Hashtbl.clear _request_cookies;
        (match List.assoc_opt "cookie"
           (List.map (fun (k,v) -> (String.lowercase_ascii k, v)) !_req_headers) with
         | Some cookie_str ->
           List.iter (fun pair ->
             let trimmed = String.trim pair in
             (match String.index_opt trimmed '=' with
              | Some i ->
                let k = String.sub trimmed 0 i in
                let v = String.sub trimmed (i+1) (String.length trimmed - i - 1) in
                Hashtbl.replace _request_cookies k v
              | None -> ())
           ) (String.split_on_char ';' cookie_str)
         | None -> ());
        let app_prefix = get_app_str "path-prefix" "/sx/" in
        let app_prefix_bare = if String.length app_prefix > 1
          && app_prefix.[String.length app_prefix - 1] = '/'
          then String.sub app_prefix 0 (String.length app_prefix - 1) else app_prefix in
        let app_home = get_app_str "home-path" app_prefix in
        let debug_prefix = app_prefix ^ "_debug/" in
        let debug_prefix_len = String.length debug_prefix in
        if path = "/" then begin
          write_response fd (http_redirect app_home); true
        end else
        (* Debug endpoint — runs on main thread, no render worker *)
        let raw_decoded = url_decode raw_path in
        if String.length path > debug_prefix_len
           && String.sub path 0 debug_prefix_len = debug_prefix then begin
          let cmd = String.sub raw_decoded debug_prefix_len (String.length raw_decoded - debug_prefix_len) in
          let query_start = try String.index cmd '?' with Not_found -> String.length cmd in
          let action = String.sub cmd 0 query_start in
          let query = if query_start < String.length cmd - 1
            then String.sub cmd (query_start + 1) (String.length cmd - query_start - 1)
            else "" in
          let get_param key =
            let prefix = key ^ "=" in
            let parts = String.split_on_char '&' query in
            match List.find_opt (fun p -> String.length p >= String.length prefix
              && String.sub p 0 (String.length prefix) = prefix) parts with
            | Some p -> url_decode (String.sub p (String.length prefix) (String.length p - String.length prefix))
            | None -> "" in
          let result = match action with
            | "env" ->
              let name = get_param "name" in
              (try
                let v = env_get env name in
                Printf.sprintf "%s = %s\n" name (Sx_runtime.value_to_str (Sx_runtime.type_of v))
              with _ -> Printf.sprintf "%s = UNDEFINED\n" name)
            | "eval" ->
              let expr_s = get_param "expr" in
              (try
                let exprs = Sx_parser.parse_all expr_s in
                let result = List.fold_left (fun _ e -> Sx_ref.eval_expr e (Env env)) Nil exprs in
                Sx_runtime.value_to_str result ^ "\n"
              with e -> Printf.sprintf "ERROR: %s\n" (Printexc.to_string e))
            | "route" ->
              let p = get_param "path" in
              (try
                let handler = env_get env "sx-handle-request" in
                let headers_dict = Hashtbl.create 0 in
                let r = Sx_ref.cek_call handler (List [String p; Dict headers_dict; Env env; Nil]) in
                match r with
                | Dict d ->
                  let page_ast = match Hashtbl.find_opt d "page-ast" with Some v -> v | _ -> Nil in
                  Printf.sprintf "page-ast: %s\n" (Sx_runtime.value_to_str page_ast)
                | _ -> Printf.sprintf "route returned: %s\n" (Sx_runtime.value_to_str r)
              with e -> Printf.sprintf "ERROR: %s\n" (Printexc.to_string e))
            | _ -> "Unknown debug command. Try: env?name=X, eval?expr=X, route?path=X\n"
          in
          write_response fd (http_response ~content_type:"text/plain; charset=utf-8" result); true
        end else
        (* Handler endpoints: paths containing "(api." are handler calls,
           not page renders. Evaluate the handler directly, return fragment. *)
        let is_handler_path =
          let rec has_sub s sub i =
            if i + String.length sub > String.length s then false
            else if String.sub s i (String.length sub) = sub then true
            else has_sub s sub (i + 1) in
          has_sub path "(api." 0 in
        let app_prefix_len = String.length app_prefix in
        let is_sx = path = app_prefix || path = app_prefix_bare
          || (String.length path > app_prefix_len
              && String.sub path 0 app_prefix_len = app_prefix) in
        if is_sx && is_handler_path then begin
          (* Handler dispatch — slug + path param extraction, method-based lookup, param binding *)
          let response =
            try
              let slug, path_param_val =
                let rec find_api s i =
                  if i + 5 > String.length s then ("", None)
                  else if String.sub s i 5 = "(api." then begin
                    let start = i + 5 in
                    if start < String.length s && s.[start] = '(' then begin
                      let inner = start + 1 in
                      let end_ = let rec sc j = if j >= String.length s then j
                        else match s.[j] with '.' | ')' -> j | _ -> sc (j+1) in sc inner in
                      let name = String.sub s inner (end_ - inner) in
                      let pval = if end_ < String.length s && s.[end_] = '.' then
                        let vs = end_ + 1 in
                        let ve = try String.index_from s vs ')' with Not_found -> String.length s in
                        Some (String.sub s vs (ve - vs)) else None in
                      (name, pval)
                    end else begin
                      let end_ = try String.index_from s start ')' with Not_found -> String.length s in
                      (String.sub s start (end_ - start), None)
                    end
                  end else find_api s (i + 1) in
                find_api path 0 in
              let req_method = String.uppercase_ascii !_req_method in
              let try_key k = try let v = env_get env k in
                if v <> Nil then Some (k, v) else None with _ -> None in
              let handler_prefix_list = get_app_list "handler-prefixes"
                ["handler:ex-"; "handler:reactive-"; "handler:"] in
              let prefixes = List.map (fun p -> p ^ slug) handler_prefix_list in
              let suffixes = match req_method with
                | "POST" -> List.concat_map (fun base -> [base; base ^ "-save"; base ^ "-submit"]) prefixes
                | "PUT" | "PATCH" -> List.concat_map (fun base -> [base; base ^ "-put"; base ^ "-save"]) prefixes
                | "DELETE" -> prefixes
                | _ -> List.concat_map (fun base -> [base; base ^ "-form"; base ^ "-status"]) prefixes in
              let found = List.fold_left (fun acc k ->
                match acc with Some _ -> acc | None -> try_key k) None suffixes in
              (match found with
              | None ->
                http_response ~status:404 ~content_type:"text/sx; charset=utf-8"
                  (Printf.sprintf "(div :class \"p-4 text-rose-600\" \"Handler not found: %s\")" (List.hd prefixes))
              | Some (_hk, hdef) ->
                (match path_param_val with
                 | Some pval ->
                   let ppath = (match hdef with Dict d ->
                     (match Hashtbl.find_opt d "path" with Some (String s) -> s | _ -> "") | _ -> "") in
                   let pname = let rec f s i = if i + 4 > String.length s then "id"
                     else if String.sub s i 4 = "<sx:" then
                       let gt = try String.index_from s (i+4) '>' with Not_found -> String.length s in
                       String.map (fun c -> if c = '_' then '-' else c) (String.sub s (i+4) (gt-i-4))
                     else f s (i+1) in f ppath 0 in
                   let sep = if !_req_query = "" then "" else "&" in
                   _req_query := !_req_query ^ sep ^ pname ^ "=" ^ pval
                 | None -> ());
                let body = (match hdef with Dict d ->
                  (match Hashtbl.find_opt d "body" with Some v -> v | None -> Nil) | _ -> Nil) in
                let params = (match hdef with Dict d ->
                  (match Hashtbl.find_opt d "params" with
                   | Some (List p) -> p | Some (ListRef r) -> !r | _ -> []) | _ -> []) in
                let param_names = List.filter_map (fun p -> match p with
                  | Symbol s when s <> "&key" && s <> "&rest" -> Some s
                  | String s when s <> "&key" && s <> "&rest" -> Some s
                  | _ -> None) params in
                (* Bind handler params in env before aser.
                   Try request-form first for POST (request-arg returns "" as default,
                   which is truthy in SX, preventing or-fallback to request-form). *)
                let is_post = req_method = "POST" || req_method = "PUT" || req_method = "PATCH" in
                List.iter (fun n ->
                  let v = try
                    let form_val = Sx_ref.eval_expr (List [Symbol "request-form"; String n]) (Env env) in
                    let arg_val = Sx_ref.eval_expr (List [Symbol "request-arg"; String n]) (Env env) in
                    if is_post then (if form_val <> String "" then form_val else arg_val)
                    else (if arg_val <> Nil then arg_val else form_val)
                    with _ -> Nil in
                  ignore (env_bind env n v)
                ) param_names;
                let aser_call = List [Symbol "aser"; List [Symbol "quote"; body]; Env env] in
                let body_str = match Sx_ref.eval_expr aser_call (Env env) with
                  | String s | SxExpr s -> s | v -> Sx_types.inspect v in
                let status = !_pending_response_status in
                (* HX-Request → render to HTML for htmx; otherwise SX wire format *)
                let is_hx = has_substring (String.lowercase_ascii data) "hx-request" in
                if is_hx then
                  let html = try
                    let exprs = Sx_parser.parse_all body_str in
                    let expr = match exprs with [e] -> e | [] -> Nil | _ -> List (Symbol "<>" :: exprs) in
                    Sx_render.sx_render_to_html env expr env
                  with _ -> body_str in
                  http_response ~status ~content_type:"text/html; charset=utf-8" html
                else
                  http_response ~status ~content_type:"text/sx; charset=utf-8" body_str)
            with e ->
              Printf.eprintf "[handler] Error for %s: %s\n%!" path (Printexc.to_string e);
              http_response ~status:500 ~content_type:"text/sx; charset=utf-8"
                (Printf.sprintf "(div :class \"p-4 text-rose-600\" \"Handler error: %s\")"
                  (escape_sx_string (Printexc.to_string e)))
          in
          write_response fd response; true
        end else if is_sx && String.length path > 6 && String.sub path 0 6 = "/sx/h/" then begin
          let rest = String.sub path 6 (String.length path - 6) in
          (* WASM companion assets: /sx/h/sx_browser.bc.wasm.assets/... → /static/wasm/... *)
          if String.length rest > 26 && String.sub rest 0 26 = "sx_browser.bc.wasm.assets/" then begin
            let asset_path = "/static/wasm/" ^ rest in
            write_response fd (serve_static_file static_dir asset_path); true
          end else begin
          (* Content-addressed definition endpoint: /sx/h/{hash} *)
          let hash = rest in
          let resp = match !_hash_index with
            | Some idx ->
              (match Hashtbl.find_opt idx.hash_to_def hash with
               | Some def ->
                 let name = match Hashtbl.find_opt idx.hash_to_name hash with
                   | Some n -> n | None -> "?" in
                 (* Detect content type from filename *)
                 let is_js = Filename.check_suffix name ".js" in
                 let ct = if is_js then "application/javascript"
                          else "text/sx; charset=utf-8" in
                 let body = if is_js then def
                            else Printf.sprintf ";; %s\n%s" name def in
                 Printf.sprintf
                   "HTTP/1.1 200 OK\r\n\
                    Content-Type: %s\r\n\
                    Content-Length: %d\r\n\
                    Cache-Control: public, max-age=31536000, immutable\r\n\
                    Access-Control-Allow-Origin: *\r\n\
                    Connection: keep-alive\r\n\r\n%s"
                   ct (String.length body) body
               | None ->
                 http_response ~status:404 "unknown hash")
            | None ->
              http_response ~status:503 "hash index not built"
          in
          write_response fd resp; true
          end (* inner begin for hash vs wasm-assets *)
        end else if is_sx then begin
          (* Streaming pages: chunked transfer, bypass cache.
             Convert SX URL to flat defpage path:
               /sx/(geography.(isomorphism.streaming)) → /geography/isomorphism/streaming
             Strip prefix, remove parens, replace dots with slashes. *)
          let page_path =
            let raw = if String.length path > app_prefix_len
              && String.sub path 0 app_prefix_len = app_prefix
              then String.sub path app_prefix_len (String.length path - app_prefix_len)
              else path in
            let buf = Buffer.create (String.length raw + 1) in
            Buffer.add_char buf '/';
            String.iter (fun c -> match c with
              | '(' | ')' -> ()
              | '.' -> Buffer.add_char buf '/'
              | c -> Buffer.add_char buf c
            ) raw;
            Buffer.contents buf in
          let stream_page_name = Hashtbl.find_opt _streaming_pages page_path in
          if stream_page_name <> None then begin
            let sname = match stream_page_name with Some s -> s | None -> "" in
            if is_ajax then begin
              (* AJAX streaming: evaluate shell + data + content synchronously,
                 return fully-resolved SX wire format (no chunked transfer). *)
              ignore (env_bind env "expand-components?" (NativeFn ("expand-components?", fun _args -> Bool true)));
              let response = try
                let page_def = match env_get env ("page:" ^ sname) with Dict d -> d | _ -> raise Not_found in
                let shell_ast = match Hashtbl.find_opt page_def "shell" with Some v -> v | None -> Nil in
                let data_ast = match Hashtbl.find_opt page_def "data" with Some v -> v | None -> Nil in
                let content_ast = match Hashtbl.find_opt page_def "content" with Some v -> v | None -> Nil in
                (* Evaluate shell — provides nav + suspense skeletons *)
                let shell_sx =
                  let call = List [Symbol "aser"; List [Symbol "quote"; shell_ast]; Env env] in
                  match Sx_ref.eval_expr call (Env env) with
                  | String s | SxExpr s -> s | v -> serialize_value v in
                (* If we have data+content, resolve all slots and embed as OOB swaps *)
                let resolve_oob = if data_ast <> Nil && content_ast <> Nil then begin
                  let data_result = try Sx_ref.eval_expr data_ast (Env env) with _ -> Nil in
                  let extract_sid items = List.map (fun item ->
                    let sid = match item with Dict d ->
                      (match Hashtbl.find_opt d "stream-id" with Some (String s) -> s | _ -> "stream-content")
                      | _ -> "stream-content" in (item, sid)) items in
                  let data_items = match data_result with
                    | Dict _ -> [(data_result, "stream-content")]
                    | List items -> extract_sid items
                    | ListRef { contents = items } -> extract_sid items
                    | _ -> [] in
                  let buf = Buffer.create 1024 in
                  List.iter (fun (item, stream_id) ->
                    try
                      let cenv = { bindings = Hashtbl.create 16; parent = Some env } in
                      (match item with Dict d ->
                        Hashtbl.iter (fun k v ->
                          if k <> "stream-id" && k <> "__type" then begin
                            let nk = String.map (fun c -> if c = '_' then '-' else c) k in
                            ignore (env_bind cenv nk v);
                            if nk <> k then ignore (env_bind cenv k v)
                          end) d | _ -> ());
                      let cr = let call = List [Symbol "aser"; List [Symbol "quote"; content_ast]; Env cenv] in
                        Sx_ref.eval_expr call (Env cenv) in
                      let sx_src = match cr with String s | SxExpr s -> s | v -> serialize_value v in
                      (* OOB swap: replace suspense placeholder contents *)
                      Buffer.add_string buf
                        (Printf.sprintf "(div :id \"sx-suspense-%s\" :data-suspense \"%s\" :sx-swap-oob \"innerHTML\" :style \"display:contents\" %s)"
                          stream_id stream_id sx_src)
                    with e ->
                      Printf.eprintf "[sx-stream-ajax] resolve error %s: %s\n%!" stream_id (Printexc.to_string e)
                  ) data_items;
                  Buffer.contents buf
                end else "" in
                http_response ~content_type:"text/sx; charset=utf-8" (shell_sx ^ resolve_oob)
              with e ->
                Printf.eprintf "[sx-stream-ajax] error for %s: %s\n%!" path (Printexc.to_string e);
                http_response ~status:500 ~content_type:"text/sx; charset=utf-8"
                  (Printf.sprintf "(div :class \"p-4 text-rose-600\" \"Streaming page error: %s\")"
                    (escape_sx_string (Printexc.to_string e)))
              in
              write_response fd response; true
            end else begin
              (* Full page streaming: run in a thread so the accept loop
                 stays unblocked for concurrent requests. *)
              let _t = Thread.create (fun () ->
                (try http_render_page_streaming env path [] fd sname
                 with Exit -> ()
                    | e -> Printf.eprintf "[sx-stream] unexpected error for %s: %s\n%!" path (Printexc.to_string e);
                           (try Unix.close fd with _ -> ()))
              ) () in
              true
            end
          end else
          let has_state_cookie = Hashtbl.mem _request_cookies "sx-home-stepper" in
          let is_htmx_req = is_ajax && has_substring (String.lowercase_ascii data) "hx-request" in
          let cache_key = if is_htmx_req then "htmx:" ^ path
                          else if is_ajax then "ajax:" ^ path else path in
          match (if has_state_cookie || is_htmx_req then None
                 else Hashtbl.find_opt response_cache cache_key) with
          | Some cached -> write_response fd cached; true
          | None ->
            if is_ajax then begin
              (* AJAX: render on main thread — aser only, fast, no SSR.
                 Avoids queueing behind slow full-page renders.
                 HX-Request (htmx) gets HTML; SX-Request gets SX wire format. *)
              let headers = parse_http_headers data in
              let is_htmx = List.exists (fun (k,_) ->
                String.lowercase_ascii k = "hx-request") headers in
              let response =
                try match http_render_page env path headers with
                  | Some body ->
                    let final_body = if is_htmx then
                      (try
                        let exprs = Sx_parser.parse_all body in
                        let expr = match exprs with [e] -> e | [] -> Nil | _ -> List (Symbol "<>" :: exprs) in
                        Sx_render.sx_render_to_html env expr env
                      with _ -> body)
                    else body in
                    let ct = if is_htmx then "text/html; charset=utf-8"
                             else "text/sx; charset=utf-8" in
                    let resp = http_response ~content_type:ct final_body in
                    if not is_htmx then Hashtbl.replace response_cache cache_key resp;
                    resp
                  | None -> http_response ~status:404
                    "(div :class \"p-8\" (h2 :class \"text-rose-600 font-semibold\" \"Page not found\") (p :class \"text-stone-500\" \"No route matched this path\"))"
                with e ->
                  Printf.eprintf "[ajax] Error for %s: %s\n%!" path (Printexc.to_string e);
                  http_response ~status:500
                    (Printf.sprintf "(div :class \"p-8\" (h2 :class \"text-rose-600 font-semibold\" \"Render Error\") (pre :class \"text-sm bg-stone-100 p-4 rounded\" \"%s\"))"
                      (escape_sx_string (Printexc.to_string e)))
              in
              write_response fd response; true
            end else if has_state_cookie then begin
              (* State cookie present — render on main thread so get-cookie works.
                 Don't cache: response varies by cookie value. *)
              let response =
                try match http_render_page env path [] with
                  | Some body -> http_response body
                  | None -> http_response ~status:404 "<h1>Not Found</h1>"
                with e ->
                  Printf.eprintf "[render] Cookie render error for %s: %s\n%!" path (Printexc.to_string e);
                  http_response ~status:500 "<h1>Error</h1>"
              in
              write_response fd response; true
            end else begin
              (* Full page: queue to render worker *)
              Mutex.lock render_mutex;
              render_queue := !render_queue @ [(fd, path, [])];
              Condition.signal render_cond;
              Mutex.unlock render_mutex;
              false
            end
        end else if String.length path > 8 && String.sub path 0 8 = "/static/" then begin
          write_response fd (serve_static_file static_dir path); true
        end else begin
          write_response fd (http_response ~status:404 "<h1>Not Found</h1>"); true
        end
      end
  in

  (* Spawn render workers *)
  let workers = Array.init n_workers (fun id ->
    Domain.spawn (render_worker id)) in

  (* Start TCP server — non-blocking accept loop *)
  let sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
  Unix.setsockopt sock Unix.SO_REUSEADDR true;
  Unix.bind sock (Unix.ADDR_INET (Unix.inet_addr_any, port));
  Unix.listen sock 1024;
  Printf.eprintf "[sx-http] Listening on port %d (%d render workers, non-blocking)\n%!" port n_workers;

  (* Auto-restart: check if binary has changed every N requests *)
  let binary_path = Sys.executable_name in
  let binary_mtime = try (Unix.stat binary_path).Unix.st_mtime with _ -> 0.0 in
  let request_count = ref 0 in
  let check_interval = 10 in  (* check every 10 requests *)
  let check_restart () =
    incr request_count;
    if !request_count mod check_interval = 0 then begin
      let current_mtime = try (Unix.stat binary_path).Unix.st_mtime with _ -> 0.0 in
      if current_mtime > binary_mtime then begin
        Printf.eprintf "[sx-http] Binary changed, restarting...\n%!";
        (* Close listen socket, then exec self *)
        Unix.close sock;
        Unix.execv binary_path (Array.of_list (Array.to_list Sys.argv))
      end
    end
  in

  (try
    while true do
      (* Accept a connection *)
      let (client, _addr) = Unix.accept sock in
      check_restart ();
      (* Read request — non-blocking: set a short timeout *)
      Unix.setsockopt_float client Unix.SO_RCVTIMEO 5.0;
      Unix.setsockopt_float client Unix.SO_SNDTIMEO 10.0;
      let buf = Buffer.create 8192 in
      let tmp = Bytes.create 8192 in
      let n = try Unix.read client tmp 0 8192 with _ -> 0 in
      Buffer.add_subbytes buf tmp 0 n;
      (* For POST: ensure full body is read based on Content-Length *)
      if n > 0 then begin
        let initial = Buffer.contents buf in
        let header_end =
          let rec find s i = if i + 4 > String.length s then -1
            else if String.sub s i 4 = "\r\n\r\n" then i + 4
            else find s (i + 1) in find initial 0 in
        if header_end > 0 then begin
          (* Parse Content-Length from headers *)
          let headers_str = String.lowercase_ascii (String.sub initial 0 header_end) in
          let content_length =
            let rec find_cl s i =
              if i + 16 > String.length s then 0
              else if String.sub s i 16 = "content-length: " then
                let start = i + 16 in
                let end_ = try String.index_from s start '\r' with Not_found ->
                  try String.index_from s start '\n' with Not_found -> String.length s in
                (try int_of_string (String.trim (String.sub s start (end_ - start))) with _ -> 0)
              else find_cl s (i + 1) in find_cl headers_str 0 in
          let body_so_far = String.length initial - header_end in
          let remaining = content_length - body_so_far in
          if remaining > 0 then begin
            let body_buf = Bytes.create remaining in
            let read_so_far = ref 0 in
            while !read_so_far < remaining do
              let r = try Unix.read client body_buf !read_so_far (remaining - !read_so_far)
                      with _ -> 0 in
              if r = 0 then read_so_far := remaining  (* EOF *)
              else read_so_far := !read_so_far + r
            done;
            Buffer.add_subbytes buf body_buf 0 !read_so_far
          end
        end
      end;
      let n = Buffer.length buf in
      if n > 0 then begin
        let data = Buffer.contents buf in
        let is_ajax = is_sx_request data in
        if is_ajax then Printf.eprintf "[sx-http] AJAX request detected\n%!";
        let handled =
          try fast_handle client data is_ajax
          with e ->
            Printf.eprintf "[sx-http] Error: %s\n%!" (Printexc.to_string e);
            write_response client (http_response ~status:500 "<h1>Internal Server Error</h1>");
            true
        in
        ignore handled
      end else
        (try Unix.close client with _ -> ())
    done
  with _ ->
    shutdown := true;
    Condition.broadcast render_cond;
    Array.iter Domain.join workers)


(* --site mode: full site env (same setup as HTTP) + epoch protocol on stdin/stdout.
   No HTTP server, no ports. Used by Playwright sandbox tests to render pages
   as a pure function: URL → HTML via the render-page epoch command. *)
let site_mode () =
  let env = make_server_env () in
  http_setup_declarative_stubs env;
  http_setup_platform_constructors env;
  http_setup_page_helpers env;
  (* Load all .sx files — same as http_mode *)
  let project_dir = try Sys.getenv "SX_PROJECT_DIR" with Not_found ->
    Sys.getcwd () in
  let spec_base = project_dir ^ "/spec" in
  let lib_base = project_dir ^ "/lib" in
  let web_base = project_dir ^ "/web" in
  let shared_sx = try Sys.getenv "SX_SHARED_DIR" with Not_found ->
    let docker_path = project_dir ^ "/shared_sx" in
    let dev_path = project_dir ^ "/shared/sx/templates" in
    if Sys.file_exists docker_path then docker_path else dev_path in
  let sx_sx = try Sys.getenv "SX_COMPONENTS_DIR" with Not_found ->
    let docker_path = project_dir ^ "/components" in
    let dev_path = project_dir ^ "/sx/sx" in
    if Sys.file_exists docker_path then docker_path else dev_path in
  let static_dir = try Sys.getenv "SX_STATIC_DIR" with Not_found ->
    let docker_path = project_dir ^ "/static" in
    let dev_path = project_dir ^ "/shared/static" in
    if Sys.file_exists docker_path then docker_path else dev_path in
  ignore (env_bind env "_project-dir" (String project_dir));
  ignore (env_bind env "_spec-dir" (String spec_base));
  ignore (env_bind env "_lib-dir" (String lib_base));
  ignore (env_bind env "_web-dir" (String web_base));
  _font_base := static_dir ^ "/fonts";
  _import_env := Some env;
  let core_files = [
    spec_base ^ "/parser.sx"; spec_base ^ "/render.sx"; spec_base ^ "/signals.sx";
    lib_base ^ "/compiler.sx";
    web_base ^ "/adapter-html.sx"; web_base ^ "/adapter-sx.sx";
    web_base ^ "/io.sx"; web_base ^ "/web-forms.sx"; web_base ^ "/engine.sx";
    web_base ^ "/request-handler.sx"; web_base ^ "/page-helpers.sx";
  ] in
  http_load_files env core_files;
  let skip_files = ["primitives.sx"; "types.sx"; "boundary.sx";
                     "harness.sx"; "eval-rules.sx"; "vm-inline.sx"] in
  let skip_dirs = ["tests"; "test"; "plans"; "essays"; "spec"; "client-libs"] in
  let rec load_dir ?(base="") dir =
    if Sys.file_exists dir && Sys.is_directory dir then begin
      let entries = Sys.readdir dir in
      Array.sort String.compare entries;
      Array.iter (fun f ->
        let path = dir ^ "/" ^ f in
        if Sys.is_directory path then begin
          if not (List.mem f skip_dirs) then load_dir ~base path
        end
        else if Filename.check_suffix f ".sx"
                && not (List.mem f skip_files)
                && not (String.length f > 5 && String.sub f 0 5 = "test-")
                && not (Filename.check_suffix f ".test.sx") then
          http_load_files ~base_dir:base env [path]
      ) entries
    end
  in
  load_dir lib_base;
  load_dir shared_sx;
  let sx_sxc = try Sys.getenv "SX_SXC_DIR" with Not_found ->
    let docker_path = project_dir ^ "/sxc" in
    let dev_path = project_dir ^ "/sx/sxc" in
    if Sys.file_exists docker_path then docker_path else dev_path in
  load_dir ~base:sx_sxc sx_sxc;
  load_dir ~base:sx_sx sx_sx;
  (* IO registry + app config *)
  (try match env_get env "__io-registry" with
    | Dict registry ->
      let batchable = Hashtbl.fold (fun name entry acc ->
        match entry with
        | Dict d -> (match Hashtbl.find_opt d "batchable" with
          | Some (Bool true) -> name :: acc | _ -> acc)
        | _ -> acc) registry [] in
      if batchable <> [] then batchable_helpers := batchable
    | _ -> ()
  with _ -> ());
  (try match env_get env "__app-config" with
    | Dict d -> _app_config := Some d
    | _ -> ()
  with _ -> ());
  (* SSR overrides *)
  let bind name fn = ignore (env_bind env name (NativeFn (name, fn))) in
  bind "effect" (fun _args -> Nil);
  bind "register-in-scope" (fun _args -> Nil);
  rebind_host_extensions env;
  ignore (env_bind env "assoc" (NativeFn ("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"))));
  ignore (env_bind env "expand-components?" (NativeFn ("expand-components?", fun _args -> Bool true)));
  (* Shell statics for render-page *)
  http_inject_shell_statics env static_dir sx_sxc;
  (* No JIT in site mode — the lazy JIT hook can loop on complex ASTs
     (known bug: project_jit_bytecode_bug.md). Pure CEK is slower but
     correct. First renders take ~2-5s, subsequent ~0.5-1s with caching. *)
  Printf.eprintf "[site] Ready — epoch protocol on stdin/stdout\n%!";
  send "(ready)";
  (* nav-urls helper — walk sx-nav-tree, collect (href label) pairs *)
  let nav_urls () =
    let tree = env_get env "sx-nav-tree" in
    let urls = ref [] in
    let rec walk node = match node with
      | Dict d ->
        let href = match Hashtbl.find_opt d "href" with Some (String s) -> s | _ -> "" in
        let label = match Hashtbl.find_opt d "label" with Some (String s) -> s | _ -> "" in
        if href <> "" then urls := (href, label) :: !urls;
        (match Hashtbl.find_opt d "children" with
         | Some (List items) | Some (ListRef { contents = items }) ->
           List.iter walk items
         | _ -> ())
      | _ -> ()
    in
    walk tree;
    let items = List.rev !urls in
    "(" ^ String.concat " " (List.map (fun (h, l) ->
      Printf.sprintf "(\"%s\" \"%s\")" (escape_sx_string h) (escape_sx_string l)
    ) items) ^ ")"
  in
  (* Epoch protocol loop *)
  (try
    while true do
      match read_line_blocking () with
      | None -> exit 0
      | Some line ->
        let line = String.trim line in
        if line = "" then ()
        else begin
          let exprs = Sx_parser.parse_all line in
          match exprs with
          | [List [Symbol "epoch"; Number n]] ->
            current_epoch := int_of_float n
          | [List [Symbol "epoch"; Integer n]] ->
            current_epoch := n
          (* render-page: full SSR pipeline — URL → complete HTML *)
          | [List [Symbol "render-page"; String path]] ->
            (try match http_render_page env path [] with
              | Some html -> send_ok_blob html
              | None -> send_error ("render-page: no route for " ^ path)
            with e -> send_error ("render-page: " ^ Printexc.to_string e))
          (* nav-urls: flat list of (href label) from nav tree *)
          | [List [Symbol "nav-urls"]] ->
            (try send_ok_raw (nav_urls ())
            with e -> send_error ("nav-urls: " ^ Printexc.to_string e))
          | [cmd] -> dispatch env cmd
          | _ -> send_error ("Expected single command, got " ^ string_of_int (List.length exprs))
        end
    done
  with End_of_file -> ())

let () =
  (* Check for CLI mode flags *)
  let args = Array.to_list Sys.argv in
  if List.mem "--test" args then test_mode ()
  else if List.mem "--render" args then cli_mode "render"
  else if List.mem "--aser-slot" args then cli_mode "aser-slot"
  else if List.mem "--aser" args then cli_mode "aser"
  else if List.mem "--site" args then site_mode ()
  else if List.mem "--http" args then begin
    (* Extract port: --http PORT *)
    let port = ref 8014 in
    let rec find = function
      | "--http" :: p :: _ -> (try port := int_of_string p with _ -> ())
      | _ :: rest -> find rest
      | [] -> ()
    in find args;
    http_mode !port
  end
  else begin
    (* Normal persistent server mode *)
    let env = make_server_env () in
    send "(ready)";
    (* Main command loop *)
    try
      while true do
        match read_line_blocking () with
        | None -> exit 0  (* stdin closed *)
        | Some line ->
          let line = String.trim line in
          if line = "" then ()  (* skip blank lines *)
          (* Discard stale io-responses from previous requests. *)
          else if String.length line > 14
               && String.sub line 0 14 = "(io-response " then
            Printf.eprintf "[sx-server] discarding stale io-response (%d chars)\n%!"
              (String.length line)
          else begin
            let exprs = Sx_parser.parse_all line in
            match exprs with
            (* Epoch marker: (epoch N) — set current epoch, read next command *)
            | [List [Symbol "epoch"; Number n]] ->
              current_epoch := int_of_float n
            | [List [Symbol "epoch"; Integer n]] ->
              current_epoch := n
            | [cmd] -> dispatch env cmd
            | _ -> send_error ("Expected single command, got " ^ string_of_int (List.length exprs))
          end
      done
    with
    | End_of_file -> ()
  end
