(** MCP server for SX tree tools — structural reading and editing of .sx files.

    Stdio JSON-RPC transport following the MCP specification.
    Loads tree-tools.sx into the SX evaluator and exposes comprehension
    and editing functions as MCP tools. *)

open Sx_types

(* ------------------------------------------------------------------ *)
(* Hot-reload: re-exec ourselves when the binary has been rebuilt       *)
(* ------------------------------------------------------------------ *)

(* ------------------------------------------------------------------ *)
(* File-based logging for debugging MCP failures                       *)
(* ------------------------------------------------------------------ *)

let log_file = "/tmp/mcp-tree.log"

let log_msg fmt =
  Printf.ksprintf (fun msg ->
    let oc = open_out_gen [Open_append; Open_creat; Open_wronly] 0o644 log_file in
    let t = Unix.gettimeofday () in
    let tm = Unix.localtime t in
    Printf.fprintf oc "[%04d-%02d-%02d %02d:%02d:%02d.%03d] %s\n"
      (1900 + tm.Unix.tm_year) (tm.Unix.tm_mon + 1) tm.Unix.tm_mday
      tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec
      (int_of_float (mod_float (t *. 1000.0) 1000.0))
      msg;
    close_out oc
  ) fmt

let exe_path =
  try Unix.readlink "/proc/self/exe"
  with _ -> Sys.executable_name

let binary_mtime =
  ref (try (Unix.stat exe_path).Unix.st_mtime with _ -> 0.0)

let check_hot_reload () =
  try
    let cur = (Unix.stat exe_path).Unix.st_mtime in
    if cur > !binary_mtime then begin
      Printf.eprintf "[mcp] Binary updated (%.0f -> %.0f), hot-reloading...\n%!" !binary_mtime cur;
      Unix.execv exe_path [| exe_path |]
    end
  with _ -> ()

(* ------------------------------------------------------------------ *)
(* Robust JSON helpers — MCP clients send ints as strings or null      *)
(* ------------------------------------------------------------------ *)

let to_int_safe json =
  match json with
  | `Int n -> Some n
  | `Float f -> Some (int_of_float f)
  | `String s -> (try Some (int_of_string s) with _ -> None)
  | `Null -> None
  | _ -> None

let to_int_or ~default json =
  match to_int_safe json with Some n -> n | None -> default

(* ------------------------------------------------------------------ *)
(* SX evaluator setup — minimal env for parser + tree-tools            *)
(* ------------------------------------------------------------------ *)

let env = ref (make_env ())

let load_sx_file e path =
  let src = In_channel.with_open_text path In_channel.input_all in
  let exprs = Sx_parser.parse_all src in
  List.iter (fun expr ->
    try ignore (Sx_ref.cek_call
      (NativeFn ("eval", fun args ->
        match args with
        | [ex] -> Sx_ref.eval_expr ex (Env e)
        | _ -> Nil))
      (List [expr]))
    with _ ->
      (* Fallback: direct eval *)
      ignore (Sx_ref.eval_expr expr (Env e))
  ) exprs

(* ------------------------------------------------------------------ *)
(* File mtime cache — like a running Lisp image, only reload changed   *)
(* ------------------------------------------------------------------ *)

let file_mtimes : (string, float) Hashtbl.t = Hashtbl.create 32

let smart_load_file e path =
  let abs = if Filename.is_relative path then Filename.concat (Sys.getcwd ()) path else path in
  let cur_mtime = (Unix.stat abs).Unix.st_mtime in
  let cached = try Some (Hashtbl.find file_mtimes abs) with Not_found -> None in
  match cached with
  | Some prev when prev >= cur_mtime -> false  (* unchanged *)
  | _ ->
    load_sx_file e abs;
    Hashtbl.replace file_mtimes abs cur_mtime;
    true  (* loaded *)

let smart_load_files e paths =
  let loaded = ref [] in
  List.iter (fun path ->
    try
      if smart_load_file e path then
        loaded := path :: !loaded
    with exn ->
      loaded := (Printf.sprintf "%s (error: %s)" path (Printexc.to_string exn)) :: !loaded
  ) paths;
  List.rev !loaded

(* JIT infrastructure — shared VM globals table, kept in sync via env_bind hook *)
let _mcp_vm_globals : (string, value) Hashtbl.t = Hashtbl.create 2048
let _jit_warned : (string, bool) Hashtbl.t = Hashtbl.create 32

let register_mcp_jit_hook () =
  Sx_runtime._jit_try_call_fn := Some (fun f args ->
    match f with
    | Lambda l ->
      let fn_name = match l.l_name with Some n -> n | None -> "" in
      if fn_name <> "" && Hashtbl.mem _jit_warned fn_name then None
      else
      (match l.l_compiled with
       | Some cl when not (Sx_vm.is_jit_failed cl) ->
         (* Already compiled — run via VM. Skip during compilation. *)
         if !(Sx_vm._jit_compiling) then None
         else
         (try Some (Sx_vm.call_closure_reuse cl args)
          with
          | Sx_vm.VmSuspended _ as e -> raise e  (* let Fix 1 in jit_try_call handle it *)
          | e ->
            if not (Hashtbl.mem _jit_warned fn_name) then begin
              Hashtbl.replace _jit_warned fn_name true;
              Printf.eprintf "[mcp-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 ->
         (* Only block NEW compilations during _jit_compiling *)
         if !(Sx_vm._jit_compiling) then None
         else
         let compiled = Sx_vm.jit_compile_lambda l _mcp_vm_globals in
         (match compiled with
           | Some cl ->
             l.l_compiled <- Some cl;
             (try Some (Sx_vm.call_closure_reuse cl args)
              with
              | Sx_vm.VmSuspended _ as e -> raise e
              | e ->
                Printf.eprintf "[mcp-jit] %s first-call fallback: %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 -> None))
    | _ -> None)

(* ------------------------------------------------------------------ *)
(* Native tree-tools helpers — avoid CEK overhead on big trees.       *)
(* Mirror the SX semantics from lib/tree-tools.sx but run as direct   *)
(* OCaml recursion. Used by read-subtree / validate / find-all /      *)
(* find-across / comp-usage handlers.                                 *)
(* ------------------------------------------------------------------ *)

let native_path_str path =
  "[" ^ String.concat "," (List.map string_of_int path) ^ "]"

let rec native_node_display (node : value) : string =
  match node with
  | Nil -> "nil"
  | Symbol s -> s
  | Keyword k -> ":" ^ k
  | String s -> "\"" ^ s ^ "\""
  | Number n ->
    if Float.is_integer n then string_of_int (int_of_float n)
    else Printf.sprintf "%g" n
  | Bool true -> "true"
  | Bool false -> "false"
  | List [] | ListRef { contents = [] } -> "()"
  | List (h :: t) | ListRef { contents = h :: t } ->
    if t = [] then "(" ^ native_node_display h ^ ")"
    else "(" ^ native_node_display h ^ " ...)"
  | Dict _ -> "{...}"
  | v -> Sx_runtime.value_to_str v

(* node-summary-short: "(head)" for singletons, "(head second ...)" for >3,
   "(all node-displays joined)" for small lists. Mirrors lib/tree-tools.sx. *)
let native_node_summary_short node =
  match node with
  | List [] | ListRef { contents = [] } -> "()"
  | List items | ListRef { contents = items } ->
    let n = List.length items in
    if n > 3 then
      let head = native_node_display (List.hd items) in
      let second = native_node_display (List.nth items 1) in
      Printf.sprintf "(%s %s ...)" head second
    else
      "(" ^ String.concat " " (List.map native_node_display items) ^ ")"
  | _ -> native_node_display node

let rec native_node_matches node pattern =
  match node with
  | Symbol s | String s ->
    (try ignore (Str.search_forward (Str.regexp_string pattern) s 0); true
     with Not_found -> false)
  | List items | ListRef { contents = items } ->
    List.exists (fun c -> native_node_matches c pattern) items
  | _ -> false

(* Raw find: returns reversed list of (path, summary) pairs — caller reverses. *)
let native_find_all_raw exprs pattern =
  let nodes = match exprs with
    | List xs | ListRef { contents = xs } -> xs
    | x -> [x] in
  let acc = ref [] in
  let rec go node path =
    if native_node_matches node pattern then
      acc := (List.rev path, native_node_summary_short node) :: !acc;
    match node with
    | List items | ListRef { contents = items } ->
      List.iteri (fun i child -> go child (i :: path)) items
    | _ -> ()
  in
  List.iteri (fun i node -> go node [i]) nodes;
  List.rev !acc

(* SX-value-returning wrapper — kept for any SX code that still calls find-all. *)
let native_find_all_sx exprs pattern =
  let pairs = native_find_all_raw exprs pattern in
  List (List.map (fun (path, summary) ->
    List [List (List.map (fun i -> Number (float_of_int i)) path);
          String summary]
  ) pairs)

(* navigate: walk a tree by a list of indices. Wraps exprs into a list on entry
   (mirrors SX navigate). Returns Nil if any index is out of range. *)
let native_navigate exprs path =
  let init = match exprs with
    | List _ | ListRef _ -> exprs
    | x -> List [x] in
  let rec step current = function
    | [] -> current
    | i :: rest ->
      (match current with
       | List items when i >= 0 && i < List.length items ->
         step (List.nth items i) rest
       | ListRef { contents = items } when i >= 0 && i < List.length items ->
         step (List.nth items i) rest
       | _ -> Nil) in
  step init path

(* annotate-tree: render a list of exprs as an indented path-annotated string.
   Mirrors the `annotate-node` dispatch from lib/tree-tools.sx:
     - small lists (len<=4, no list children) render inline
     - others render head on first line, children indented, closing ")"
   Path annotations use [i,j,k,...] form. *)
let native_annotate_tree exprs =
  let nodes = match exprs with
    | List xs | ListRef { contents = xs } -> xs
    | x -> [x] in
  let out = Buffer.create 1024 in
  let first = ref true in
  let emit s =
    if !first then first := false else Buffer.add_char out '\n';
    Buffer.add_string out s in
  let rec ann node path depth =
    let indent = String.make (depth * 2) ' ' in
    let label = native_path_str (List.rev path) in
    match node with
    | List [] | ListRef { contents = [] } ->
      emit (indent ^ label ^ " ()")
    | List items | ListRef { contents = items } ->
      let n = List.length items in
      let rest = List.tl items in
      let any_child_list = List.exists
        (fun c -> match c with List _ | ListRef _ -> true | _ -> false) rest in
      if n <= 4 && not any_child_list then
        emit (indent ^ label ^ " (" ^
              String.concat " " (List.map native_node_display items) ^ ")")
      else begin
        let head_str = native_node_display (List.hd items) in
        emit (indent ^ label ^ " (" ^ head_str);
        List.iteri (fun i child ->
          if i > 0 then ann child (i :: path) (depth + 1)
        ) items;
        emit (indent ^ "  )")
      end
    | _ ->
      emit (indent ^ label ^ " " ^ native_node_display node)
  in
  List.iteri (fun i node -> ann node [i] 0) nodes;
  Buffer.contents out

let native_read_subtree exprs path =
  let node = native_navigate exprs path in
  match node with
  | Nil -> "Error: path " ^ native_path_str path ^ " not found"
  | _ -> native_annotate_tree (List [node])

(* validate: walk the tree, emit WARNING for malformed letrec bindings and
   ERROR for defisland/defcomp with fewer than 3 args. *)
let native_validate exprs =
  let errors = ref [] in
  let emit s = errors := s :: !errors in
  let rec go node path =
    (match node with
     | List items | ListRef { contents = items } ->
       (match items with
        | [] -> ()
        | head :: _ ->
          let head_name = match head with Symbol s -> Some s | _ -> None in
          (match head_name with
           | Some "letrec" when List.length items >= 2 ->
             let bindings = List.nth items 1 in
             (match bindings with
              | List pairs | ListRef { contents = pairs } ->
                List.iteri (fun i pair ->
                  let ok = match pair with
                    | List (Symbol _ :: _ :: _) -> true
                    | ListRef { contents = Symbol _ :: _ :: _ } -> true
                    | _ -> false in
                  if not ok then
                    emit (Printf.sprintf
                      "WARNING %s: letrec binding %d is not a (name value) pair: %s"
                      (native_path_str (List.rev (i :: 1 :: path)))
                      i
                      (native_node_display pair))
                ) pairs
              | _ -> ())
           | Some (("defisland" | "defcomp") as nm) when List.length items < 4 ->
             emit (Printf.sprintf
               "ERROR %s: %s has fewer than 3 args (name params b..."
               (native_path_str (List.rev path)) nm)
           | _ -> ()));
       List.iteri (fun i child -> go child (i :: path)) items
     | _ -> ())
  in
  let nodes = match exprs with
    | List xs | ListRef { contents = xs } -> xs
    | x -> [x] in
  List.iteri (fun i node -> go node [i]) nodes;
  if !errors = [] then "OK" else String.concat "\n" (List.rev !errors)

let setup_env () =
  let e = make_env () in
  (* Primitives are auto-registered at module init *)
  (* Trampoline ref for HO primitives *)
  Sx_primitives._sx_trampoline_fn := (fun v ->
    match v with
    | Thunk (body, closure_env) -> Sx_ref.eval_expr body (Env closure_env)
    | other -> other);
  (* Seed VM globals with all primitives as NativeFn values.
     Without this, OP_CALL_PRIM in JIT-compiled bytecode can't find
     primitives and falls back to CEK — which causes cascading failures
     for stdlib functions like nth/first that override native versions. *)
  Hashtbl.iter (fun name fn ->
    Hashtbl.replace _mcp_vm_globals name (NativeFn (name, fn))
  ) Sx_primitives.primitives;
  (* JIT: mirror root-env bindings into shared VM globals table *)
  Sx_types._env_bind_hook := Some (fun env name v ->
    if env.parent = None then
      if not (Sx_primitives.is_primitive name) then
        Hashtbl.replace _mcp_vm_globals name v);
  (* Character classification for parser *)
  let bind name fn = ignore (env_bind e name (NativeFn (name, fn))) in
  bind "is-whitespace?" (fun args -> match args with
    | [String s] when String.length s = 1 ->
      let c = s.[0] in Bool (c = ' ' || c = '\t' || c = '\n' || c = '\r')
    | _ -> Bool false);
  bind "is-digit?" (fun args -> match args with
    | [String s] when String.length s = 1 ->
      Bool (s.[0] >= '0' && s.[0] <= '9')
    | _ -> Bool false);
  bind "is-alpha?" (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'))
    | _ -> Bool false);
  bind "char-code" (fun args -> match args with
    | [String s] when String.length s > 0 -> Number (float_of_int (Char.code s.[0]))
    | _ -> Number 0.0);
  bind "code-char" (fun args -> match args with
    | [Number n] -> String (String.make 1 (Char.chr (int_of_float n)))
    | _ -> String "");
  bind "parse-number" (fun args -> match args with
    | [String s] -> (try Number (float_of_string s) with _ -> Nil)
    | _ -> Nil);
  bind "identical?" (fun args -> match args with
    | [a; b] -> Bool (a == b)
    | _ -> Bool false);
  (* Character classification for SX parser.sx *)
  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 = '%' ||
            Char.code c > 127)
    | _ -> 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 >= '0' && c <= '9') ||
            c = '_' || c = '~' || c = '*' || c = '+' || c = '-' ||
            c = '>' || c = '<' || c = '=' || c = '/' || c = '!' ||
            c = '?' || c = '&' || c = '.' || c = ':' || c = '#' ||
            c = ',' || c = '@' || c = '^' || c = '%' ||
            Char.code c > 127)
    | _ -> Bool false);
  bind "make-keyword" (fun args -> match args with
    | [String s] -> Keyword s | _ -> Nil);
  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"
        | '\t' -> Buffer.add_string buf "\\t"
        | '\r' -> Buffer.add_string buf "\\r"
        | c -> Buffer.add_char buf c) s;
      String (Buffer.contents buf)
    | _ -> String "");
  bind "sx-expr-source" (fun args -> match args with
    | [SxExpr s] -> String s | _ -> String "");
  (* Runtime functions needed by tree-tools *)
  bind "symbol-name" (fun args -> match args with
    | [Symbol s] -> String s | _ -> String "");
  bind "keyword-name" (fun args -> match args with
    | [Keyword k] -> String k | _ -> String "");
  bind "make-symbol" (fun args -> match args with
    | [String s] -> Symbol s | _ -> Nil);
  (* Environment operations needed by harness *)
  bind "env-bind!" (fun args -> match args with
    | [Env env_val; String name; v] -> ignore (env_bind env_val name v); v
    | _ -> Nil);
  bind "env-get" (fun args -> match args with
    | [Env env_val; String name] -> env_get env_val name
    | _ -> Nil);
  bind "env-has?" (fun args -> match args with
    | [Env env_val; String name] -> Bool (env_has env_val name)
    | _ -> Bool false);
  bind "make-env" (fun _args -> Env (make_env ()));
  bind "keys" (fun args -> match args with
    | [Dict d] -> List (Hashtbl.fold (fun k _ acc -> String k :: acc) d [])
    | _ -> List []);
  bind "get" (fun args -> match args with
    | [Dict d; String k] -> (match Hashtbl.find_opt d k with Some v -> v | None -> Nil)
    | [Dict d; Keyword k] -> (match Hashtbl.find_opt d k with Some v -> v | None -> Nil)
    | [List items; Number n] -> (let i = int_of_float n in if i >= 0 && i < List.length items then List.nth items i else Nil)
    | _ -> Nil);
  bind "dict-set!" (fun args -> match args with
    | [Dict d; String k; v] -> Hashtbl.replace d k v; v
    | [Dict d; Keyword k; v] -> Hashtbl.replace d k v; v
    | _ -> Nil);
  bind "merge" (fun args -> match args with
    | [Dict a; Dict b] ->
      let d = Hashtbl.create (Hashtbl.length a + Hashtbl.length b) in
      Hashtbl.iter (fun k v -> Hashtbl.replace d k v) a;
      Hashtbl.iter (fun k v -> Hashtbl.replace d k v) b;
      Dict d
    | _ -> Nil);
  bind "apply" (fun args -> match args with
    | [f; List items] | [f; ListRef { contents = items }] ->
      Sx_ref.cek_call f (List items)
    | _ -> Nil);
  bind "current-env" (fun _args -> Env e);
  bind "type-of" (fun args -> match args with
    | [v] -> String (type_of v) | _ -> String "nil");
  bind "list?" (fun args -> match args with
    | [List _ | ListRef _] -> Bool true | _ -> Bool false);
  bind "nil?" (fun args -> match args with
    | [v] -> Bool (is_nil v) | _ -> Bool true);
  bind "string?" (fun args -> match args with
    | [String _] -> Bool true | _ -> Bool false);
  bind "number?" (fun args -> match args with
    | [Number _] -> Bool true | _ -> Bool false);
  bind "callable?" (fun args -> match args with
    | [NativeFn _ | Lambda _ | Component _ | Island _] -> Bool true | _ -> Bool false);
  bind "empty?" (fun args -> match args with
    | [List []] | [ListRef { contents = [] }] -> Bool true
    | [Nil] -> Bool true | _ -> Bool false);
  bind "contains?" (fun args -> match args with
    | [String s; String sub] ->
      let rec find i =
        if i > String.length s - String.length sub then false
        else if String.sub s i (String.length sub) = sub then true
        else find (i + 1)
      in Bool (String.length sub = 0 || find 0)
    | [List l; v] | [ListRef { contents = l }; v] ->
      Bool (List.exists (fun x -> x = v) l)
    | _ -> Bool false);
  bind "starts-with?" (fun args -> match args with
    | [String s; String prefix] ->
      Bool (String.length s >= String.length prefix &&
            String.sub s 0 (String.length prefix) = prefix)
    | _ -> Bool false);
  bind "append!" (fun args -> match args with
    | [ListRef r; v] -> r := !r @ [v]; v
    | _ -> Nil);
  bind "map-indexed" (fun args -> match args with
    | [f; List l] | [f; ListRef { contents = l }] ->
      List (List.mapi (fun i x -> Sx_ref.cek_call f (List [Number (float_of_int i); x])) l)
    | _ -> List []);
  (* Native list-replace — bypasses CEK map-indexed callback chain for deep tree edits *)
  bind "list-replace" (fun args -> match args with
    | [List l; Number idx; v] ->
      let i = int_of_float idx in
      List (List.mapi (fun j x -> if j = i then v else x) l)
    | [ListRef { contents = l }; Number idx; v] ->
      let i = int_of_float idx in
      List (List.mapi (fun j x -> if j = i then v else x) l)
    | _ -> Nil);
  (* Native navigate — bypasses CEK reduce callback chain for deep path reads *)
  bind "navigate" (fun args -> match args with
    | [tree; List path] | [tree; ListRef { contents = path }] ->
      let nodes = match tree with List _ | ListRef _ -> tree | _ -> List [tree] in
      List.fold_left (fun current idx ->
        match current, idx with
        | (List l | ListRef { contents = l }), Number n ->
          let i = int_of_float n in
          if i >= 0 && i < List.length l then List.nth l i else Nil
        | _ -> Nil
      ) nodes path
    | _ -> Nil);
  (* use — module declaration, no-op at eval time, metadata for static analysis *)
  bind "use" (fun _args -> Nil);
  (* Capability-based evaluation contexts *)
  let cap_stack : string list ref = ref [] in
  bind "with-capabilities" (fun args -> match args with
    | [List caps; body] ->
      let cap_set = List.filter_map (fun v -> match v with
        | Symbol s | String s -> Some s | _ -> None) caps in
      let prev = !cap_stack in
      cap_stack := cap_set;
      (* body can be a lambda (call it) or an expression (eval it) *)
      let result = try
        match body with
        | Lambda _ -> Sx_ref.cek_call body Nil
        | _ -> body
      with exn -> cap_stack := prev; raise exn in
      cap_stack := prev;
      result
    | _ -> Nil);
  bind "current-capabilities" (fun _args ->
    if !cap_stack = [] then Nil
    else List (List.map (fun s -> String s) !cap_stack));
  bind "has-capability?" (fun args -> match args with
    | [String cap] ->
      if !cap_stack = [] then Bool true  (* no restriction *)
      else Bool (List.mem cap !cap_stack)
    | _ -> Bool true);
  bind "require-capability!" (fun args -> match args with
    | [String cap] ->
      if !cap_stack = [] then Nil  (* no restriction *)
      else if List.mem cap !cap_stack then Nil
      else raise (Eval_error (Printf.sprintf
        "Capability '%s' not available. Current: %s" cap (String.concat ", " !cap_stack)))
    | _ -> Nil);
  bind "trim" (fun args -> match args with
    | [String s] -> String (String.trim s) | _ -> String "");
  bind "split" (fun args -> match args with
    | [String s; String d] ->
      List (List.map (fun p -> String p) (String.split_on_char d.[0] s))
    | _ -> List []);
  (* sx-parse — use the native OCaml parser for bootstrapping *)
  bind "sx-parse" (fun args -> match args with
    | [String s] -> List (Sx_parser.parse_all s)
    | _ -> List []);
  bind "sx-serialize" (fun args -> match args with
    | [v] -> String (Sx_runtime.value_to_str v)
    | _ -> String "");
  (* Stubs needed by signals.sx + adapter-html.sx *)
  bind "set-render-active!" (fun _args -> Nil);
  bind "render-active?" (fun _args -> Bool true);
  bind "trampoline" (fun args -> match args with
    | [Thunk (expr, e)] -> Sx_ref.eval_expr expr (Env e)
    | [v] -> v | _ -> Nil);
  bind "eval-expr" (fun args -> match args with
    | [expr; Env ue] -> Sx_ref.eval_expr expr (Env ue)
    | [expr] -> Sx_ref.eval_expr expr (Env e)
    | _ -> Nil);
  bind "deftype" (fun _args -> Nil);
  bind "defeffect" (fun _args -> Nil);
  (* Load SX modules with timing *)
  let spec_dir = try Sys.getenv "SX_SPEC_DIR" with Not_found -> "spec" in
  let lib_dir = try Sys.getenv "SX_LIB_DIR" with Not_found -> "lib" in
  let web_dir = try Sys.getenv "SX_WEB_DIR" with Not_found -> "web" in
  let t0 = Unix.gettimeofday () in
  let timed name f =
    let t = Unix.gettimeofday () in
    f ();
    Printf.eprintf "[mcp] %s: %.0fms\n%!" name ((Unix.gettimeofday () -. t) *. 1000.0)
  in
  timed "parser.sx" (fun () ->
    try load_sx_file e (Filename.concat spec_dir "parser.sx")
    with exn -> Printf.eprintf "[mcp] Warning: parser.sx load failed: %s\n%!" (Printexc.to_string exn));
  timed "tree-tools.sx" (fun () ->
    try load_sx_file e (Filename.concat lib_dir "tree-tools.sx")
    with exn -> Printf.eprintf "[mcp] Error: tree-tools.sx load failed: %s\n%!" (Printexc.to_string exn); exit 1);
  timed "signals.sx" (fun () ->
    try load_sx_file e (Filename.concat spec_dir "signals.sx")
    with exn -> Printf.eprintf "[mcp] Warning: signals.sx load failed: %s\n%!" (Printexc.to_string exn));
  timed "render.sx" (fun () ->
    try load_sx_file e (Filename.concat spec_dir "render.sx")
    with exn -> Printf.eprintf "[mcp] Warning: render.sx load failed: %s\n%!" (Printexc.to_string exn));
  timed "adapter-html.sx" (fun () ->
    try load_sx_file e (Filename.concat web_dir "adapter-html.sx")
    with exn -> Printf.eprintf "[mcp] Warning: adapter-html.sx load failed: %s\n%!" (Printexc.to_string exn));
  timed "harness.sx" (fun () ->
    try load_sx_file e (Filename.concat spec_dir "harness.sx")
    with exn -> Printf.eprintf "[mcp] Warning: harness.sx load failed: %s\n%!" (Printexc.to_string exn));
  timed "eval-rules.sx" (fun () ->
    try load_sx_file e (Filename.concat spec_dir "eval-rules.sx")
    with exn -> Printf.eprintf "[mcp] Warning: eval-rules.sx load failed: %s\n%!" (Printexc.to_string exn));
  (* Render pipeline — native OCaml renderer + HTML tag bindings *)
  Sx_render.setup_render_env e;
  List.iter (fun tag ->
    ignore (Sx_types.env_bind e tag
      (NativeFn ("html:" ^ tag, fun args -> List (Symbol tag :: args))))
  ) Sx_render.html_tags;
  ignore (Sx_types.env_bind e "island?" (NativeFn ("island?", fun args -> match args with [Island _] -> Bool true | _ -> Bool false)));
  timed "compiler.sx+JIT" (fun () ->
    try load_sx_file e (Filename.concat lib_dir "compiler.sx");
        register_mcp_jit_hook ()
    with exn -> Printf.eprintf "[mcp] Warning: compiler.sx load failed (JIT disabled): %s\n%!" (Printexc.to_string exn));

  (* Native-impl the hot tree-tools ops — replaces SX versions to avoid CEK
     overhead on big trees. See native_* helpers defined above setup_env. *)
  ignore (Sx_types.env_bind e "find-all" (NativeFn ("find-all", fun args ->
    match args with
    | [exprs; String pattern] -> native_find_all_sx exprs pattern
    | _ -> List [])));
  ignore (Sx_types.env_bind e "read-subtree" (NativeFn ("read-subtree", fun args ->
    match args with
    | [exprs; List path] | [exprs; ListRef { contents = path }] ->
      let ints = List.map (fun v -> match v with Number n -> int_of_float n | _ -> 0) path in
      String (native_read_subtree exprs ints)
    | _ -> String "")));
  ignore (Sx_types.env_bind e "validate" (NativeFn ("validate", fun args ->
    match args with
    | [exprs] -> String (native_validate exprs)
    | _ -> String "")));
  ignore (Sx_types.env_bind e "path-str" (NativeFn ("path-str", fun args ->
    match args with
    | [List path] | [ListRef { contents = path }] ->
      let ints = List.map (fun v -> match v with Number n -> int_of_float n | _ -> 0) path in
      String (native_path_str ints)
    | _ -> String "[]")));

  Printf.eprintf "[mcp] Ready in %.0fms\n%!" ((Unix.gettimeofday () -. t0) *. 1000.0);
  env := e

(* ------------------------------------------------------------------ *)
(* Call SX tree-tools functions                                        *)
(* ------------------------------------------------------------------ *)

let call_sx fn_name args =
  let e = !env in
  let fn = env_get e fn_name in
  Sx_ref.cek_call fn (List args)

(* File parse cache — avoids re-parsing unchanged files *)
let _parse_cache : (string, float * value) Hashtbl.t = Hashtbl.create 32
let _parse_cst_cache : (string, float * value * Sx_parser.cst_file) Hashtbl.t = Hashtbl.create 32
let _max_cache_entries = 64

let cache_invalidate path =
  Hashtbl.remove _parse_cache path;
  Hashtbl.remove _parse_cst_cache path

let parse_file path =
  let mtime = (Unix.stat path).Unix.st_mtime in
  match Hashtbl.find_opt _parse_cache path with
  | Some (cached_mtime, ast) when cached_mtime = mtime -> ast
  | _ ->
    if Hashtbl.length _parse_cache > _max_cache_entries then Hashtbl.clear _parse_cache;
    let src = In_channel.with_open_text path In_channel.input_all in
    let ast = List (Sx_parser.parse_all src) in
    Hashtbl.replace _parse_cache path (mtime, ast);
    ast

(* CST-based round-tripping — replaces comment_map machinery.
   Parse file as CST for lossless writes, project to AST for tree-tools. *)

(* Parse file → (AST for tree-tools, CST for writing back) *)
let parse_file_cst path =
  let mtime = (Unix.stat path).Unix.st_mtime in
  match Hashtbl.find_opt _parse_cst_cache path with
  | Some (cached_mtime, ast, cst) when cached_mtime = mtime -> (ast, cst)
  | _ ->
    if Hashtbl.length _parse_cst_cache > _max_cache_entries then Hashtbl.clear _parse_cst_cache;
    let cst = Sx_parser.parse_file_cst path in
    let ast = List (List.map Sx_cst.cst_to_ast cst.nodes) in
    Hashtbl.replace _parse_cst_cache path (mtime, ast, cst);
    (ast, cst)

(* Extract comment text from CST trivia for display in summarise/read_tree *)
let extract_cst_comments (cst : Sx_parser.cst_file) =
  let tbl = Hashtbl.create 16 in
  List.iteri (fun i node ->
    let trivia = match node with
      | Sx_cst.CstAtom r -> r.leading_trivia
      | Sx_cst.CstList r -> r.leading_trivia
      | Sx_cst.CstDict r -> r.leading_trivia
    in
    let comments = List.filter_map (function
      | Sx_cst.LineComment text ->
        (* Strip trailing newline for display *)
        let t = if String.length text > 0 && text.[String.length text - 1] = '\n'
          then String.sub text 0 (String.length text - 1) else text in
        Some t
      | _ -> None
    ) trivia in
    if comments <> [] then
      Hashtbl.replace tbl i comments
  ) cst.nodes;
  tbl

(* Inject comment text into summarise/annotate output.
   Matches [N] markers and inserts comment lines that precede expr N. *)
let inject_cst_comments output comment_tbl =
  if Hashtbl.length comment_tbl = 0 then output
  else
    let lines = String.split_on_char '\n' output in
    let buf = Buffer.create (String.length output + 512) in
    let first = ref true in
    List.iter (fun line ->
      let idx = if String.length line > 1 && line.[0] = '[' then
        (try Scanf.sscanf line "[%d]" (fun n -> Some n) with _ -> None)
      else
        let trimmed = String.trim line in
        if String.length trimmed > 1 && trimmed.[0] = '[' then
          (try Scanf.sscanf trimmed "[%d]" (fun n -> Some n) with _ -> None)
        else None
      in
      (match idx with
       | Some n ->
         (match Hashtbl.find_opt comment_tbl n with
          | Some comments ->
            List.iter (fun text ->
              if not !first then Buffer.add_char buf '\n';
              first := false;
              Buffer.add_string buf text
            ) comments
          | None -> ())
       | None -> ());
      if not !first then Buffer.add_char buf '\n';
      first := false;
      Buffer.add_string buf line
    ) lines;
    Buffer.contents buf

let parse_path_str s =
  (* Parse SX path string: "(0 3 2)" or "(0,3,2)" or "0 3 2" → SX list of numbers.
     Commas are unquote in SX, so strip them before parsing. *)
  let s = String.map (fun c -> if c = ',' then ' ' else c) s in
  let exprs = Sx_parser.parse_all s in
  match exprs with
  | [List items] ->
    (* (0 3 2) → list of numbers *)
    List (List.map (fun x -> match x with Number _ -> x | _ -> Number 0.0) items)
  | _ ->
    (* Bare numbers: "0 3 2" → parsed as separate exprs *)
    List (List.map (fun x -> match x with Number _ -> x | _ -> Number 0.0) exprs)

let _json_to_path j =
  let open Yojson.Safe.Util in
  parse_path_str (to_string j)

(* Resolve path: if it contains ">", use resolve-named-path; else parse as index path *)
let resolve_path tree path_str =
  if String.contains path_str '>' then
    call_sx "resolve-named-path" [tree; String path_str]
  else
    parse_path_str path_str

let value_to_string v =
  match v with
  | String s -> s
  | _ -> Sx_runtime.value_to_str v

let text_result s =
  `Assoc [("content", `List [`Assoc [
    ("type", `String "text");
    ("text", `String s)
  ]])]

let error_result s =
  `Assoc [("content", `List [`Assoc [
    ("type", `String "text");
    ("text", `String s)
  ]]);
  ("isError", `Bool true)]

(* ------------------------------------------------------------------ *)
(* Recursive .sx file discovery                                        *)
(* ------------------------------------------------------------------ *)

let glob_sx_files dir =
  let results = ref [] in
  let rec walk path =
    if Sys.is_directory path then
      let entries = Sys.readdir path in
      Array.iter (fun e -> walk (Filename.concat path e)) entries
    else if Filename.check_suffix path ".sx" then
      results := path :: !results
  in
  (try walk dir with Sys_error _ -> ());
  List.sort String.compare !results

let relative_path ~base path =
  let blen = String.length base in
  if String.length path > blen && String.sub path 0 blen = base then
    let rest = String.sub path (blen + 1) (String.length path - blen - 1) in
    rest
  else path

(* ------------------------------------------------------------------ *)
(* Pretty printer                                                      *)
(* ------------------------------------------------------------------ *)

let pp_atom = Sx_types.inspect

(* Estimate single-line width of a value *)
let rec est_width = function
  | Nil -> 3 | Bool true -> 4 | Bool false -> 5
  | Number n -> String.length (if Float.is_integer n then string_of_int (int_of_float n) else Printf.sprintf "%g" 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
        (* Fits on one line and has no comments *)
        Buffer.add_string buf (pp_atom v)
      else begin
        (* Multi-line *)
        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



(* Apply an AST-level edit result back to the CST and write the file.
   Unchanged nodes keep their original source; changed nodes are pretty-printed
   with the original leading trivia preserved. *)
let write_edit_cst file (cst : Sx_parser.cst_file) result =
  match result with
  | Dict d ->
    (match Hashtbl.find_opt d "ok" with
     | Some new_tree ->
       let new_items = match new_tree with
         | List items | ListRef { contents = items } -> items
         | _ -> [new_tree]
       in
       let old_nodes = cst.nodes in
       let old_asts = List.map Sx_cst.cst_to_ast old_nodes in
       let new_cst_nodes = List.mapi (fun i new_ast ->
         if i < List.length old_nodes then
           let old_ast = List.nth old_asts i in
           if inspect old_ast = inspect new_ast then
             List.nth old_nodes i
           else
             let pp = pretty_print_value new_ast in
             let new_cst = Sx_parser.parse_all_cst pp in
             let orig_trivia = match List.nth old_nodes i with
               | Sx_cst.CstAtom r -> r.leading_trivia
               | Sx_cst.CstList r -> r.leading_trivia
               | Sx_cst.CstDict r -> r.leading_trivia
             in
             (match new_cst.nodes with
              | [node] ->
                (match node with
                 | Sx_cst.CstAtom r -> Sx_cst.CstAtom { r with leading_trivia = orig_trivia }
                 | Sx_cst.CstList r -> Sx_cst.CstList { r with leading_trivia = orig_trivia }
                 | Sx_cst.CstDict r -> Sx_cst.CstDict { r with leading_trivia = orig_trivia })
              | _ -> List.nth old_nodes i)
         else
           let pp = pretty_print_value new_ast in
           let new_cst = Sx_parser.parse_all_cst ("\n\n" ^ pp) in
           (match new_cst.nodes with node :: _ -> node | [] ->
             Sx_cst.CstAtom { leading_trivia = []; token = pp;
                              value = new_ast; span = { start_offset = 0; end_offset = 0 } })
       ) new_items in
       let source = Sx_cst.cst_file_to_source new_cst_nodes cst.trailing_trivia in
       Out_channel.with_open_text file (fun oc -> output_string oc source);
       cache_invalidate file;
       text_result (Printf.sprintf "OK — wrote %d bytes to %s" (String.length source) file)
     | None ->
       let err = match Hashtbl.find_opt d "error" with
         | Some (String s) -> s | Some v -> value_to_string v | None -> "Unknown error"
       in
       error_result ("Error: " ^ err))
  | _ -> error_result "Unexpected result type"

(* ------------------------------------------------------------------ *)
(* Infrastructure helpers                                              *)
(* ------------------------------------------------------------------ *)

let run_command cmd =
  let ic = Unix.open_process_in cmd in
  let buf = Buffer.create 4096 in
  (try while true do
    if Buffer.length buf > 0 then Buffer.add_char buf '\n';
    Buffer.add_string buf (input_line ic)
  done with End_of_file -> ());
  let status = Unix.close_process_in ic in
  let code = match status with Unix.WEXITED n -> n | _ -> 1 in
  (code, Buffer.contents buf)

let require_file args key =
  let open Yojson.Safe.Util in
  let path = args |> member key |> to_string in
  if not (Sys.file_exists path) then
    raise (Invalid_argument (Printf.sprintf "File not found: %s" path));
  path

let require_dir args key =
  let open Yojson.Safe.Util in
  let path = args |> member key |> to_string in
  if not (Sys.file_exists path) then
    raise (Invalid_argument (Printf.sprintf "Directory not found: %s" path))
  else if not (Sys.is_directory path) then
    raise (Invalid_argument (Printf.sprintf "Not a directory: %s" path));
  path

let project_dir () =
  try Sys.getenv "SX_PROJECT_DIR" with Not_found ->
  let spec_dir = try Sys.getenv "SX_SPEC_DIR" with Not_found -> "spec" in
  Filename.dirname spec_dir

(* ------------------------------------------------------------------ *)
(* Tool dispatch table                                                 *)
(* ------------------------------------------------------------------ *)

let tool_handlers : (string, Yojson.Safe.t -> Yojson.Safe.t) Hashtbl.t = Hashtbl.create 64
let register name f = Hashtbl.replace tool_handlers name f

(* ------------------------------------------------------------------ *)
(* Tool handlers                                                       *)
(* ------------------------------------------------------------------ *)

let handle_sx_read_tree args =
  let open Yojson.Safe.Util in
    let file = require_file args "file" in
    let tree, cst = parse_file_cst file in
    let focus = args |> member "focus" |> to_string_option in
    let max_depth = to_int_safe (args |> member "max_depth") in
    let max_lines = to_int_safe (args |> member "max_lines") in
    let offset = to_int_or ~default:0 (args |> member "offset") in
    (match focus with
     | Some pattern ->
       text_result (inject_cst_comments (value_to_string (call_sx "annotate-focused" [tree; String pattern])) (extract_cst_comments cst))
     | None ->
       match max_lines with
       | Some limit ->
         text_result (inject_cst_comments (value_to_string (call_sx "annotate-paginated"
           [tree; Number (float_of_int offset); Number (float_of_int limit)])) (extract_cst_comments cst))
       | None ->
         match max_depth with
         | Some depth ->
           text_result (inject_cst_comments (value_to_string (call_sx "summarise" [tree; Number (float_of_int depth)])) (extract_cst_comments cst))
         | None ->
           let full = value_to_string (call_sx "annotate-tree" [tree]) in
           let line_count = 1 + String.fold_left (fun n c -> if c = '\n' then n + 1 else n) 0 full in
           if line_count <= 200 then text_result (inject_cst_comments full (extract_cst_comments cst))
           else
             let summary = value_to_string (call_sx "summarise" [tree; Number 2.0]) in
             text_result (inject_cst_comments (Printf.sprintf ";; File has %d lines — showing depth-2 summary. Use max_depth, max_lines, or focus to control output.\n%s" line_count summary) (extract_cst_comments cst)))

let handle_sx_summarise args =
  let open Yojson.Safe.Util in
    let file = require_file args "file" in
    let tree, cst = parse_file_cst file in
    let depth = to_int_or ~default:2 (args |> member "depth") in
    text_result (inject_cst_comments (value_to_string (call_sx "summarise" [tree; Number (float_of_int depth)])) (extract_cst_comments cst))

let handle_sx_read_subtree args =
  let open Yojson.Safe.Util in
    let tree = parse_file (require_file args "file") in
    let path = resolve_path tree (args |> member "path" |> to_string) in
    let ints = match path with
      | List xs | ListRef { contents = xs } ->
        List.map (fun v -> match v with Number n -> int_of_float n | _ -> 0) xs
      | _ -> [] in
    text_result (native_read_subtree tree ints)

let handle_sx_get_context args =
  let open Yojson.Safe.Util in
    let tree = parse_file (require_file args "file") in
    let path = resolve_path tree (args |> member "path" |> to_string) in
    text_result (value_to_string (call_sx "get-context" [tree; path]))

let handle_sx_find_all args =
  let open Yojson.Safe.Util in
    let tree = parse_file (require_file args "file") in
    let pattern = args |> member "pattern" |> to_string in
    let results = native_find_all_raw tree pattern in
    let lines = List.map (fun (p, s) -> native_path_str p ^ " " ^ s) results in
    text_result (String.concat "\n" lines)

let handle_sx_get_siblings args =
  let open Yojson.Safe.Util in
    let file = require_file args "file" in
    let tree, cst = parse_file_cst file in
    let path = resolve_path tree (args |> member "path" |> to_string) in
    let output = value_to_string (call_sx "get-siblings" [tree; path]) in
    (* Inject comments for top-level siblings *)
    let is_top_level = match path with
      | List [Number _] | List [Number _; Number _] -> true
      | _ -> false in
    text_result (if is_top_level then inject_cst_comments output (extract_cst_comments cst) else output)

let handle_sx_validate args =
    let tree = parse_file (require_file args "file") in
    text_result (native_validate tree)

let handle_sx_replace_node args =
  let open Yojson.Safe.Util in
    let file = require_file args "file" in
    let tree, cst = parse_file_cst file in
    let path = resolve_path tree (args |> member "path" |> to_string) in
    let src = args |> member "new_source" |> to_string in
    write_edit_cst file cst (call_sx "replace-node" [tree; path; String src])

let handle_sx_insert_child args =
  let open Yojson.Safe.Util in
    let file = require_file args "file" in
    let tree, cst = parse_file_cst file in
    let path = resolve_path tree (args |> member "path" |> to_string) in
    let index = to_int_or ~default:0 (args |> member "index") in
    let src = args |> member "new_source" |> to_string in
    write_edit_cst file cst (call_sx "insert-child" [tree; path; Number (float_of_int index); String src])

let handle_sx_delete_node args =
  let open Yojson.Safe.Util in
    let file = require_file args "file" in
    let tree, cst = parse_file_cst file in
    let path = resolve_path tree (args |> member "path" |> to_string) in
    write_edit_cst file cst (call_sx "delete-node" [tree; path])

let handle_sx_wrap_node args =
  let open Yojson.Safe.Util in
    let file = require_file args "file" in
    let tree, cst = parse_file_cst file in
    let path = resolve_path tree (args |> member "path" |> to_string) in
    let wrapper = args |> member "wrapper" |> to_string in
    write_edit_cst file cst (call_sx "wrap-node" [tree; path; String wrapper])

let handle_sx_format_check args =
    let file = require_file args "file" in
    let tree = parse_file file in
    let warnings = call_sx "lint-file" [tree] in
    (match warnings with
     | List [] | ListRef { contents = [] } -> text_result "OK — no issues found"
     | List items | ListRef { contents = items } ->
       text_result (String.concat "\n" (List.map value_to_string items))
     | _ -> text_result (value_to_string warnings))

let handle_sx_macroexpand args =
  let open Yojson.Safe.Util in
    let file = args |> member "file" |> to_string_option in
    let expr_str = args |> member "expr" |> to_string in
    (* Create a fresh env with file definitions loaded *)
    let e = !env in
    (* Optionally load a file's definitions to get its macros *)
    (match file with
     | Some f ->
       (try load_sx_file e f
        with exn -> Printf.eprintf "[mcp] Warning: failed to load %s: %s\n%!" f (Printexc.to_string exn))
     | None -> ());
    let exprs = Sx_parser.parse_all expr_str in
    let result = List.fold_left (fun _acc expr ->
      Sx_ref.eval_expr expr (Env e)
    ) Nil exprs in
    text_result (Sx_types.inspect result)

let handle_sx_build args =
  let open Yojson.Safe.Util in
    let target = args |> member "target" |> to_string_option |> Option.value ~default:"js" in
    let full = args |> member "full" |> to_bool_option |> Option.value ~default:false in
    let pd = project_dir () in
    let cmd = match target with
      | "ocaml" ->
        let abs_project = if Filename.is_relative pd then Sys.getcwd () ^ "/" ^ pd else pd in
        (* Remove assets dir that conflicts with dune's browser target, then build *)
        Printf.sprintf "cd %s/hosts/ocaml && rm -rf browser/sx_browser.bc.wasm.assets && eval $(opam env 2>/dev/null) && dune build 2>&1 && cp _build/default/browser/sx_browser.bc.wasm.js %s/shared/static/wasm/sx_browser.bc.wasm.js && cp _build/default/browser/sx_browser.bc.js %s/shared/static/wasm/sx_browser.bc.js && rm -rf %s/shared/static/wasm/sx_browser.bc.wasm.assets && cp -r _build/default/browser/sx_browser.bc.wasm.assets %s/shared/static/wasm/ && cp -r _build/default/browser/sx_browser.bc.wasm.assets browser/" abs_project abs_project abs_project abs_project abs_project
      | "wasm" ->
        let abs_project = if Filename.is_relative pd then Sys.getcwd () ^ "/" ^ pd else pd in
        Printf.sprintf "cd %s && bash hosts/ocaml/browser/build-all.sh 2>&1" abs_project
      | "js" | _ ->
        let extra = if full then " --extensions continuations --spec-modules types" else "" in
        Printf.sprintf "cd %s && python3 hosts/javascript/cli.py%s --output shared/static/scripts/sx-browser.js 2>&1" pd extra
    in
    let (code, output) = run_command cmd in
    if code = 0 then text_result (Printf.sprintf "OK — %s build succeeded\n%s" target (String.trim output))
    else error_result (Printf.sprintf "%s build failed:\n%s" target output)

let handle_sx_build_bytecode _args =
  ignore _args;
    let pd = project_dir () in
    let sx_dir = pd ^ "/shared/static/wasm/sx" in
    let files = [
      "render.sx"; "core-signals.sx"; "signals.sx"; "deps.sx"; "router.sx";
      "page-helpers.sx"; "freeze.sx"; "bytecode.sx"; "compiler.sx"; "vm.sx";
      "dom.sx"; "browser.sx"; "adapter-html.sx"; "adapter-sx.sx"; "adapter-dom.sx";
      "tw-layout.sx"; "tw-type.sx"; "tw.sx";
      "boot-helpers.sx"; "hypersx.sx"; "harness.sx"; "harness-reactive.sx";
      "harness-web.sx"; "engine.sx"; "orchestration.sx"; "boot.sx";
    ] in
    let t0 = Unix.gettimeofday () in
    (* JSON serialization for bytecode constants *)
    let rec const_to_json = function
      | Number n ->
        if Float.is_integer n then Printf.sprintf "{\"t\":\"n\",\"v\":%d}" (int_of_float n)
        else Printf.sprintf "{\"t\":\"n\",\"v\":%g}" n
      | String s -> Printf.sprintf "{\"t\":\"s\",\"v\":%s}" (json_escape s)
      | Symbol s -> Printf.sprintf "{\"t\":\"sym\",\"v\":%s}" (json_escape s)
      | Keyword k -> Printf.sprintf "{\"t\":\"kw\",\"v\":%s}" (json_escape k)
      | Bool true -> "{\"t\":\"b\",\"v\":true}"
      | Bool false -> "{\"t\":\"b\",\"v\":false}"
      | Nil -> "{\"t\":\"nil\"}"
      | Dict d when Hashtbl.mem d "bytecode" -> code_to_json (Dict d)
      | List items -> Printf.sprintf "{\"t\":\"list\",\"v\":[%s]}"
          (String.concat "," (List.map const_to_json items))
      | ListRef { contents = items } -> Printf.sprintf "{\"t\":\"list\",\"v\":[%s]}"
          (String.concat "," (List.map const_to_json items))
      | _ -> "{\"t\":\"nil\"}"
    and code_to_json code =
      let bc = match Sx_runtime.get code (String "bytecode") with
        | List l | ListRef { contents = l } ->
          String.concat "," (List.map (fun v -> match v with Number n -> string_of_int (int_of_float n) | _ -> "0") l)
        | _ -> "" in
      let consts = match Sx_runtime.get code (String "constants") with
        | List l | ListRef { contents = l } -> String.concat "," (List.map const_to_json l)
        | _ -> "" in
      let arity = match Sx_runtime.get code (String "arity") with
        | Number n -> int_of_float n | _ -> 0 in
      let uvc = match Sx_runtime.get code (String "upvalue-count") with
        | Number n -> int_of_float n | _ -> 0 in
      Printf.sprintf "{\"t\":\"code\",\"v\":{\"arity\":%d,\"upvalue-count\":%d,\"bytecode\":[%s],\"constants\":[%s]}}" arity uvc bc consts
    and json_escape s =
      let buf = Buffer.create (String.length s + 2) 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 -> Buffer.add_char buf c) s;
      Buffer.add_char buf '"';
      Buffer.contents buf
    in
    let compiled = ref 0 in
    let skipped = ref 0 in
    let log = Buffer.create 1024 in
    List.iter (fun file ->
      let src_path = sx_dir ^ "/" ^ file in
      if Sys.file_exists src_path then begin
        try
          let src = In_channel.with_open_text src_path In_channel.input_all in
          let exprs = Sx_parser.parse_all src in
          let hash = Digest.string src |> Digest.to_hex |> fun s -> String.sub s 0 16 in
          let code = Sx_compiler.compile_module (List exprs) in
          (* Serialize to JSON *)
          let bc = match Sx_runtime.get code (String "bytecode") with
            | List l | ListRef { contents = l } ->
              String.concat "," (List.map (fun v -> match v with Number n -> string_of_int (int_of_float n) | _ -> "0") l)
            | _ -> "" in
          let consts = match Sx_runtime.get code (String "constants") with
            | List l | ListRef { contents = l } -> String.concat "," (List.map const_to_json l)
            | _ -> "" in
          let arity = match Sx_runtime.get code (String "arity") with
            | Number n -> int_of_float n | _ -> 0 in
          let json = Printf.sprintf "{\"magic\":\"SXBC\",\"version\":1,\"hash\":\"%s\",\"module\":{\"arity\":%d,\"bytecode\":[%s],\"constants\":[%s]}}"
            hash arity bc consts in
          let json_path = (String.sub src_path 0 (String.length src_path - 3)) ^ ".sxbc.json" in
          Out_channel.with_open_text json_path (fun oc -> output_string oc json);
          let kb = String.length json / 1024 in
          Buffer.add_string log (Printf.sprintf "  ok %s → %dK\n" file kb);
          incr compiled
        with e ->
          Buffer.add_string log (Printf.sprintf "  SKIP %s — %s\n" file (Printexc.to_string e));
          incr skipped
      end
    ) files;
    let dt = Unix.gettimeofday () -. t0 in
    let summary = Printf.sprintf "Done: %d compiled, %d skipped in %.1fs\n%s"
      !compiled !skipped dt (Buffer.contents log) in
    if !skipped = 0 then
      text_result (Printf.sprintf "OK — bytecode compilation succeeded\n%s" summary)
    else
      text_result (Printf.sprintf "Bytecode compilation partial\n%s" summary)

let handle_sx_test args =
  let open Yojson.Safe.Util in
    let host = args |> member "host" |> to_string_option |> Option.value ~default:"js" in
    let full = args |> member "full" |> to_bool_option |> Option.value ~default:false in
    let pd = project_dir () in
    let timeout = to_int_or ~default:300 (args |> member "timeout") in
    let cmd = match host with
      | "ocaml" ->
        (* Use pre-built binary directly — avoids dune rebuild delay.
           Falls back to dune exec if the binary doesn't exist. *)
        let exe = Printf.sprintf "%s/hosts/ocaml/_build/default/bin/run_tests.exe" pd in
        if Sys.file_exists exe then
          Printf.sprintf "cd %s/hosts/ocaml && timeout %d %s%s 2>&1"
            pd timeout exe (if full then " --full" else "")
        else
          Printf.sprintf "cd %s/hosts/ocaml && eval $(opam env 2>/dev/null) && timeout %d dune exec bin/run_tests.exe%s 2>&1"
            pd timeout (if full then " -- --full" else "")
      | "js" | _ ->
        Printf.sprintf "cd %s && timeout %d node hosts/javascript/run_tests.js%s 2>&1"
          pd timeout (if full then " --full" else "")
    in
    let (_code, output) = run_command cmd in
    let all_lines = String.split_on_char '\n' output in
    (* Extract summary and failures *)
    let fails = List.filter (fun l -> let t = String.trim l in
      String.length t > 5 && String.sub t 0 4 = "FAIL") all_lines in
    let summary = List.find_opt (fun l -> try let _ = Str.search_forward (Str.regexp "Results:") l 0 in true with Not_found -> false) all_lines in
    let result = match summary with
      | Some s ->
        if fails = [] then s
        else s ^ "\n\nFailures:\n" ^ String.concat "\n" fails
      | None ->
        let last_n = List.filteri (fun i _ -> i >= List.length all_lines - 5) all_lines in
        String.concat "\n" last_n
    in
    text_result result

let handle_sx_pretty_print args =
  let open Yojson.Safe.Util in
    let file = args |> member "file" |> to_string in
    let cst = Sx_parser.parse_file_cst file in
    (* Reformat each node's code while preserving trivia (comments, spacing) *)
    let reformatted = List.map (fun node ->
      let trivia = match node with
        | Sx_cst.CstAtom r -> r.leading_trivia
        | Sx_cst.CstList r -> r.leading_trivia
        | Sx_cst.CstDict r -> r.leading_trivia
      in
      let ast = Sx_cst.cst_to_ast node in
      let pp = pretty_print_value ast in
      let new_cst = Sx_parser.parse_all_cst pp in
      match new_cst.nodes with
      | [n] ->
        (match n with
         | Sx_cst.CstAtom r -> Sx_cst.CstAtom { r with leading_trivia = trivia }
         | Sx_cst.CstList r -> Sx_cst.CstList { r with leading_trivia = trivia }
         | Sx_cst.CstDict r -> Sx_cst.CstDict { r with leading_trivia = trivia })
      | _ -> node
    ) cst.nodes in
    let source = Sx_cst.cst_file_to_source reformatted cst.trailing_trivia in
    Out_channel.with_open_text file (fun oc -> output_string oc source);
    cache_invalidate file;
    text_result (Printf.sprintf "OK — reformatted %s (%d bytes, %d forms)" file (String.length source) (List.length cst.nodes))

let handle_sx_changed args =
  let open Yojson.Safe.Util in
    let base_ref = args |> member "ref" |> to_string_option |> Option.value ~default:"main" in
    let pd = project_dir () in
    let cmd = Printf.sprintf "cd %s && git diff --name-only %s -- '*.sx' '*.sxc' 2>/dev/null" pd base_ref in
    let (_code, output) = run_command cmd in
    let changed = if output = "" then [] else String.split_on_char '\n' output in
    if changed = [] then text_result (Printf.sprintf "No .sx files changed since %s" base_ref)
    else begin
      let lines = List.map (fun rel ->
        let full = Filename.concat pd rel in
        try
          let tree = parse_file full in
          let summary = value_to_string (call_sx "summarise" [tree; Number 1.0]) in
          Printf.sprintf "=== %s ===\n%s" rel summary
        with _ -> Printf.sprintf "=== %s === (parse error or deleted)" rel
      ) changed in
      text_result (String.concat "\n\n" lines)
    end

let handle_sx_diff_branch args =
  let open Yojson.Safe.Util in
    let base_ref = args |> member "ref" |> to_string_option |> Option.value ~default:"main" in
    let pd = project_dir () in
    let cmd = Printf.sprintf "cd %s && git diff --name-only %s -- '*.sx' '*.sxc' 2>/dev/null" pd base_ref in
    let (_code, output) = run_command cmd in
    let changed = if output = "" then [] else String.split_on_char '\n' output in
    if changed = [] then text_result (Printf.sprintf "No .sx files changed since %s" base_ref)
    else begin
      let lines = List.filter_map (fun rel ->
        let full = Filename.concat pd rel in
        (* Get the base version via git show *)
        let base_cmd = Printf.sprintf "cd %s && git show %s:%s 2>/dev/null" pd base_ref rel in
        let (_base_code, base_src) = run_command base_cmd in
        try
          let tree_b = parse_file full in
          if base_src = "" then
            Some (Printf.sprintf "=== %s (new file) ===\n%s" rel
              (value_to_string (call_sx "summarise" [tree_b; Number 1.0])))
          else begin
            let tree_a = List (Sx_parser.parse_all base_src) in
            let diff = value_to_string (call_sx "tree-diff" [tree_a; tree_b]) in
            if diff = "No differences" then None
            else Some (Printf.sprintf "=== %s ===\n%s" rel diff)
          end
        with _ -> Some (Printf.sprintf "=== %s === (parse error)" rel)
      ) changed in
      if lines = [] then text_result "All changed .sx files are structurally identical to base"
      else text_result (String.concat "\n\n" lines)
    end

let handle_sx_blame args =
  let open Yojson.Safe.Util in
    let file = require_file args "file" in
    let path_str_arg = args |> member "path" |> to_string_option in
    let pd = project_dir () in
    (* Get the node's source span by parsing and finding line numbers *)
    let tree = parse_file file in
    let target_src = match path_str_arg with
      | Some ps ->
        let path = resolve_path tree ps in
        let node = call_sx "navigate" [tree; path] in
        if is_nil node then None
        else Some (Sx_types.inspect node)
      | None -> None
    in
    let rel_file = relative_path ~base:pd file in
    let cmd = match target_src with
      | Some src ->
        (* Find the line range containing this source fragment *)
        let first_line = String.sub src 0 (min 40 (String.length src)) in
        let escaped = String.concat "" (List.of_seq (Seq.map (fun c ->
          if c = '(' || c = ')' || c = '[' || c = ']' || c = '.' || c = '*' || c = '+' || c = '?' || c = '{' || c = '}' || c = '\\' || c = '|' || c = '^' || c = '$'
          then Printf.sprintf "\\%c" c else String.make 1 c
        ) (String.to_seq first_line))) in
        Printf.sprintf "cd %s && git blame -L '/%s/,+10' -- %s 2>/dev/null || git blame -- %s 2>/dev/null | head -20" pd escaped rel_file rel_file
      | None ->
        Printf.sprintf "cd %s && git blame -- %s 2>/dev/null | head -30" pd rel_file
    in
    let (_code, output) = run_command cmd in
    text_result output

let handle_sx_doc_gen args =
    let dir = require_dir args "dir" in
    let files = glob_sx_files dir in
    let strip_comment_prefix text =
      let lines = String.split_on_char '\n' text in
      let cleaned = List.map (fun line ->
        let s = String.trim line in
        if String.length s >= 3 && s.[0] = ';' && s.[1] = ';' && s.[2] = ' ' then
          String.sub s 3 (String.length s - 3)
        else if String.length s >= 2 && s.[0] = ';' && s.[1] = ';' then
          String.sub s 2 (String.length s - 2)
        else s
      ) lines in
      (* Filter out section divider lines (═══, ---) *)
      let non_dividers = List.filter (fun s ->
        not (String.length s > 3 && (s.[0] = '=' || s.[0] = '-' || s.[0] = '#'))
      ) cleaned in
      let trimmed = List.filter (fun s -> String.trim s <> "") non_dividers in
      String.concat "\n" trimmed
    in
    let all_docs = List.concat_map (fun path ->
      let rel = relative_path ~base:dir path in
      try
        let cst = Sx_parser.parse_file_cst path in
        List.filter_map (fun node ->
          (* Extract leading comment trivia from CST node *)
          let trivia = match node with
            | Sx_cst.CstAtom r -> r.leading_trivia
            | Sx_cst.CstList r -> r.leading_trivia
            | Sx_cst.CstDict r -> r.leading_trivia
          in
          let comment_text = List.filter_map (function
            | Sx_cst.LineComment text -> Some text | _ -> None
          ) trivia in
          let prev_comment = if comment_text = [] then None
            else Some (String.concat "" comment_text) in
          let expr = Sx_cst.cst_to_ast node in
          match expr with
          | List (Symbol head :: Symbol name :: params_rest)
          | ListRef { contents = Symbol head :: Symbol name :: params_rest } ->
            (match head with
             | "defcomp" | "defisland" ->
               let params_str = match params_rest with
                 | List ps :: _ | ListRef { contents = ps } :: _ ->
                   let keys = List.filter_map (fun p -> match p with
                     | Symbol s when s <> "&key" && s <> "&rest" && not (String.length s > 0 && s.[0] = '&') -> Some s
                     | List (Symbol s :: _) when s <> "&key" && s <> "&rest" -> Some (Printf.sprintf "%s (typed)" s)
                     | _ -> None) ps
                   in
                   let has_rest = List.exists (fun p -> match p with Symbol "&rest" -> true | _ -> false) ps in
                   let key_str = if keys = [] then "" else "  Keys: " ^ String.concat ", " keys ^ "\n" in
                   let rest_str = if has_rest then "  Children: yes\n" else "" in
                   key_str ^ rest_str
                 | _ -> ""
               in
               let comment_str = match prev_comment with
                 | Some text ->
                   let cleaned = strip_comment_prefix text in
                   if cleaned = "" then "" else "  " ^ cleaned ^ "\n"
                 | None -> ""
               in
               Some (Printf.sprintf "## %s `%s`\nDefined in: %s\nType: %s\n%s%s" head name rel head comment_str params_str)
             | "defmacro" ->
               let comment_str = match prev_comment with
                 | Some text ->
                   let cleaned = strip_comment_prefix text in
                   if cleaned = "" then "" else "  " ^ cleaned ^ "\n"
                 | None -> ""
               in
               Some (Printf.sprintf "## %s `%s`\nDefined in: %s\nType: macro\n%s" head name rel comment_str)
             | _ -> None)
          | _ -> None
        ) cst.nodes
      with _ -> []
    ) files in
    if all_docs = [] then text_result "(no components found)"
    else text_result (String.concat "\n" all_docs)

let handle_sx_nav args =
  let open Yojson.Safe.Util in
    let mode = (try args |> member "mode" |> to_string with _ -> "list") in
    let section_filter = (try Some (args |> member "section" |> to_string) with _ -> None) in
    let project_dir = try Sys.getenv "SX_PROJECT_DIR" with Not_found ->
      try Sys.getenv "SX_ROOT" with Not_found -> Sys.getcwd () in
    let sx_dir = project_dir ^ "/sx/sx" in
    (* Extract all nav items from nav-data.sx AND nav-tree.sx *)
    let scan_nav () =
      let items = ref [] in
      let seen = Hashtbl.create 64 in
      let rec walk = function
        | Dict d ->
          (match Hashtbl.find_opt d "href", Hashtbl.find_opt d "label" with
           | Some (String href), Some (String label) when not (Hashtbl.mem seen href) ->
             Hashtbl.replace seen href ();
             let summary = match Hashtbl.find_opt d "summary" with Some (String s) -> s | _ -> "" in
             items := (href, label, summary) :: !items
           | _ -> ());
          Hashtbl.iter (fun _ v -> walk v) d
        | List l | ListRef { contents = l } -> List.iter walk l
        | _ -> ()
      in
      (* Scan both files — nav-data has the groups, nav-tree has the sidebar structure *)
      List.iter (fun file ->
        let src = try In_channel.with_open_text (sx_dir ^ "/" ^ file) In_channel.input_all with _ -> "" in
        (* Evaluate defines so (dict :key val) calls produce Dict values *)
        let exprs = try Sx_parser.parse_all src with _ -> [] in
        List.iter (fun expr ->
          try walk (Sx_ref.eval_expr expr (Env !env))
          with _ -> walk expr  (* fallback: walk unevaluated AST *)
        ) exprs
      ) ["nav-data.sx"; "nav-tree.sx"];
      List.rev !items
    in
    let href_section href =
      if String.length href > 5 && String.sub href 0 5 = "/sx/(" then
        let rest = String.sub href 5 (String.length href - 6) in
        match String.index_opt rest '.' with Some i -> String.sub rest 0 i | None -> rest
      else ""
    in
    (* Scan all .sx files under sx_dir for defcomp/defisland *)
    let scan_comps () =
      let comps = ref [] in
      let rec scan dir =
        Array.iter (fun e ->
          let p = dir ^ "/" ^ e in
          if Sys.is_directory p then scan p
          else if Filename.check_suffix e ".sx" then
            List.iter (function
              | List (Symbol "defcomp" :: Symbol n :: _)
              | List (Symbol "defisland" :: Symbol n :: _) ->
                comps := (n, Filename.basename p) :: !comps
              | _ -> ()
            ) (try Sx_parser.parse_all (In_channel.with_open_text p In_channel.input_all) with _ -> [])
        ) (try Sys.readdir dir with _ -> [||])
      in scan sx_dir; !comps
    in
    let scan_pagefns () =
      let src = try In_channel.with_open_text (sx_dir ^ "/page-functions.sx") In_channel.input_all with _ -> "" in
      List.filter_map (function
        | List [Symbol "define"; Symbol n; _] -> Some n
        | _ -> None
      ) (try Sx_parser.parse_all src with _ -> [])
    in
    (match mode with
     | "list" ->
       let items = scan_nav () in
       let lines = List.filter_map (fun (href, label, summary) ->
         let sec = href_section href in
         match section_filter with
         | Some f when f <> sec -> None
         | _ ->
           let s = if summary = "" then "" else " — " ^ (if String.length summary > 50 then String.sub summary 0 50 ^ "..." else summary) in
           Some (Printf.sprintf "  %-28s %s%s" label href s)
       ) items in
       text_result (Printf.sprintf "%d nav items%s\n%s"
         (List.length lines)
         (match section_filter with Some s -> " in " ^ s | None -> "")
         (String.concat "\n" lines))
     | "check" ->
       let items = scan_nav () in
       let comps = scan_comps () in
       let pfns = scan_pagefns () in
       let issues = Buffer.create 256 in
       let n = ref 0 in
       let issue s = incr n; Buffer.add_string issues s; Buffer.add_char issues '\n' in
       (* Duplicate hrefs *)
       let seen = Hashtbl.create 64 in
       List.iter (fun (href, label, _) ->
         if Hashtbl.mem seen href then issue (Printf.sprintf "DUP  %s (%s)" href label)
         else Hashtbl.replace seen href ()
       ) items;
       (* Check page function coverage *)
       List.iter (fun (href, label, _) ->
         let sec = href_section href in
         if sec <> "" && not (List.mem sec pfns) && sec <> "sx" then
           issue (Printf.sprintf "WARN no page-fn '%s' for %s (%s)" sec label href)
       ) items;
       (* Components with -content suffix but no nav *)
       let nav_src = try In_channel.with_open_text (sx_dir ^ "/nav-data.sx") In_channel.input_all with _ -> "" in
       List.iter (fun (name, file) ->
         if String.length name > 8 &&
            String.sub name (String.length name - 8) 8 = "-content" then
           let slug = String.sub name 1 (String.length name - 1) in (* remove ~ *)
           let parts = String.split_on_char '/' slug in
           let last = List.nth parts (List.length parts - 1) in
           let check = String.sub last 0 (String.length last - 8) in (* remove -content *)
           if not (try ignore (Str.search_forward (Str.regexp_string check) nav_src 0); true with Not_found -> false) then
             issue (Printf.sprintf "INFO %s (%s) — no nav entry" name file)
       ) comps;
       if !n = 0 then text_result "Nav check: all clear"
       else text_result (Printf.sprintf "Nav check: %d issues\n%s" !n (Buffer.contents issues))
     | "add" ->
       let title = (try args |> member "title" |> to_string with _ -> "") in
       let slug = (try args |> member "slug" |> to_string with _ -> "") in
       let sec = (match section_filter with Some s -> s | None -> "applications") in
       if title = "" || slug = "" then error_result "title and slug required"
       else begin
         let comp = Printf.sprintf "~%s/%s/content" sec slug in
         let file = sx_dir ^ "/" ^ slug ^ ".sx" in
         let href = Printf.sprintf "/sx/(%s.(%s))" sec slug in
         if Sys.file_exists file then error_result ("exists: " ^ file)
         else begin
           (* Component file *)
           let src = Printf.sprintf ";;; %s\n\n(defcomp %s ()\n  (~docs/page :title \"%s\"\n    (~docs/section :title \"Overview\" :id \"overview\"\n      (p \"TODO\"))))\n" title comp title in
           Out_channel.with_open_text file (fun oc -> output_string oc src);
           cache_invalidate file;
           (* Page function *)
           let pf = sx_dir ^ "/page-functions.sx" in
           let ps = In_channel.with_open_text pf In_channel.input_all in
           Out_channel.with_open_text pf (fun oc ->
             output_string oc ps;
             Printf.fprintf oc "\n(define %s (make-page-fn \"%s\" \"~%s/%s/\" nil \"-content\"))\n" slug comp sec slug);
           cache_invalidate pf;
           (* Nav entry *)
           let nf = sx_dir ^ "/nav-data.sx" in
           let ns = In_channel.with_open_text nf In_channel.input_all in
           Out_channel.with_open_text nf (fun oc ->
             output_string oc ns;
             Printf.fprintf oc "\n(define %s-nav-items\n  (list (dict :label \"%s\" :href \"%s\")))\n" slug title href);
           cache_invalidate nf;
           text_result (Printf.sprintf "Created:\n  File: %s\n  Component: %s\n  Page fn: %s\n  Nav href: %s" file comp slug href)
         end
       end
     | "delete" ->
       let slug = (try args |> member "slug" |> to_string with _ -> "") in
       if slug = "" then error_result "slug required"
       else begin
         let changes = Buffer.create 256 in
         let log s = Buffer.add_string changes s; Buffer.add_char changes '\n' in
         (* Helper: remove a top-level (define name ...) block from text *)
         let remove_define_block text name =
           let pattern = Printf.sprintf "(define %s " name in
           match try Some (Str.search_forward (Str.regexp_string pattern) text 0) with Not_found -> None with
           | None -> text
           | Some start ->
             (* Find matching close paren *)
             let depth = ref 0 in
             let finish = ref (String.length text) in
             for i = start to String.length text - 1 do
               if text.[i] = '(' then incr depth
               else if text.[i] = ')' then begin
                 decr depth;
                 if !depth = 0 && !finish = String.length text then
                   finish := i + 1
               end
             done;
             (* Also consume trailing newlines *)
             let e = ref !finish in
             while !e < String.length text && text.[!e] = '\n' do incr e done;
             String.sub text 0 start ^ String.sub text !e (String.length text - !e)
         in
         (* 1. Remove from nav-data.sx *)
         let nf = sx_dir ^ "/nav-data.sx" in
         let ns = In_channel.with_open_text nf In_channel.input_all in
         let nav_items_name = slug ^ "-nav-items" in
         let ns2 = remove_define_block ns nav_items_name in
         if ns2 <> ns then begin
           Out_channel.with_open_text nf (fun oc -> output_string oc ns2);
           cache_invalidate nf;
           log (Printf.sprintf "nav-data.sx: removed define %s" nav_items_name)
         end;
         (* 2. Remove from nav-tree.sx — find the dict block with matching href *)
         let tf = sx_dir ^ "/nav-tree.sx" in
         let ts = In_channel.with_open_text tf In_channel.input_all in
         let href_pat = Printf.sprintf "\"(/sx/(%%.(%s" slug in
         (* Match any section: find the (dict ... :href "/sx/(SECTION.(SLUG..." block *)
         let slug_re = Str.regexp (Printf.sprintf ":href \"/sx/([a-z]+\\.(%s" (Str.quote slug)) in
         let ts2 = match try Some (Str.search_forward slug_re ts 0) with Not_found -> None with
           | None -> ignore href_pat; ts
           | Some _ ->
             (* Walk back to find the opening (dict *)
             let href_pos = Str.match_beginning () in
             let start = ref href_pos in
             while !start > 0 && String.sub ts !start 4 <> "dict" do decr start done;
             (* Back one more for the opening paren *)
             while !start > 0 && ts.[!start] <> '(' do decr start done;
             (* Find matching close paren *)
             let depth = ref 0 in
             let finish = ref (String.length ts) in
             for i = !start to String.length ts - 1 do
               if ts.[i] = '(' then incr depth
               else if ts.[i] = ')' then begin
                 decr depth;
                 if !depth = 0 && !finish = String.length ts then
                   finish := i + 1
               end
             done;
             (* Consume trailing whitespace/newlines *)
             let e = ref !finish in
             while !e < String.length ts && (ts.[!e] = '\n' || ts.[!e] = ' ') do incr e done;
             log (Printf.sprintf "nav-tree.sx: removed entry for %s" slug);
             String.sub ts 0 !start ^ String.sub ts !e (String.length ts - !e)
         in
         if ts2 <> ts then begin
           Out_channel.with_open_text tf (fun oc -> output_string oc ts2);
           cache_invalidate tf
         end;
         (* 3. Remove from page-functions.sx *)
         let pf = sx_dir ^ "/page-functions.sx" in
         let ps = In_channel.with_open_text pf In_channel.input_all in
         let ps2 = remove_define_block ps slug in
         if ps2 <> ps then begin
           Out_channel.with_open_text pf (fun oc -> output_string oc ps2);
           cache_invalidate pf;
           log (Printf.sprintf "page-functions.sx: removed define %s" slug)
         end;
         text_result (Printf.sprintf "Deleted %s:\n%s" slug (Buffer.contents changes))
       end
     | "move" ->
       let slug = (try args |> member "slug" |> to_string with _ -> "") in
       let from_sec = (try args |> member "from" |> to_string with _ -> "") in
       let to_sec = (try args |> member "to" |> to_string with _ ->
         match section_filter with Some s -> s | None -> "") in
       if slug = "" || from_sec = "" || to_sec = "" then
         error_result "slug, from, and to (or section) required"
       else if from_sec = to_sec then
         error_result "from and to must differ"
       else begin
         let changes = Buffer.create 256 in
         let log s = Buffer.add_string changes s; Buffer.add_char changes '\n' in
         let old_prefix = from_sec ^ ".(" ^ slug in
         let new_prefix = to_sec ^ ".(" ^ slug in
         (* 1. Rewrite hrefs in nav-data.sx *)
         let nf = sx_dir ^ "/nav-data.sx" in
         let ns = In_channel.with_open_text nf In_channel.input_all in
         let ns2 = Str.global_replace (Str.regexp_string old_prefix) new_prefix ns in
         if ns2 <> ns then begin
           Out_channel.with_open_text nf (fun oc -> output_string oc ns2);
           cache_invalidate nf;
           log (Printf.sprintf "nav-data.sx: rewrote hrefs %s → %s" from_sec to_sec)
         end;
         (* 2. Move entry in nav-tree.sx: extract block from source, rewrite hrefs, insert into target *)
         let tf = sx_dir ^ "/nav-tree.sx" in
         let ts = In_channel.with_open_text tf In_channel.input_all in
         (* First rewrite all hrefs *)
         let ts2 = Str.global_replace (Str.regexp_string old_prefix) new_prefix ts in
         (* Find the dict block for this slug *)
         let slug_re = Str.regexp (Printf.sprintf ":href \"/sx/([a-z]+\\.(%s" (Str.quote slug)) in
         let ts3 = match try Some (Str.search_forward slug_re ts2 0) with Not_found -> None with
           | None ->
             log "nav-tree.sx: hrefs rewritten (no entry block found to relocate)";
             ts2
           | Some _ ->
             let href_pos = Str.match_beginning () in
             (* Walk back to (dict *)
             let start = ref href_pos in
             while !start > 0 && String.sub ts2 !start 4 <> "dict" do decr start done;
             while !start > 0 && ts2.[!start] <> '(' do decr start done;
             (* Find matching close paren *)
             let depth = ref 0 in
             let finish = ref (String.length ts2) in
             for i = !start to String.length ts2 - 1 do
               if ts2.[i] = '(' then incr depth
               else if ts2.[i] = ')' then begin
                 decr depth;
                 if !depth = 0 && !finish = String.length ts2 then
                   finish := i + 1
               end
             done;
             let block = String.sub ts2 !start (!finish - !start) in
             (* Remove block from source position *)
             let e = ref !finish in
             while !e < String.length ts2 && (ts2.[!e] = '\n' || ts2.[!e] = ' ') do incr e done;
             let without = String.sub ts2 0 !start ^ String.sub ts2 !e (String.length ts2 - !e) in
             (* Insert into target section — find the last child before the closing paren of target's :children *)
             let target_href = Printf.sprintf "\"/sx/(%s)\"" to_sec in
             (match try Some (Str.search_forward (Str.regexp_string target_href) without 0) with Not_found -> None with
              | None ->
                log (Printf.sprintf "nav-tree.sx: hrefs rewritten but target section %s not found" to_sec);
                without
              | Some _ ->
                let target_pos = Str.match_beginning () in
                (* Find :children after target_pos *)
                let children_re = Str.regexp_string ":children" in
                (match try Some (Str.search_forward children_re without target_pos) with Not_found -> None with
                 | None ->
                   log (Printf.sprintf "nav-tree.sx: target %s has no :children" to_sec);
                   without
                 | Some _ ->
                   let ch_pos = Str.match_beginning () in
                   (* Find the opening paren of the children list *)
                   let lp = ref (ch_pos + 9) in
                   while !lp < String.length without && without.[!lp] <> '(' do incr lp done;
                   (* Find its matching close paren *)
                   let d = ref 0 in
                   let close = ref (String.length without) in
                   for i = !lp to String.length without - 1 do
                     if without.[i] = '(' then incr d
                     else if without.[i] = ')' then begin
                       decr d;
                       if !d = 0 && !close = String.length without then
                         close := i
                     end
                   done;
                   (* Insert block just before the closing paren *)
                   let indent = "\n            " in
                   let result = String.sub without 0 !close ^ indent ^ block ^ String.sub without !close (String.length without - !close) in
                   log (Printf.sprintf "nav-tree.sx: moved %s from %s to %s" slug from_sec to_sec);
                   result))
         in
         Out_channel.with_open_text tf (fun oc -> output_string oc ts3);
         cache_invalidate tf;
         (* 3. Rewrite page-functions.sx component prefix if needed *)
         let pf = sx_dir ^ "/page-functions.sx" in
         let ps = In_channel.with_open_text pf In_channel.input_all in
         let old_comp_prefix = "~" ^ from_sec ^ "/" ^ slug ^ "/" in
         let new_comp_prefix = "~" ^ to_sec ^ "/" ^ slug ^ "/" in
         let ps2 = Str.global_replace (Str.regexp_string old_comp_prefix) new_comp_prefix ps in
         if ps2 <> ps then begin
           Out_channel.with_open_text pf (fun oc -> output_string oc ps2);
           cache_invalidate pf;
           log (Printf.sprintf "page-functions.sx: rewrote %s → %s" old_comp_prefix new_comp_prefix)
         end;
         text_result (Printf.sprintf "Moved %s: %s → %s\n%s" slug from_sec to_sec (Buffer.contents changes))
       end
     | m -> error_result (Printf.sprintf "unknown mode: %s (list, check, add, move, delete)" m))

let handle_sx_playwright args =
  let open Yojson.Safe.Util in
    let pd = project_dir () in
    let spec = args |> member "spec" |> to_string_option in
    let mode = args |> member "mode" |> to_string_option in
    let url = args |> member "url" |> to_string_option in
    let selector = args |> member "selector" |> to_string_option in
    let expr = args |> member "expr" |> to_string_option in
    let actions = args |> member "actions" |> to_string_option in
    let island = args |> member "island" |> to_string_option in
    let phase = args |> member "phase" |> to_string_option in
    let filter = args |> member "filter" |> to_string_option in
    let setup = args |> member "setup" |> to_string_option in
    let stack = args |> member "stack" |> to_string_option in
    let bytecode = try args |> member "bytecode" |> to_bool with _ -> false in
    let files_json = try args |> member "files" with _ -> `Null in
    (* Determine whether to run specs or the inspector *)
    let use_inspector = match mode with
      | Some m when m <> "run" -> true
      | _ -> spec = None && mode <> None
    in
    if not use_inspector then begin
      (* Original spec runner *)
      let spec_arg = match spec with Some s -> " " ^ s | None -> "" in
      let cmd = Printf.sprintf "cd %s/tests/playwright && npx playwright test%s --reporter=line 2>&1" pd spec_arg in
      let (_code, output) = run_command cmd in
      let all_lines = String.split_on_char '\n' output in
      (* Count passed/failed/skipped from the summary line *)
      let summary = List.find_opt (fun l ->
        try let _ = Str.search_forward (Str.regexp "passed\\|failed") l 0 in true
        with Not_found -> false) (List.rev all_lines) in
      (* Extract test names that failed *)
      let fail_names = List.filter_map (fun l ->
        let t = String.trim l in
        if String.length t > 2 then
          try
            let _ = Str.search_forward (Str.regexp "› .* › ") t 0 in
            Some ("  " ^ t)
          with Not_found -> None
        else None) all_lines in
      (* Extract error messages (lines starting with Error:) *)
      let errors = List.filter_map (fun l ->
        let t = String.trim l in
        if String.length t > 6 then
          try
            let _ = Str.search_forward (Str.regexp "expect.*\\(received\\)\\|Expected\\|Received\\|Error:.*expect") t 0 in
            Some ("    " ^ t)
          with Not_found -> None
        else None) all_lines in
      let total = List.length fail_names + (match summary with
        | Some s -> (try let _ = Str.search_forward (Str.regexp "\\([0-9]+\\) passed") s 0 in
            int_of_string (Str.matched_group 1 s) with _ -> 0)
        | None -> 0) in
      let summary_str = match summary with Some s -> String.trim s | None -> "no summary" in
      let result =
        if fail_names = [] then
          Printf.sprintf "%s (%d total)" summary_str total
        else
          Printf.sprintf "%s (%d total)\n\nFailed:\n%s\n\nErrors:\n%s"
            summary_str total
            (String.concat "\n" fail_names)
            (String.concat "\n" (List.filteri (fun i _ -> i < 10) errors))
      in
      text_result result
    end else begin
      (* SX-aware inspector *)
      let inspector_args = `Assoc (List.filter_map Fun.id [
        (match mode with Some m -> Some ("mode", `String m) | None -> Some ("mode", `String "inspect"));
        (match url with Some u -> Some ("url", `String u) | None -> None);
        (match selector with Some s -> Some ("selector", `String s) | None -> None);
        (match expr with Some e -> Some ("expr", `String e) | None -> None);
        (match actions with Some a -> Some ("actions", `String a) | None -> None);
        (match island with Some i -> Some ("island", `String i) | None -> None);
        (match phase with Some p -> Some ("phase", `String p) | None -> None);
        (match filter with Some f -> Some ("filter", `String f) | None -> None);
        (match setup with Some s -> Some ("setup", `String s) | None -> None);
        (match stack with Some s -> Some ("stack", `String s) | None -> None);
        (if bytecode then Some ("bytecode", `Bool true) else None);
        (match files_json with
         | `List items -> Some ("files", `List (List.map (fun j -> `String (Yojson.Safe.Util.to_string j)) items))
         | _ -> None);
      ]) in
      let args_json = Yojson.Basic.to_string inspector_args in
      (* Single-quote shell wrapping — escape any literal single quotes in JSON *)
      let shell_safe = String.concat "'\\''" (String.split_on_char '\'' args_json) in
      let cmd = Printf.sprintf "cd %s && node tests/playwright/sx-inspect.js '%s' 2>&1" pd shell_safe in
      let (_code, raw) = run_command cmd in
      (* Try to parse as JSON and format nicely *)
      try
        let json = Yojson.Basic.from_string raw in
        let pretty = Yojson.Basic.pretty_to_string json in
        text_result pretty
      with _ ->
        text_result raw
    end

let handle_sx_harness_eval args =
  let open Yojson.Safe.Util in
    let expr_str = args |> member "expr" |> to_string in
    let mock_str = args |> member "mock" |> to_string_option in
    let file = args |> member "file" |> to_string_option in
    let setup_str = args |> member "setup" |> to_string_option in
    let files_json = try args |> member "files" with _ -> `Null in
    let host_stubs = match args |> member "host_stubs" with `Bool b -> b | _ -> false in
    let e = !env in
    let warnings = ref [] in
    (* Inject stub host primitives so files using host-get/host-new/etc. can load *)
    if host_stubs then begin
      let stubs = {|
        (define host-global (fn (&rest _) nil))
        (define host-get (fn (&rest _) nil))
        (define host-set! (fn (obj k v) v))
        (define host-call (fn (&rest _) nil))
        (define host-new (fn (&rest _) (dict)))
        (define host-callback (fn (f) f))
        (define host-typeof (fn (&rest _) "string"))
        (define hs-ref-eq (fn (a b) (identical? a b)))
        (define host-call-fn (fn (&rest _) nil))
        (define host-iter? (fn (&rest _) false))
        (define host-to-list (fn (&rest _) (list)))
        (define host-await (fn (&rest _) nil))
        (define host-new-function (fn (&rest _) nil))
        (define load-library! (fn (&rest _) false))
      |} in
      let stub_exprs = Sx_parser.parse_all stubs in
      List.iter (fun expr ->
        try ignore (Sx_ref.eval_expr expr (Env e))
        with exn ->
          warnings := Printf.sprintf "Stub warning: %s" (Printexc.to_string exn) :: !warnings
      ) stub_exprs
    end;
    (* Collect all files to load *)
    let all_files = match files_json with
      | `List items ->
        List.map (fun j -> Yojson.Safe.Util.to_string j) items
      | _ -> match file with Some f -> [f] | None -> []
    in
    (* Smart-load files — only re-evaluate if source changed *)
    let reloaded = smart_load_files e all_files in
    List.iter (fun r ->
      if String.contains r '(' then  (* error entries contain parens *)
        warnings := Printf.sprintf "Warning: %s" r :: !warnings
    ) reloaded;
    (* Run setup expression if provided *)
    (match setup_str with
     | Some s ->
       let setup_exprs = Sx_parser.parse_all s in
       List.iter (fun expr ->
         try ignore (Sx_ref.eval_expr expr (Env e))
         with exn ->
           warnings := Printf.sprintf "Setup error: %s" (Printexc.to_string exn) :: !warnings
       ) setup_exprs
     | None -> ());
    (* Create harness with optional mock overrides — evaluate so fn exprs become lambdas *)
    let mock_arg = match mock_str with
      | Some s ->
        let parsed = Sx_parser.parse_all s in
        if parsed <> [] then
          let evaluated = Sx_ref.eval_expr (List.hd parsed) (Env e) in
          List [Keyword "platform"; evaluated]
        else List []
      | None -> List []
    in
    let session = Sx_ref.cek_call (env_get e "make-harness") mock_arg in
    (* Install interceptors *)
    ignore (call_sx "install-interceptors" [session; Env e]);
    (* IO-aware eval: drives cek_step_loop + cek_resume to handle perform *)
    let io_log = ref [] in
    let eval_with_io expr =
      let state = Sx_ref.make_cek_state expr (Env e) (List []) in
      let rec drive st =
        let final = Sx_ref.cek_step_loop st in
        match Sx_ref.cek_suspended_p final with
        | Bool true ->
          let request = Sx_runtime.get_val final (String "request") in
          io_log := request :: !io_log;
          let resumed = Sx_ref.cek_resume final Nil in
          drive resumed
        | _ -> Sx_ref.cek_value final
      in
      drive state
    in
    (* Evaluate the expression *)
    let exprs = Sx_parser.parse_all expr_str in
    let result = List.fold_left (fun _acc expr ->
      try eval_with_io expr
      with exn -> String (Printf.sprintf "Error: %s" (Printexc.to_string exn))
    ) Nil exprs in
    (* Get the IO log *)
    let log = call_sx "harness-log" [session] in
    let log_str = match log with
      | List items | ListRef { contents = items } when items <> [] ->
        "\n\nIO Log:\n" ^ String.concat "\n" (List.map (fun entry ->
          let op = value_to_string (call_sx "get" [entry; String "op"]) in
          let args_val = call_sx "get" [entry; String "args"] in
          Printf.sprintf "  %s(%s)" op (Sx_types.inspect args_val)
        ) items)
      | _ ->
        if !io_log <> [] then
          "\n\nIO suspensions (" ^ string_of_int (List.length !io_log) ^ "):\n" ^
          String.concat "\n" (List.rev_map (fun req ->
            "  (perform " ^ Sx_types.inspect req ^ ")"
          ) !io_log)
        else "\n\n(no IO calls)"
    in
    let warn_str = if !warnings = [] then "" else
      "\n\nWarnings:\n" ^ String.concat "\n" (List.rev !warnings)
    in
    let reload_str = if reloaded = [] then "" else
      "\n\nReloaded: " ^ String.concat ", " (List.map Filename.basename reloaded) in
    text_result (Printf.sprintf "Result: %s%s%s%s" (Sx_types.inspect result) log_str reload_str warn_str)

let handle_sx_write_file args =
  let open Yojson.Safe.Util in
    let file = args |> member "file" |> to_string in
    let source = args |> member "source" |> to_string in
    (* Validate by parsing as CST — preserves comments and formatting *)
    (try
      let cst = Sx_parser.parse_all_cst source in
      if cst.nodes = [] then error_result "Source parsed to empty — nothing to write"
      else begin
        (* Pretty-print each node but keep trivia *)
        let reformatted = List.map (fun node ->
          let trivia = match node with
            | Sx_cst.CstAtom r -> r.leading_trivia
            | Sx_cst.CstList r -> r.leading_trivia
            | Sx_cst.CstDict r -> r.leading_trivia
          in
          let ast = Sx_cst.cst_to_ast node in
          let pp = pretty_print_value ast in
          let new_cst = Sx_parser.parse_all_cst pp in
          match new_cst.nodes with
          | [n] ->
            (match n with
             | Sx_cst.CstAtom r -> Sx_cst.CstAtom { r with leading_trivia = trivia }
             | Sx_cst.CstList r -> Sx_cst.CstList { r with leading_trivia = trivia }
             | Sx_cst.CstDict r -> Sx_cst.CstDict { r with leading_trivia = trivia })
          | _ -> node
        ) cst.nodes in
        let output = Sx_cst.cst_file_to_source reformatted cst.trailing_trivia in
        Out_channel.with_open_text file (fun oc -> output_string oc output);
        cache_invalidate file;
        text_result (Printf.sprintf "OK — wrote %d bytes (%d top-level forms) to %s" (String.length output) (List.length cst.nodes) file)
      end
    with e -> error_result (Printf.sprintf "Parse error — file not written: %s" (Printexc.to_string e)))

let handle_sx_rename_symbol args =
  let open Yojson.Safe.Util in
    let file = require_file args "file" in
    let tree, cst = parse_file_cst file in
    let old_name = args |> member "old_name" |> to_string in
    let new_name = args |> member "new_name" |> to_string in
    let new_tree = call_sx "rename-symbol" [tree; String old_name; String new_name] in
    let count = call_sx "count-renames" [tree; String old_name] in
    let count_str = value_to_string count in
    write_edit_cst file cst (Dict (let d = Hashtbl.create 2 in Hashtbl.replace d "ok" new_tree; d))
    |> (fun result ->
      match result with
      | `Assoc [("content", `List [`Assoc [("type", _); ("text", `String s)]])] when not (String.starts_with ~prefix:"Error" s) ->
        text_result (Printf.sprintf "Renamed %s occurrences of '%s' → '%s' in %s" count_str old_name new_name file)
      | other -> other)

let handle_sx_replace_by_pattern args =
  let open Yojson.Safe.Util in
    let file = require_file args "file" in
    let tree, cst = parse_file_cst file in
    let pattern = args |> member "pattern" |> to_string in
    let src = args |> member "new_source" |> to_string in
    let all = args |> member "all" |> to_bool_option |> Option.value ~default:false in
    if all then
      write_edit_cst file cst (call_sx "replace-all-by-pattern" [tree; String pattern; String src])
    else
      write_edit_cst file cst (call_sx "replace-by-pattern" [tree; String pattern; String src])

let handle_sx_insert_near args =
  let open Yojson.Safe.Util in
    let file = require_file args "file" in
    let tree, cst = parse_file_cst file in
    let pattern = args |> member "pattern" |> to_string in
    let position = args |> member "position" |> to_string_option |> Option.value ~default:"after" in
    let src = args |> member "new_source" |> to_string in
    write_edit_cst file cst (call_sx "insert-near-pattern" [tree; String pattern; String position; String src])

let handle_sx_rename_across args =
  let open Yojson.Safe.Util in
    let dir = require_dir args "dir" in
    let old_name = args |> member "old_name" |> to_string in
    let new_name = args |> member "new_name" |> to_string in
    let dry_run = args |> member "dry_run" |> to_bool_option |> Option.value ~default:false in
    let files = glob_sx_files dir in
    let results = List.filter_map (fun path ->
      let rel = relative_path ~base:dir path in
      try
        let tree, cst = parse_file_cst path in
        let count = call_sx "count-renames" [tree; String old_name] in
        match count with
        | Number n when n > 0.0 ->
          if dry_run then
            Some (Printf.sprintf "%s: %d occurrences (dry run)" rel (int_of_float n))
          else begin
            let new_tree = call_sx "rename-symbol" [tree; String old_name; String new_name] in
            let result = Dict (let d = Hashtbl.create 2 in Hashtbl.replace d "ok" new_tree; d) in
            ignore (write_edit_cst path cst result);
            Some (Printf.sprintf "%s: %d occurrences renamed" rel (int_of_float n))
          end
        | _ -> None
      with _ -> None
    ) files in
    if results = [] then text_result (Printf.sprintf "No occurrences of '%s' found" old_name)
    else text_result (String.concat "\n" results)

let handle_sx_comp_list args =
  let open Yojson.Safe.Util in
    let dir = require_dir args "dir" in
    let limit = to_int_or ~default:200 (args |> member "limit") in
    let offset = to_int_or ~default:0 (args |> member "offset") in
    let files = glob_sx_files dir in
    let all_lines = List.concat_map (fun path ->
      let rel = relative_path ~base:dir path in
      try
        let exprs = Sx_parser.parse_all (In_channel.with_open_text path In_channel.input_all) in
        List.filter_map (fun expr ->
          match expr with
          | List (Symbol head :: Symbol name :: rest) | ListRef { contents = Symbol head :: Symbol name :: rest } ->
            (match head with
             | "defcomp" | "defisland" | "defmacro" | "defpage" | "define" ->
               let params = match rest with
                 | List ps :: _ | ListRef { contents = ps } :: _ ->
                   String.concat " " (List.map Sx_runtime.value_to_str ps)
                 | _ -> ""
               in
               Some (Printf.sprintf "%-10s %-40s %-50s %s" head name rel params)
             | _ -> None)
          | _ -> None
        ) exprs
      with _ -> []
    ) files in
    if all_lines = [] then text_result "(no definitions found)"
    else
      let total = List.length all_lines in
      let page = all_lines |> List.filteri (fun i _ -> i >= offset && i < offset + limit) in
      text_result (Printf.sprintf "%-10s %-40s %-50s %s  (showing %d-%d of %d)\n%s" "TYPE" "NAME" "FILE" "PARAMS" offset (offset + List.length page) total (String.concat "\n" page))

let handle_sx_find_across args =
  let open Yojson.Safe.Util in
    let dir = require_dir args "dir" in
    let limit = to_int_or ~default:200 (args |> member "limit") in
    let offset = to_int_or ~default:0 (args |> member "offset") in
    let pattern = args |> member "pattern" |> to_string in
    let files = glob_sx_files dir in
    let all_lines = List.concat_map (fun path ->
      let rel = relative_path ~base:dir path in
      try
        let tree = parse_file path in
        let results = native_find_all_raw tree pattern in
        List.map (fun (p, s) -> rel ^ " " ^ native_path_str p ^ " " ^ s) results
      with _ -> []
    ) files in
    if all_lines = [] then text_result "(no matches)"
    else
      let total = List.length all_lines in
      let page = all_lines |> List.filteri (fun i _ -> i >= offset && i < offset + limit) in
      text_result (Printf.sprintf "(showing %d-%d of %d)\n%s" offset (offset + List.length page) total (String.concat "\n" page))

let handle_sx_diff args =
    let file_a = require_file args "file_a" in
    let file_b = require_file args "file_b" in
    let tree_a = parse_file file_a in
    let tree_b = parse_file file_b in
    text_result (value_to_string (call_sx "tree-diff" [tree_a; tree_b]))

let handle_sx_comp_usage args =
  let open Yojson.Safe.Util in
    let dir = require_dir args "dir" in
    let limit = to_int_or ~default:200 (args |> member "limit") in
    let offset = to_int_or ~default:0 (args |> member "offset") in
    let name = args |> member "name" |> to_string in
    let files = glob_sx_files dir in
    let all_lines = List.concat_map (fun path ->
      let rel = relative_path ~base:dir path in
      try
        let tree = parse_file path in
        let results = native_find_all_raw tree name in
        List.map (fun (p, s) -> rel ^ " " ^ native_path_str p ^ " " ^ s) results
      with _ -> []
    ) files in
    if all_lines = [] then text_result "(no usages found)"
    else
      let total = List.length all_lines in
      let page = all_lines |> List.filteri (fun i _ -> i >= offset && i < offset + limit) in
      text_result (Printf.sprintf "(showing %d-%d of %d)\n%s" offset (offset + List.length page) total (String.concat "\n" page))

let handle_sx_eval args =
  let open Yojson.Safe.Util in
    let expr_str = args |> member "expr" |> to_string in
    let e = !env in
    (* Smart-load files — only re-evaluate if source changed *)
    let files_json = try args |> member "files" with _ -> `Null in
    let file = try args |> member "file" |> to_string_option with _ -> None in
    let all_files = match files_json with
      | `List items -> List.map Yojson.Safe.Util.to_string items
      | _ -> match file with Some f -> [f] | None -> []
    in
    let reloaded = smart_load_files e all_files in
    (* Optional IO tracing via harness *)
    let trace_io = try args |> member "trace_io" |> to_bool with _ -> false in
    let session = if trace_io then begin
      let mock_str = try args |> member "mock" |> to_string_option with _ -> None in
      let mock_arg = match mock_str with
        | Some s ->
          let parsed = Sx_parser.parse_all s in
          if parsed <> [] then
            let evaluated = Sx_ref.eval_expr (List.hd parsed) (Env e) in
            List [Keyword "platform"; evaluated]
          else List []
        | None -> List []
      in
      let s = Sx_ref.cek_call (env_get e "make-harness") mock_arg in
      ignore (call_sx "install-interceptors" [s; Env e]);
      Some s
    end else None in
    (* Run setup if provided *)
    let setup_str = try args |> member "setup" |> to_string_option with _ -> None in
    (match setup_str with
     | Some s ->
       List.iter (fun expr -> ignore (Sx_ref.eval_expr expr (Env e))) (Sx_parser.parse_all s)
     | None -> ());
    (* Evaluate *)
    let exprs = Sx_parser.parse_all expr_str in
    let result = List.fold_left (fun _acc expr ->
      try Sx_ref.eval_expr expr (Env e)
      with exn -> String (Printf.sprintf "Error: %s" (Printexc.to_string exn))
    ) Nil exprs in
    (* Format output *)
    let result_str = Sx_runtime.value_to_str result in
    let reload_str = if reloaded = [] then "" else
      "\n\nReloaded: " ^ String.concat ", " (List.map Filename.basename reloaded) in
    let io_str = match session with
      | Some s ->
        let log = call_sx "harness-log" [s] in
        (match log with
         | List items | ListRef { contents = items } when items <> [] ->
           "\n\nIO trace:\n" ^ String.concat "\n" (List.map (fun entry ->
             let op = value_to_string (call_sx "get" [entry; String "op"]) in
             let args_val = call_sx "get" [entry; String "args"] in
             Printf.sprintf "  %s(%s)" op (Sx_types.inspect args_val)
           ) items)
         | _ -> "\n\n(no IO calls)")
      | None -> ""
    in
    text_result (result_str ^ reload_str ^ io_str)

let handle_sx_guard args =
  let open Yojson.Safe.Util in
    let expr_str = args |> member "expr" |> to_string in
    let file = try Some (args |> member "file" |> to_string) with _ -> None in
    let e = !env in
    (match file with
     | Some f -> (try load_sx_file e f with _ -> ())
     | None -> ());
    let exprs = Sx_parser.parse_all expr_str in
    let conditions = ref [] in
    (* Evaluate with error recovery — catch Eval_error, log it, return placeholder *)
    let result = ref Nil in
    (try
      result := List.fold_left (fun _acc expr ->
        Sx_ref.eval_expr expr (Env e)
      ) Nil exprs
    with Eval_error msg ->
      let enhanced = Sx_ref.enhance_error_with_trace msg in
      conditions := enhanced :: !conditions;
      result := String ("<error: " ^ msg ^ ">"));
    let cond_lines = match !conditions with
      | [] -> ""
      | cs -> "\n\nConditions signaled:\n" ^
              String.concat "\n" (List.rev_map (fun c -> "  - " ^ c) cs) in
    text_result (Sx_runtime.value_to_str !result ^ cond_lines)

let handle_sx_render_trace args =
  let open Yojson.Safe.Util in
    let expr_str = args |> member "expr" |> to_string in
    let file = try Some (args |> member "file" |> to_string) with _ -> None in
    let e = !env in
    (match file with
     | Some f -> (try load_sx_file e f with _ -> ())
     | None -> ());
    let exprs = Sx_parser.parse_all expr_str in
    let expr = match exprs with [e] -> e | _ -> List (Symbol "do" :: exprs) in
    let trace = Buffer.create 2048 in
    let truncate s n = if String.length s > n then String.sub s 0 n ^ "..." else s in
    let expr_str = truncate (Sx_runtime.value_to_str expr) 60 in
    let kind = match expr with
      | Nil -> "nil" | Bool _ -> "bool" | Number _ -> "number"
      | String _ -> "string" | Symbol _ -> "symbol" | Keyword _ -> "keyword"
      | RawHTML _ -> "raw-html"
      | List (Symbol s :: _) | ListRef { contents = Symbol s :: _ } ->
        if List.mem s Sx_render.html_tags then "element:" ^ s
        else if List.mem s ["if";"when";"cond";"case";"let";"let*";"do";"begin";"map";"filter";"define";"defcomp"] then "form:" ^ s
        else "call:" ^ s
      | List _ -> "list" | _ -> "other" in
    Buffer.add_string trace (Printf.sprintf "→ %s  %s\n" kind expr_str);
    let result = (try
      Sx_render.sx_render_to_html e expr e
    with Sx_types.Eval_error msg -> "ERROR: " ^ Sx_ref.enhance_error_with_trace msg) in
    let result_str = truncate result 60 in
    Buffer.add_string trace (Printf.sprintf "← %s\n" result_str);
    text_result (Printf.sprintf "Result: %s\n\nRender trace:\n%s" result (Buffer.contents trace))

let handle_sx_trace args =
  let open Yojson.Safe.Util in
    let expr_str = args |> member "expr" |> to_string in
    let max_steps = to_int_or ~default:200 (args |> member "max_steps") in
    let file = try Some (args |> member "file" |> to_string) with _ -> None in
    let components_only = (try args |> member "components_only" |> to_bool with _ -> false) in
    let e = !env in
    (match file with
     | Some f -> (try load_sx_file e f with _ -> ())
     | None -> ());
    let exprs = Sx_parser.parse_all expr_str in
    let expr = match exprs with [e] -> e | _ -> List exprs in
    let state = ref (Sx_ref.make_cek_state expr (Env e) (List [])) in
    let steps = Buffer.create 2048 in
    let step_count = ref 0 in
    let truncate s n = if String.length s > n then String.sub s 0 n ^ "..." else s in
    (* Track comp-trace depth for component-only mode *)
    let comp_depth = ref 0 in
    let prev_comp_depth = ref 0 in
    let get_frame_type kont = match kont with
      | List (CekFrame f :: _) -> f.cf_type
      | List (Dict d :: _) ->
        (match Hashtbl.find_opt d "type" with Some (String s) -> s | _ -> "?")
      | _ -> "done" in
    let count_comp_trace kont =
      let n = ref 0 in
      let k = ref kont in
      (try while true do
        (match !k with
         | List (CekFrame f :: rest) ->
           if f.cf_type = "comp-trace" then incr n;
           k := List rest
         | List (Dict d :: rest) ->
           (match Hashtbl.find_opt d "type" with
            | Some (String "comp-trace") -> incr n | _ -> ());
           k := List rest
         | _ -> raise Exit)
      done with Exit -> ());
      !n in
    (try
      while !step_count < max_steps do
        let s = !state in
        (match s with
         | CekState cs ->
           incr step_count;
           let n = !step_count in
           if components_only then begin
             let depth = count_comp_trace cs.cs_kont in
             (if depth > !prev_comp_depth then begin
               let indent = String.make (depth * 2) ' ' in
               let ft = get_frame_type cs.cs_kont in
               let name = (match cs.cs_kont with
                 | List (CekFrame f :: _) when f.cf_type = "comp-trace" ->
                   (match f.cf_name with String s -> s | _ -> "?")
                 | _ -> "?") in
               Buffer.add_string steps
                 (Printf.sprintf "%s→ ENTER  ~%s\n" indent name);
               ignore ft
             end else if depth < !prev_comp_depth then begin
               let indent = String.make ((depth + 1) * 2) ' ' in
               let val_str = if cs.cs_phase = "continue"
                 then truncate (Sx_runtime.value_to_str cs.cs_value) 60
                 else "..." in
               Buffer.add_string steps
                 (Printf.sprintf "%s← EXIT   → %s\n" indent val_str)
             end);
             prev_comp_depth := depth
           end else begin
             if cs.cs_phase = "eval" then begin
               let ctrl = cs.cs_control in
               (match ctrl with
                | Symbol sym_name ->
                  let resolved = (try
                    let v = Sx_ref.eval_expr ctrl cs.cs_env in
                    truncate (Sx_runtime.value_to_str v) 60
                  with _ -> "???") in
                  Buffer.add_string steps
                    (Printf.sprintf "%3d LOOKUP  %s → %s\n" n sym_name resolved)
                | List (hd :: _) ->
                  let head_str = truncate (Sx_runtime.value_to_str hd) 30 in
                  let ctrl_str = truncate (Sx_runtime.value_to_str ctrl) 80 in
                  Buffer.add_string steps
                    (Printf.sprintf "%3d CALL    %s\n" n ctrl_str);
                  ignore head_str
                | _ ->
                  Buffer.add_string steps
                    (Printf.sprintf "%3d LITERAL %s\n" n
                      (truncate (Sx_runtime.value_to_str ctrl) 60)))
             end else begin
               let val_str = truncate (Sx_runtime.value_to_str cs.cs_value) 60 in
               let ft = get_frame_type cs.cs_kont in
               Buffer.add_string steps
                 (Printf.sprintf "%3d RETURN  %s → %s\n" n val_str ft)
             end
           end;
           ignore comp_depth;
           (match Sx_ref.cek_terminal_p s with
            | Bool true -> raise Exit
            | _ -> ());
           state := Sx_ref.cek_step s
         | _ -> raise Exit)
      done
    with
    | Exit -> ()
    | Eval_error msg ->
      let enhanced = Sx_ref.enhance_error_with_trace msg in
      Buffer.add_string steps (Printf.sprintf "ERROR: %s\n" enhanced)
    | exn ->
      Buffer.add_string steps (Printf.sprintf "ERROR: %s\n" (Printexc.to_string exn)));
    let final_val = (match !state with
      | CekState cs -> Sx_runtime.value_to_str cs.cs_value
      | v -> Sx_runtime.value_to_str v) in
    text_result (Printf.sprintf "Result: %s\n\nTrace (%d steps):\n%s"
      final_val !step_count (Buffer.contents steps))

let handle_sx_deps args =
  let open Yojson.Safe.Util in
    let file = require_file args "file" in
    let name = try Some (args |> member "name" |> to_string) with _ -> None in
    let dir = try args |> member "dir" |> to_string with _ ->
      try Sys.getenv "SX_PROJECT_DIR" with Not_found ->
      try Sys.getenv "PWD" with Not_found -> "." in
    let tree = parse_file file in
    (* Find the target subtree *)
    let target = match name with
      | Some n ->
        (* Find the named define/defcomp/defisland *)
        let items = match tree with List l | ListRef { contents = l } -> l | _ -> [tree] in
        let found = List.find_opt (fun item ->
          match item with
          | List (Symbol head :: Symbol def_name :: _)
          | List (Symbol head :: List (Symbol def_name :: _) :: _)
            when (head = "define" || head = "defcomp" || head = "defisland" ||
                  head = "defmacro" || head = "deftest") ->
            def_name = n || ("~" ^ def_name) = n || def_name = String.sub n 1 (String.length n - 1)
          | _ -> false
        ) items in
        (match found with Some f -> f | None -> tree)
      | None -> tree
    in
    let free_syms = call_sx "collect-free-symbols" [target] in
    let sym_names = match free_syms with
      | List items | ListRef { contents = items } ->
        List.filter_map (fun v -> match v with String s -> Some s | _ -> None) items
      | _ -> []
    in
    (* Resolve where each symbol is defined *)
    let file_defines = Hashtbl.create 32 in
    let same_file_items = match tree with List l | ListRef { contents = l } -> l | _ -> [] in
    List.iter (fun item ->
      match item with
      | List (Symbol head :: Symbol def_name :: _)
        when (head = "define" || head = "defcomp" || head = "defisland" || head = "defmacro") ->
        Hashtbl.replace file_defines def_name true
      | _ -> ()
    ) same_file_items;
    (* Check primitives *)
    let is_prim name = try ignore (Sx_primitives.get_primitive name); true with _ -> false in
    (* Scan directory for definitions *)
    let all_sx_files = glob_sx_files dir in
    let ext_defs = Hashtbl.create 64 in
    List.iter (fun path ->
      if path <> file then
        try
          let t = parse_file path in
          let items = match t with List l | ListRef { contents = l } -> l | _ -> [] in
          List.iter (fun item ->
            match item with
            | List (Symbol head :: Symbol def_name :: _)
              when (head = "define" || head = "defcomp" || head = "defisland" || head = "defmacro") ->
              if not (Hashtbl.mem ext_defs def_name) then
                Hashtbl.replace ext_defs def_name (relative_path ~base:dir path)
            | _ -> ()
          ) items
        with _ -> ()
    ) all_sx_files;
    (* Find use declarations *)
    let use_decls = call_sx "find-use-declarations" [tree] in
    let declared_modules = match use_decls with
      | List items | ListRef { contents = items } ->
        List.filter_map (fun v -> match v with String s -> Some s | _ -> None) items
      | _ -> []
    in
    (* Format output *)
    let lines = List.map (fun sym ->
      if Hashtbl.mem file_defines sym then
        Printf.sprintf "  %-30s (same file)" sym
      else if is_prim sym then
        Printf.sprintf "  %-30s [primitive]" sym
      else match Hashtbl.find_opt ext_defs sym with
        | Some path -> Printf.sprintf "  %-30s %s" sym path
        | None -> Printf.sprintf "  %-30s ???" sym
    ) sym_names in
    let header = match name with
      | Some n -> Printf.sprintf "Dependencies of %s in %s" n file
      | None -> Printf.sprintf "Dependencies of %s" file
    in
    let use_str = if declared_modules = [] then "" else
      Printf.sprintf "\n\nDeclared modules (use):\n  %s" (String.concat ", " declared_modules)
    in
    text_result (Printf.sprintf "%s\n%d symbols referenced:\n%s%s"
      header (List.length sym_names) (String.concat "\n" lines) use_str)

let handle_sx_build_manifest args =
  let open Yojson.Safe.Util in
    let target = (try args |> member "target" |> to_string with _ -> "js") in
    (match target with
     | "ocaml" ->
       let e = !env in
       (* Collect all bindings from the env *)
       let bindings = ref [] in
       (* Walk env chain collecting all bindings *)
       let rec collect_bindings env acc =
         Hashtbl.iter (fun id v ->
           if not (Hashtbl.mem acc id) then Hashtbl.replace acc id v
         ) env.bindings;
         match env.parent with Some p -> collect_bindings p acc | None -> ()
       in
       let all = Hashtbl.create 256 in
       collect_bindings e all;
       Hashtbl.iter (fun id v ->
         let k = Sx_types.unintern id in
         let kind = match v with
           | NativeFn _ -> "native"
           | Lambda _ -> "lambda"
           | Component _ -> "component"
           | Island _ -> "island"
           | Macro _ -> "macro"
           | _ -> "value"
         in
         bindings := (k, kind) :: !bindings
       ) all;
       let sorted = List.sort (fun (a,_) (b,_) -> String.compare a b) !bindings in
       let by_kind = Hashtbl.create 8 in
       List.iter (fun (name, kind) ->
         let cur = try Hashtbl.find by_kind kind with Not_found -> [] in
         Hashtbl.replace by_kind kind (name :: cur)
       ) sorted;
       let sections = Buffer.create 2048 in
       Buffer.add_string sections "OCaml Build Manifest\n====================\n\n";
       Buffer.add_string sections (Printf.sprintf "Total bindings: %d\n\n" (List.length sorted));
       Buffer.add_string sections "Loaded files: parser.sx, tree-tools.sx, harness.sx\n\n";
       List.iter (fun kind ->
         match Hashtbl.find_opt by_kind kind with
         | Some names ->
           let rev_names = List.rev names in
           Buffer.add_string sections
             (Printf.sprintf "%s (%d):\n  %s\n\n" kind (List.length rev_names)
               (String.concat ", " rev_names))
         | None -> ()
       ) ["native"; "lambda"; "macro"; "component"; "island"; "value"];
       text_result (Buffer.contents sections)
     | _ ->
       let pd = project_dir () in
       let cmd = Printf.sprintf "cd %s && python3 hosts/javascript/manifest.py 2>&1"
         (Filename.quote pd) in
       let (_code, output) = run_command cmd in
       text_result output)

let handle_sx_explain args =
  let open Yojson.Safe.Util in
    let form_name = args |> member "name" |> to_string in
    let e = !env in
    let result = try
      let find_fn = env_get e "find-rule" in
      Sx_ref.cek_call find_fn (List [String form_name])
    with _ -> Nil in
    (match result with
     | Dict d ->
       let get_str k = match Hashtbl.find_opt d k with
         | Some (String s) -> s | Some v -> value_to_string v | None -> "" in
       let effects = match Hashtbl.find_opt d "effects" with
         | Some (List items) -> String.concat ", " (List.map value_to_string items)
         | Some Nil -> "none" | _ -> "none" in
       let examples = match Hashtbl.find_opt d "examples" with
         | Some (String s) -> "  " ^ s
         | Some (List items) ->
           String.concat "\n" (List.map (fun ex -> "  " ^ value_to_string ex) items)
         | _ -> "  (none)" in
       text_result (Printf.sprintf "%s\n  Category: %s\n  Pattern:  %s\n  Effects:  %s\n\n%s\n\nExamples:\n%s"
         (get_str "name") (get_str "category") (get_str "pattern") effects
         (get_str "rule") examples)
     | _ ->
       (* Try listing by category *)
       let cats_fn = try env_get e "rules-by-category" with _ -> Nil in
       let cat_results = try Sx_ref.cek_call cats_fn (List [String form_name]) with _ -> Nil in
       (match cat_results with
        | List items when items <> [] ->
          let lines = List.map (fun rule ->
            match rule with
            | Dict rd ->
              let name = match Hashtbl.find_opt rd "name" with Some (String s) -> s | _ -> "?" in
              let pattern = match Hashtbl.find_opt rd "pattern" with Some (String s) -> s | _ -> "" in
              Printf.sprintf "  %-16s %s" name pattern
            | _ -> "  " ^ value_to_string rule
          ) items in
          text_result (Printf.sprintf "Category: %s (%d rules)\n\n%s"
            form_name (List.length items) (String.concat "\n" lines))
        | _ ->
          (* List all categories *)
          let all_cats = try Sx_ref.cek_call (env_get e "rule-categories") Nil with _ -> Nil in
          let cat_str = match all_cats with
            | List items -> String.concat ", " (List.filter_map (fun v ->
                match v with String s -> Some s | _ -> None) items)
            | _ -> "?" in
          error_result (Printf.sprintf "No rule found for '%s'. Categories: %s" form_name cat_str)))

  (* ================================================================== *)
  (* Server inspection tools                                             *)
  (* ================================================================== *)

let handle_sx_load_check _args =
  ignore _args;
    (* Load all .sx files the HTTP server would load, report errors *)
    let pd = project_dir () in
    let spec_base = pd ^ "/spec" in
    let lib_base = pd ^ "/lib" in
    let web_base = pd ^ "/web" in
    let shared_sx = pd ^ "/shared/sx/templates" in
    let sx_sx =
      let dp = pd ^ "/sx" in
      let dv = pd ^ "/sx/sx" in
      if Sys.file_exists (dp ^ "/page-functions.sx") then dp else dv in
    let sx_sxc =
      let dp = pd ^ "/sxc" in
      let dv = pd ^ "/sx/sxc" in
      if Sys.file_exists dp then dp else dv in
    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 errors = Buffer.create 256 in
    let ok_count = ref 0 in
    let err_count = ref 0 in
    let test_env = Sx_types.make_env () in
    (* Bind minimal stubs so files can define things *)
    ignore (Sx_types.env_bind test_env "register-special-form!" (NativeFn ("register-special-form!", fun args ->
      match args with [String _; _] -> Nil | _ -> Nil)));
    ignore (Sx_types.env_bind test_env "*custom-special-forms*" (Dict (Hashtbl.create 0)));
    let check_file path =
      if Sys.file_exists path then begin
        try
          let exprs = Sx_parser.parse_file path in
          ignore (List.length exprs);
          incr ok_count
        with e ->
          incr err_count;
          Buffer.add_string errors (Printf.sprintf "  PARSE ERROR %s: %s\n" (Filename.basename path) (Printexc.to_string e))
      end in
    let rec check_dir 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 check_dir 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
            check_file path
        ) entries
      end in
    (* Check core files *)
    List.iter check_file [
      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 ^ "/web-forms.sx"; web_base ^ "/engine.sx";
      web_base ^ "/request-handler.sx"; web_base ^ "/page-helpers.sx";
    ];
    (* Check all dirs *)
    check_dir lib_base;
    check_dir shared_sx;
    check_dir sx_sxc;
    check_dir sx_sx;
    if !err_count = 0 then
      text_result (Printf.sprintf "OK — %d files parse cleanly" !ok_count)
    else
      text_result (Printf.sprintf "%d files OK, %d errors:\n%s" !ok_count !err_count (Buffer.contents errors))

let handle_sx_env args =
  let open Yojson.Safe.Util in
    (* Query running server for defined symbols *)
    let pattern = args |> member "pattern" |> to_string_option |> Option.value ~default:"*" in
    let type_filter = args |> member "type" |> to_string_option in
    (* Search the MCP tool's own env *)
    let e = !env in
    let matches = ref [] in
    Hashtbl.iter (fun id v ->
      let name = Sx_types.unintern id in
      let type_name = Sx_runtime.type_of v |> Sx_runtime.value_to_str in
      let matches_pattern =
        if pattern = "*" then true
        else if String.length pattern > 0 && pattern.[String.length pattern - 1] = '*' then
          let prefix = String.sub pattern 0 (String.length pattern - 1) in
          String.length name >= String.length prefix &&
          String.sub name 0 (String.length prefix) = prefix
        else name = pattern in
      let matches_type = match type_filter with
        | None -> true | Some t -> type_name = "\"" ^ t ^ "\"" in
      if matches_pattern && matches_type then
        matches := (name, type_name) :: !matches
    ) e.bindings;
    let sorted = List.sort (fun (a,_) (b,_) -> String.compare a b) !matches in
    let lines = List.map (fun (name, tp) -> Printf.sprintf "  %-40s %s" name tp) sorted in
    text_result (Printf.sprintf "%d matches:\n%s" (List.length sorted) (String.concat "\n" lines))

let handle_sx_handler_list _args =
  ignore _args;
    (* List all registered defhandler forms *)
    let e = !env in
    let handlers = ref [] in
    Hashtbl.iter (fun id v ->
      let name = Sx_types.unintern id in
      if String.length name > 8 && String.sub name 0 8 = "handler:" then begin
        let handler_name = String.sub name 8 (String.length name - 8) in
        let method_ = match v with
          | Dict d -> (match Hashtbl.find_opt d "method" with
            | Some (String m) -> String.uppercase_ascii m
            | Some (Keyword m) -> String.uppercase_ascii m
            | _ -> "GET")
          | _ -> "?" in
        let path = match v with
          | Dict d -> (match Hashtbl.find_opt d "path" with
            | Some (String p) -> p | _ -> "(no path)")
          | _ -> "?" in
        handlers := (handler_name, method_, path) :: !handlers
      end
    ) e.bindings;
    let sorted = List.sort (fun (a,_,_) (b,_,_) -> String.compare a b) !handlers in
    let lines = List.map (fun (name, m, p) ->
      Printf.sprintf "  %-6s %-20s %s" m name p) sorted in
    if sorted = [] then
      text_result "No handlers registered. Load handlers/examples.sx first."
    else
      text_result (Printf.sprintf "%d handlers:\n%s" (List.length sorted) (String.concat "\n" lines))

let handle_sx_page_list _args =
  ignore _args;
    (* List all page functions by scanning page-functions.sx *)
    let pd = project_dir () in
    let pf_path =
      let dp = pd ^ "/sx/page-functions.sx" in
      let dv = pd ^ "/sx/sx/page-functions.sx" in
      if Sys.file_exists dp then dp else dv in
    if not (Sys.file_exists pf_path) then
      error_result "page-functions.sx not found"
    else begin
      try
        let exprs = Sx_parser.parse_file pf_path in
        let pages = List.filter_map (fun expr ->
          match expr with
          | List (Symbol "define" :: Symbol name :: _) -> Some name
          | List (Symbol "define" :: String name :: _) -> Some name
          | _ -> None
        ) exprs in
        let lines = List.map (fun name ->
          Printf.sprintf "  /sx/(%s)" name) pages in
        text_result (Printf.sprintf "%d page functions:\n%s" (List.length pages) (String.concat "\n" lines))
      with e ->
        error_result (Printf.sprintf "Parse error: %s" (Printexc.to_string e))
    end

let handle_sx_request args =
  let open Yojson.Safe.Util in
    (* Simulate HTTP request to running server *)
    let url = args |> member "url" |> to_string in
    let method_ = args |> member "method" |> to_string_option |> Option.value ~default:"GET" in
    let port = 8013 in
    let path = if String.length url > 0 && url.[0] = '/' then url
      else if String.length url > 4 && String.sub url 0 4 = "http" then
        try let i = String.index_from url 10 '/' in
          String.sub url i (String.length url - i) with Not_found -> url
      else "/" ^ url in
    (try
      let addr = Unix.ADDR_INET (Unix.inet_addr_loopback, port) in
      let sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
      Unix.connect sock addr;
      let request = Printf.sprintf "%s %s HTTP/1.1\r\nHost: localhost\r\nSX-Request: true\r\nConnection: close\r\n\r\n" method_ path in
      let _ = Unix.write_substring sock request 0 (String.length request) in
      let buf = Buffer.create 4096 in
      let tmp = Bytes.create 4096 in
      let rec read_all () =
        let n = try Unix.read sock tmp 0 4096 with _ -> 0 in
        if n > 0 then begin
          Buffer.add_subbytes buf tmp 0 n;
          read_all ()
        end in
      read_all ();
      Unix.close sock;
      let response = Buffer.contents buf in
      (* Extract status line and body *)
      let body_start =
        let rec find i =
          if i + 4 > String.length response then 0
          else if String.sub response i 4 = "\r\n\r\n" then i + 4
          else find (i + 1) in
        find 0 in
      let status_line = try String.sub response 0 (String.index response '\r')
        with Not_found -> "?" in
      let body = if body_start > 0 && body_start < String.length response then
        String.sub response body_start (String.length response - body_start)
      else response in
      let body_preview = if String.length body > 2000 then
        String.sub body 0 2000 ^ "\n... (" ^ string_of_int (String.length body) ^ " bytes total)"
      else body in
      text_result (Printf.sprintf "%s\nBody (%d bytes):\n%s" status_line (String.length body) body_preview)
    with e ->
      error_result (Printf.sprintf "Connection failed (server running on port %d?): %s" port (Printexc.to_string e)))

let handle_tool name args =
  match Hashtbl.find_opt tool_handlers name with
  | Some handler ->
    (try
      let file_arg = try Yojson.Safe.Util.(args |> member "file" |> to_string) with _ -> "" in
      let t0 = Unix.gettimeofday () in
      let r = handler args in
      let elapsed = (Unix.gettimeofday () -. t0) *. 1000.0 in
      log_msg "OK [%s] %s (%.0fms)" name (if file_arg <> "" then "file=" ^ file_arg else "") elapsed;
      r
     with Invalid_argument msg ->
        log_msg "INVALID_ARG [%s]: %s" name msg;
        error_result msg
        | Stack_overflow ->
        log_msg "STACK OVERFLOW [%s]" name;
        error_result "Stack overflow — file too large or recursive structure"
        | Out_of_memory ->
        log_msg "OUT OF MEMORY [%s]" name;
        error_result "Out of memory"
        | e ->
        log_msg "EXCEPTION [%s]: %s" name (Printexc.to_string e);
        error_result ("Error: " ^ Printexc.to_string e))
  | None ->
    log_msg "UNKNOWN TOOL: %s" name;
    error_result ("Unknown tool: " ^ name)

let () =
  register "sx_read_tree" handle_sx_read_tree;
  register "sx_summarise" handle_sx_summarise;
  register "sx_read_subtree" handle_sx_read_subtree;
  register "sx_get_context" handle_sx_get_context;
  register "sx_find_all" handle_sx_find_all;
  register "sx_get_siblings" handle_sx_get_siblings;
  register "sx_validate" handle_sx_validate;
  register "sx_replace_node" handle_sx_replace_node;
  register "sx_insert_child" handle_sx_insert_child;
  register "sx_delete_node" handle_sx_delete_node;
  register "sx_wrap_node" handle_sx_wrap_node;
  register "sx_format_check" handle_sx_format_check;
  register "sx_macroexpand" handle_sx_macroexpand;
  register "sx_build" handle_sx_build;
  register "sx_build_bytecode" handle_sx_build_bytecode;
  register "sx_test" handle_sx_test;
  register "sx_pretty_print" handle_sx_pretty_print;
  register "sx_changed" handle_sx_changed;
  register "sx_diff_branch" handle_sx_diff_branch;
  register "sx_blame" handle_sx_blame;
  register "sx_doc_gen" handle_sx_doc_gen;
  register "sx_nav" handle_sx_nav;
  register "sx_playwright" handle_sx_playwright;
  register "sx_harness_eval" handle_sx_harness_eval;
  register "sx_write_file" handle_sx_write_file;
  register "sx_rename_symbol" handle_sx_rename_symbol;
  register "sx_replace_by_pattern" handle_sx_replace_by_pattern;
  register "sx_insert_near" handle_sx_insert_near;
  register "sx_rename_across" handle_sx_rename_across;
  register "sx_comp_list" handle_sx_comp_list;
  register "sx_find_across" handle_sx_find_across;
  register "sx_diff" handle_sx_diff;
  register "sx_comp_usage" handle_sx_comp_usage;
  register "sx_eval" handle_sx_eval;
  register "sx_guard" handle_sx_guard;
  register "sx_render_trace" handle_sx_render_trace;
  register "sx_trace" handle_sx_trace;
  register "sx_deps" handle_sx_deps;
  register "sx_build_manifest" handle_sx_build_manifest;
  register "sx_explain" handle_sx_explain;
  register "sx_load_check" handle_sx_load_check;
  register "sx_env" handle_sx_env;
  register "sx_handler_list" handle_sx_handler_list;
  register "sx_page_list" handle_sx_page_list;
  register "sx_request" handle_sx_request;
  ()


(* ------------------------------------------------------------------ *)
(* MCP tool definitions                                                *)
(* ------------------------------------------------------------------ *)

let tool name desc props required =
  `Assoc [
    ("name", `String name);
    ("description", `String desc);
    ("inputSchema", `Assoc [
      ("type", `String "object");
      ("required", `List (List.map (fun r -> `String r) required));
      ("properties", `Assoc props)])]

let file_prop = ("file", `Assoc [("type", `String "string"); ("description", `String "Path to .sx file")])
let path_prop = ("path", `Assoc [("type", `String "string"); ("description", `String "SX path, e.g. \"(0 2 1)\"")])
let dir_prop = ("dir", `Assoc [("type", `String "string"); ("description", `String "Directory to scan recursively")])

let tool_definitions = `List [
  tool "sx_read_tree" "Read an .sx file as an annotated tree with path labels. Auto-summarises large files (>200 lines). Use focus to expand only matching subtrees, max_depth for depth limit, or max_lines+offset for pagination."
    [file_prop;
     ("focus", `Assoc [("type", `String "string"); ("description", `String "Pattern — expand matching subtrees, collapse rest")]);
     ("max_depth", `Assoc [("type", `String "integer"); ("description", `String "Depth limit (like summarise)")]);
     ("max_lines", `Assoc [("type", `String "integer"); ("description", `String "Max lines to return (pagination)")]);
     ("offset", `Assoc [("type", `String "integer"); ("description", `String "Line offset for pagination (default 0)")])]
    ["file"];
  tool "sx_summarise" "Folded structural overview of an .sx file. Use to orient before drilling into a region."
    [file_prop; ("depth", `Assoc [("type", `String "integer"); ("description", `String "Max depth (0=heads only, default 2)")])] ["file"];
  tool "sx_read_subtree" "Expand a specific subtree by path. Use after summarise to drill in."
    [file_prop; path_prop] ["file"; "path"];
  tool "sx_get_context" "Show enclosing chain from root to a target node."
    [file_prop; path_prop] ["file"; "path"];
  tool "sx_find_all" "Search for nodes matching a pattern. Returns paths and summaries."
    [file_prop; ("pattern", `Assoc [("type", `String "string"); ("description", `String "Search pattern")])] ["file"; "pattern"];
  tool "sx_get_siblings" "Show siblings of a node with target marked."
    [file_prop; path_prop] ["file"; "path"];
  tool "sx_validate" "Check structural integrity of an .sx file."
    [file_prop] ["file"];
  tool "sx_replace_node" "Replace node at path with new SX source. Fragment is parsed before file is touched."
    [file_prop; path_prop; ("new_source", `Assoc [("type", `String "string"); ("description", `String "New SX source")])] ["file"; "path"; "new_source"];
  tool "sx_insert_child" "Insert new child at index within a list node."
    [file_prop; path_prop; ("index", `Assoc [("type", `String "integer"); ("description", `String "Insert position")]); ("new_source", `Assoc [("type", `String "string"); ("description", `String "New SX source")])] ["file"; "path"; "index"; "new_source"];
  tool "sx_delete_node" "Remove node at path. Siblings shift to fill gap."
    [file_prop; path_prop] ["file"; "path"];
  tool "sx_wrap_node" "Wrap node in a new form. Use _ as placeholder, e.g. \"(when cond _)\"."
    [file_prop; path_prop; ("wrapper", `Assoc [("type", `String "string"); ("description", `String "Wrapper with _ placeholder")])] ["file"; "path"; "wrapper"];
  tool "sx_eval" "Evaluate SX in the persistent image. Definitions survive between calls. Files are smart-loaded (only re-evaluated if source changed on disk). With trace_io=true, wraps in harness to capture all IO calls."
    [("expr", `Assoc [("type", `String "string"); ("description", `String "SX expression to evaluate")]);
     ("file", `Assoc [("type", `String "string"); ("description", `String "Optional .sx file to load")]);
     ("files", `Assoc [("type", `String "array"); ("items", `Assoc [("type", `String "string")]); ("description", `String "Multiple .sx files to load in order (smart reload — skips unchanged)")]);
     ("setup", `Assoc [("type", `String "string"); ("description", `String "SX expression to run before main eval")]);
     ("trace_io", `Assoc [("type", `String "boolean"); ("description", `String "Wrap in test harness to capture IO trace (default: false)")]);
     ("mock", `Assoc [("type", `String "string"); ("description", `String "Mock platform overrides as SX dict (requires trace_io)")])]
    ["expr"];
  tool "sx_guard" "Evaluate with error recovery. Catches errors, shows component trace, and continues. Returns result + any conditions signaled."
    [("expr", `Assoc [("type", `String "string"); ("description", `String "SX expression to evaluate with error recovery")]);
     ("file", `Assoc [("type", `String "string"); ("description", `String "Optional .sx file to load for definitions")])] ["expr"];
  tool "sx_render_trace" "Render an SX expression to HTML with full dispatch tracing. Shows which render path each sub-expression takes."
    [("expr", `Assoc [("type", `String "string"); ("description", `String "SX expression to render with tracing")]);
     ("file", `Assoc [("type", `String "string"); ("description", `String "Optional .sx file to load for definitions")])] ["expr"];
  tool "sx_trace" "Step-through SX evaluation showing each CEK machine step (symbol lookups, function calls, returns). Set components_only=true for component entry/exit only."
    [("expr", `Assoc [("type", `String "string"); ("description", `String "SX expression to trace")]);
     ("file", `Assoc [("type", `String "string"); ("description", `String "Optional .sx file to load for definitions")]);
     ("max_steps", `Assoc [("type", `String "integer"); ("description", `String "Max CEK steps to show (default: 200)")]);
     ("components_only", `Assoc [("type", `String "boolean"); ("description", `String "Show only component entry/exit events (default: false)")])] ["expr"];
  tool "sx_explain" "Explain SX evaluation rules. Pass a form name (if, let, map, ...) or category (literal, special-form, higher-order, ...)."
    [("name", `Assoc [("type", `String "string"); ("description", `String "Form name or category to explain")])] ["name"];
  tool "sx_load_check" "Validate all .sx files that the HTTP server loads. Reports parse errors. No server needed."
    [] [];
  tool "sx_env" "Search defined symbols in the MCP environment. Supports wildcard patterns (e.g. \"handler:*\", \"~examples*\")."
    [("pattern", `Assoc [("type", `String "string"); ("description", `String "Symbol name or pattern (* wildcard). Default: *")]);
     ("type", `Assoc [("type", `String "string"); ("description", `String "Filter by type: component, island, lambda, macro, native")])]
    [];
  tool "sx_handler_list" "List all registered defhandler forms with their HTTP methods and paths."
    [] [];
  tool "sx_page_list" "List all page functions from page-functions.sx with their URL patterns."
    [] [];
  tool "sx_request" "Send an HTTP request to the running SX server (localhost:8013). Returns status + response body."
    [("url", `Assoc [("type", `String "string"); ("description", `String "URL path (e.g. /sx/(geography)) or full URL")]);
     ("method", `Assoc [("type", `String "string"); ("description", `String "HTTP method: GET (default), POST, PUT, DELETE")])]
    ["url"];
  tool "sx_deps" "Dependency analysis for a component or file. Shows all referenced symbols and where they're defined."
    [file_prop;
     ("name", `Assoc [("type", `String "string"); ("description", `String "Specific define/defcomp/defisland to analyze")]);
     ("dir", `Assoc [("type", `String "string"); ("description", `String "Directory to search for definitions (default: project root)")])] ["file"];
  tool "sx_build_manifest" "Show build manifest: which modules, primitives, adapters, and exports are included in a JS or OCaml build."
    [("target", `Assoc [("type", `String "string"); ("description", `String "Build target: \"js\" (default) or \"ocaml\"")])] [];
  tool "sx_find_across" "Search for a pattern across all .sx files under a directory. Returns file paths, tree paths, and summaries. Paginated (default 200 results)."
    [dir_prop; ("pattern", `Assoc [("type", `String "string"); ("description", `String "Search pattern")]);
     ("limit", `Assoc [("type", `String "integer"); ("description", `String "Max results to return (default: 200)")]);
     ("offset", `Assoc [("type", `String "integer"); ("description", `String "Skip first N results (default: 0)")])] ["dir"; "pattern"];
  tool "sx_comp_list" "List all definitions (defcomp, defisland, defmacro, defpage, define) across .sx files in a directory. Paginated (default 200 results)."
    [dir_prop;
     ("limit", `Assoc [("type", `String "integer"); ("description", `String "Max results to return (default: 200)")]);
     ("offset", `Assoc [("type", `String "integer"); ("description", `String "Skip first N results (default: 0)")])] ["dir"];
  tool "sx_comp_usage" "Find all uses of a component or symbol name across .sx files in a directory. Paginated (default 200 results)."
    [dir_prop; ("name", `Assoc [("type", `String "string"); ("description", `String "Component or symbol name to search for")]);
     ("limit", `Assoc [("type", `String "integer"); ("description", `String "Max results to return (default: 200)")]);
     ("offset", `Assoc [("type", `String "integer"); ("description", `String "Skip first N results (default: 0)")])] ["dir"; "name"];
  tool "sx_diff" "Structural diff between two .sx files. Reports ADDED, REMOVED, CHANGED nodes with paths."
    [("file_a", `Assoc [("type", `String "string"); ("description", `String "Path to first .sx file")]);
     ("file_b", `Assoc [("type", `String "string"); ("description", `String "Path to second .sx file")])] ["file_a"; "file_b"];
  tool "sx_format_check" "Lint an .sx file for common issues: empty let bindings, missing bodies, duplicate params, structural problems."
    [file_prop] ["file"];
  tool "sx_macroexpand" "Evaluate an SX expression with a file's definitions loaded. Use to test macros — the file's defmacro forms are available."
    [("file", `Assoc [("type", `String "string"); ("description", `String "Optional .sx file to load for macro/component definitions")]);
     ("expr", `Assoc [("type", `String "string"); ("description", `String "Expression to expand/evaluate")])]
    ["expr"];
  tool "sx_build" "Build the SX runtime. Target \"js\" (default) builds sx-browser.js, \"ocaml\" runs dune build, \"wasm\" does full pipeline (dune + bundle + bytecode compile + deploy to shared/static/wasm/). Set full=true for extensions+types."
    [("target", `Assoc [("type", `String "string"); ("description", `String "Build target: \"js\" (default), \"ocaml\", or \"wasm\" (full WASM pipeline: build + bundle + bytecode + deploy)")]);
     ("full", `Assoc [("type", `String "boolean"); ("description", `String "Include extensions and type system (default: false)")])]
    [];
  tool "sx_build_bytecode" "Compile all web .sx files to pre-compiled .sxbc.json bytecode modules for the WASM browser kernel."
    [] [];
  tool "sx_test" "Run SX test suite. Returns pass/fail summary and any failures."
    [("host", `Assoc [("type", `String "string"); ("description", `String "Test host: \"js\" (default) or \"ocaml\"")]);
     ("full", `Assoc [("type", `String "boolean"); ("description", `String "Run full test suite including extensions (default: false)")])]
    [];
  tool "sx_pretty_print" "Reformat an .sx file with indentation. Short forms stay on one line, longer forms break across lines."
    [file_prop] ["file"];
  tool "sx_write_file" "Create or overwrite an .sx file. Source is parsed first — malformed SX is rejected and the file is not touched."
    [file_prop;
     ("source", `Assoc [("type", `String "string"); ("description", `String "SX source to write")])]
    ["file"; "source"];
  tool "sx_rename_symbol" "Rename all occurrences of a symbol in an .sx file. Structural — only renames symbols, not strings."
    [file_prop;
     ("old_name", `Assoc [("type", `String "string"); ("description", `String "Current symbol name")]);
     ("new_name", `Assoc [("type", `String "string"); ("description", `String "New symbol name")])]
    ["file"; "old_name"; "new_name"];
  tool "sx_replace_by_pattern" "Find nodes matching a pattern and replace with new source. Set all=true to replace all matches (default: first only)."
    [file_prop;
     ("pattern", `Assoc [("type", `String "string"); ("description", `String "Search pattern to match")]);
     ("new_source", `Assoc [("type", `String "string"); ("description", `String "Replacement SX source")]);
     ("all", `Assoc [("type", `String "boolean"); ("description", `String "Replace all matches (default: first only)")])]
    ["file"; "pattern"; "new_source"];
  tool "sx_insert_near" "Insert new source before or after the first node matching a pattern. No path needed."
    [file_prop;
     ("pattern", `Assoc [("type", `String "string"); ("description", `String "Pattern to find insertion point")]);
     ("new_source", `Assoc [("type", `String "string"); ("description", `String "SX source to insert")]);
     ("position", `Assoc [("type", `String "string"); ("description", `String "\"before\" or \"after\" (default: after)")])]
    ["file"; "pattern"; "new_source"];
  tool "sx_rename_across" "Rename a symbol across all .sx files in a directory. Use dry_run=true to preview without writing."
    [dir_prop;
     ("old_name", `Assoc [("type", `String "string"); ("description", `String "Current symbol name")]);
     ("new_name", `Assoc [("type", `String "string"); ("description", `String "New symbol name")]);
     ("dry_run", `Assoc [("type", `String "boolean"); ("description", `String "Preview changes without writing (default: false)")])]
    ["dir"; "old_name"; "new_name"];
  tool "sx_changed" "List .sx files changed since a git ref (default: main) with depth-1 summaries."
    [("ref", `Assoc [("type", `String "string"); ("description", `String "Git ref to diff against (default: main)")])]
    [];
  tool "sx_diff_branch" "Structural diff of all .sx changes on current branch vs a base ref. Shows ADDED/REMOVED/CHANGED per file."
    [("ref", `Assoc [("type", `String "string"); ("description", `String "Base ref (default: main)")])]
    [];
  tool "sx_blame" "Git blame for an .sx file, optionally focused on a tree path."
    [file_prop; path_prop] ["file"];
  tool "sx_doc_gen" "Generate component documentation from all defcomp/defisland/defmacro signatures in a directory."
    [dir_prop] ["dir"];
  tool "sx_harness_eval" "Evaluate SX in a test harness with mock IO. Returns result + IO trace. Supports loading multiple files and setup expressions."
    [("expr", `Assoc [("type", `String "string"); ("description", `String "SX expression to evaluate")]);
     ("mock", `Assoc [("type", `String "string"); ("description", `String "Optional mock platform overrides as SX dict, e.g. {:fetch (fn (url) {:status 200})}")]);
     ("file", `Assoc [("type", `String "string"); ("description", `String "Optional .sx file to load for definitions")]);
     ("files", `Assoc [("type", `String "array"); ("items", `Assoc [("type", `String "string")]); ("description", `String "Multiple .sx files to load in order")]);
     ("setup", `Assoc [("type", `String "string"); ("description", `String "SX setup expression to run before main evaluation")]);
     ("host_stubs", `Assoc [("type", `String "boolean"); ("description", `String "If true, inject nil-returning stubs for host-get/host-set!/host-call/host-new/etc. so files that use host primitives can load in the harness")])]
    ["expr"];
  tool "sx_nav" "Manage sx-docs navigation and articles. Modes: list (all nav items with status), check (validate consistency), add (create article + nav entry), delete (remove nav entry + page fn), move (move entry between sections, rewriting hrefs)."
    [("mode", `Assoc [("type", `String "string"); ("description", `String "Mode: list, check, add, delete, or move")]);
     ("section", `Assoc [("type", `String "string"); ("description", `String "Nav section to filter (list), target section (add), or target section (move)")]);
     ("title", `Assoc [("type", `String "string"); ("description", `String "Article title (add mode)")]);
     ("slug", `Assoc [("type", `String "string"); ("description", `String "URL slug (add/delete/move modes, e.g. reactive-runtime)")]);
     ("from", `Assoc [("type", `String "string"); ("description", `String "Source section (move mode, e.g. applications)")]);
     ("to", `Assoc [("type", `String "string"); ("description", `String "Target section (move mode, e.g. geography)")])]
    [];
  tool "sx_playwright" "Run Playwright browser tests or inspect SX pages interactively. Modes: run (spec files), inspect (page/island report with leak detection and handler audit), diff (full SSR vs hydrated DOM), hydrate (lake-focused SSR vs hydrated comparison — detects clobbering), eval (JS expression), interact (action sequence), screenshot, listeners (CDP event listener inspection), trace (click + capture console/network/pushState), cdp (raw CDP command), trace-boot (full console capture during boot — ALL prefixes), hydrate-debug (re-run island hydration with full env/state tracing), eval-at (inject eval at a specific boot phase)."
    [("spec", `Assoc [("type", `String "string"); ("description", `String "Spec file to run (run mode). e.g. stepper.spec.js")]);
     ("mode", `Assoc [("type", `String "string"); ("description", `String "Mode: run, inspect, diff, hydrate, eval, interact, screenshot, listeners, trace, cdp, trace-boot, hydrate-debug, eval-at, sandbox (offline WASM kernel — no server needed)")]);
     ("phase", `Assoc [("type", `String "string"); ("description", `String "Boot phase for eval-at mode: before-modules, after-modules, before-pages, after-pages, before-components, after-components, before-hydrate, after-hydrate, after-boot")]);
     ("filter", `Assoc [("type", `String "string"); ("description", `String "Filter prefix for trace-boot mode (e.g. '[sx-platform]')")]);
     ("url", `Assoc [("type", `String "string"); ("description", `String "URL path to navigate to (default: /)")]);
     ("island", `Assoc [("type", `String "string"); ("description", `String "Filter inspect to a specific island by name (e.g. home/stepper)")]);
     ("selector", `Assoc [("type", `String "string"); ("description", `String "CSS selector for screenshot/listeners/trace modes")]);
     ("expr", `Assoc [("type", `String "string"); ("description", `String "JS expression (eval mode), selector (listeners/trace), or CDP command (cdp mode)")]);
     ("actions", `Assoc [("type", `String "string"); ("description", `String "Semicolon-separated action sequence (interact mode). Actions: click:sel, fill:sel:val, wait:ms, text:sel, html:sel, attrs:sel, screenshot, screenshot:sel, count:sel, visible:sel")]);
     ("files", `Assoc [("type", `String "array"); ("items", `Assoc [("type", `String "string")]); ("description", `String ".sx files to load (sandbox mode)")]);
     ("setup", `Assoc [("type", `String "string"); ("description", `String "SX setup expression (sandbox mode)")]);
     ("stack", `Assoc [("type", `String "string"); ("description", `String "Module stack for sandbox: core (default), web (full web stack), hs (web + hyperscript), test (web + test framework)")]);
     ("bytecode", `Assoc [("type", `String "boolean"); ("description", `String "Load .sxbc bytecode instead of .sx source in sandbox (default: false)")])]
    [];
]

(* ------------------------------------------------------------------ *)
(* JSON-RPC dispatch                                                   *)
(* ------------------------------------------------------------------ *)

let dispatch method_name params =
  match method_name with
  | "initialize" ->
    `Assoc [
      ("protocolVersion", `String "2024-11-05");
      ("capabilities", `Assoc [("tools", `Assoc [])]);
      ("serverInfo", `Assoc [
        ("name", `String "sx-tree-tools");
        ("version", `String "0.1.0")])]
  | "notifications/initialized" -> `Null
  | "tools/list" -> `Assoc [("tools", tool_definitions)]
  | "tools/call" ->
    let open Yojson.Safe.Util in
    let name = params |> member "name" |> to_string in
    let args = params |> member "arguments" in
    (try handle_tool name args
     with e -> error_result ("Error: " ^ Printexc.to_string e))
  | _ -> `Null

(* ------------------------------------------------------------------ *)
(* Stdio JSON-RPC main loop                                            *)
(* ------------------------------------------------------------------ *)

let () =
  setup_env ();
  log_msg "Server started (pid=%d, cwd=%s)" (Unix.getpid ()) (Sys.getcwd ());
  try while true do
    let line = input_line stdin in
    if String.length line > 0 then begin
      try
        let json = Yojson.Safe.from_string line in
        let open Yojson.Safe.Util in
        let meth = json |> member "method" |> to_string_option |> Option.value ~default:"" in
        let params = json |> member "params" in
        let id = json |> member "id" in
        let tool_name = if meth = "tools/call" then
          (try params |> member "name" |> to_string with _ -> "?")
        else meth in
        let t0 = Unix.gettimeofday () in
        let result =
          try dispatch meth params
          with e ->
            let msg = Printexc.to_string e in
            log_msg "DISPATCH ERROR [%s]: %s" tool_name msg;
            error_result ("Error: " ^ msg)
        in
        let elapsed = (Unix.gettimeofday () -. t0) *. 1000.0 in
        if elapsed > 5000.0 then
          log_msg "SLOW [%s]: %.0fms" tool_name elapsed;
        (* Check for error in result *)
        (match result with
         | `Assoc items when List.mem_assoc "isError" items ->
           log_msg "TOOL ERROR [%s]: %s (%.0fms)" tool_name
             (try result |> member "content" |> to_list |> List.hd |> member "text" |> to_string with _ -> "?")
             elapsed
         | _ -> ());
        if id <> `Null then begin
          let resp = `Assoc [
            ("jsonrpc", `String "2.0");
            ("id", id);
            ("result", result)] in
          print_string (Yojson.Safe.to_string resp);
          print_char '\n';
          flush stdout;
          check_hot_reload ()
        end
      with e ->
        let msg = Printexc.to_string e in
        log_msg "REQUEST PARSE ERROR: %s" msg;
        Printf.eprintf "[mcp] Request error: %s\n%!" msg
    end
  done
  with End_of_file ->
    log_msg "Server shutting down (End_of_file)"
