(** 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 (* ------------------------------------------------------------------ *) (* 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 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); (* 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 ""); (* Load parser.sx for the SX-level sx-parse/sx-serialize *) 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 (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)); (* Load tree-tools *) (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); (* Load harness *) (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)); (* Load eval-rules *) (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)); (* Load 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))); Printf.eprintf "[mcp] SX tree-tools + harness + eval-rules + render loaded\n%!"; 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) let parse_file path = let src = In_channel.with_open_text path In_channel.input_all in let exprs = Sx_parser.parse_all src in List exprs 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 *) 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 (* Special case: keyword args stay on same line as their value *) let rec emit = function | [] -> () | Keyword k :: v :: rest -> Buffer.add_char buf '\n'; Buffer.add_string buf (String.make child_indent ' '); Buffer.add_char buf ':'; Buffer.add_string buf k; Buffer.add_char buf ' '; pp child_indent v; emit rest | item :: rest -> Buffer.add_char buf '\n'; Buffer.add_string buf (String.make child_indent ' '); pp child_indent item; emit rest in emit rest; Buffer.add_char buf ')' end | _ -> Buffer.add_string buf (pp_atom v) in pp 0 v; Buffer.contents buf let pretty_print_file exprs = String.concat "\n\n" (List.map pretty_print_value exprs) ^ "\n" (* ------------------------------------------------------------------ *) (* Tool handlers *) (* ------------------------------------------------------------------ *) let rec handle_tool name args = let open Yojson.Safe.Util in match name with | "sx_read_tree" -> let file = args |> member "file" |> to_string in let tree = parse_file file in let focus = args |> member "focus" |> to_string_option in let max_depth = args |> member "max_depth" |> to_int_option in let max_lines = args |> member "max_lines" |> to_int_option in let offset = args |> member "offset" |> to_int_option |> Option.value ~default:0 in (match focus with | Some pattern -> (* Focus mode: expand matching subtrees, collapse rest *) text_result (value_to_string (call_sx "annotate-focused" [tree; String pattern])) | None -> match max_lines with | Some limit -> (* Paginated mode *) text_result (value_to_string (call_sx "annotate-paginated" [tree; Number (float_of_int offset); Number (float_of_int limit)])) | None -> match max_depth with | Some depth -> (* Depth-limited mode *) text_result (value_to_string (call_sx "summarise" [tree; Number (float_of_int depth)])) | None -> (* Auto mode: full tree if small, summarise if large *) 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 full else let summary = value_to_string (call_sx "summarise" [tree; Number 2.0]) in text_result (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)) | "sx_summarise" -> let tree = parse_file (args |> member "file" |> to_string) in let depth = args |> member "depth" |> to_int in text_result (value_to_string (call_sx "summarise" [tree; Number (float_of_int depth)])) | "sx_read_subtree" -> let tree = parse_file (args |> member "file" |> to_string) in let path = resolve_path tree (args |> member "path" |> to_string) in text_result (value_to_string (call_sx "read-subtree" [tree; path])) | "sx_get_context" -> let tree = parse_file (args |> member "file" |> to_string) in let path = resolve_path tree (args |> member "path" |> to_string) in text_result (value_to_string (call_sx "get-context" [tree; path])) | "sx_find_all" -> let tree = parse_file (args |> member "file" |> to_string) in let pattern = args |> member "pattern" |> to_string in let results = call_sx "find-all" [tree; String pattern] in let lines = match results with | List items | ListRef { contents = items } -> List.map (fun item -> match item with | List [p; s] | ListRef { contents = [p; s] } -> value_to_string (call_sx "path-str" [p]) ^ " " ^ value_to_string s | _ -> value_to_string item ) items | _ -> [value_to_string results] in text_result (String.concat "\n" lines) | "sx_get_siblings" -> let tree = parse_file (args |> member "file" |> to_string) in let path = resolve_path tree (args |> member "path" |> to_string) in text_result (value_to_string (call_sx "get-siblings" [tree; path])) | "sx_validate" -> let tree = parse_file (args |> member "file" |> to_string) in text_result (value_to_string (call_sx "validate" [tree])) | "sx_replace_node" -> let file = args |> member "file" |> to_string in let tree = parse_file file in let path = resolve_path tree (args |> member "path" |> to_string) in let src = args |> member "new_source" |> to_string in write_edit file (call_sx "replace-node" [tree; path; String src]) | "sx_insert_child" -> let file = args |> member "file" |> to_string in let tree = parse_file file in let path = resolve_path tree (args |> member "path" |> to_string) in let index = args |> member "index" |> to_int in let src = args |> member "new_source" |> to_string in write_edit file (call_sx "insert-child" [tree; path; Number (float_of_int index); String src]) | "sx_delete_node" -> let file = args |> member "file" |> to_string in let tree = parse_file file in let path = resolve_path tree (args |> member "path" |> to_string) in write_edit file (call_sx "delete-node" [tree; path]) | "sx_wrap_node" -> let file = args |> member "file" |> to_string in let tree = parse_file file in let path = resolve_path tree (args |> member "path" |> to_string) in let wrapper = args |> member "wrapper" |> to_string in write_edit file (call_sx "wrap-node" [tree; path; String wrapper]) | "sx_format_check" -> let file = args |> member "file" |> to_string 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)) | "sx_macroexpand" -> 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) | "sx_build" -> 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 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 in let cmd = match target with | "ocaml" -> Printf.sprintf "cd %s/hosts/ocaml && eval $(opam env 2>/dev/null) && dune build 2>&1" project_dir | "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" project_dir extra in let ic = Unix.open_process_in cmd in let lines = ref [] in (try while true do lines := input_line ic :: !lines done with End_of_file -> ()); let status = Unix.close_process_in ic in let output = String.concat "\n" (List.rev !lines) in (match status with | Unix.WEXITED 0 -> text_result (Printf.sprintf "OK — %s build succeeded\n%s" target (String.trim output)) | _ -> error_result (Printf.sprintf "%s build failed:\n%s" target output)) | "sx_build_bytecode" -> 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 in let cmd = Printf.sprintf "cd %s && node hosts/ocaml/browser/compile-modules.js shared/static/wasm 2>&1" project_dir in let ic = Unix.open_process_in cmd in let lines = ref [] in (try while true do lines := input_line ic :: !lines done with End_of_file -> ()); let status = Unix.close_process_in ic in let output = String.concat "\n" (List.rev !lines) in (match status with | Unix.WEXITED 0 -> text_result (Printf.sprintf "OK — bytecode compilation succeeded\n%s" (String.trim output)) | _ -> error_result (Printf.sprintf "Bytecode compilation failed:\n%s" output)) | "sx_test" -> 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 project_dir = try Sys.getenv "SX_PROJECT_DIR" with Not_found -> (* Walk up from spec dir to find project root *) let spec_dir = try Sys.getenv "SX_SPEC_DIR" with Not_found -> "spec" in Filename.dirname spec_dir in let cmd = match host with | "ocaml" -> Printf.sprintf "cd %s/hosts/ocaml && eval $(opam env 2>/dev/null) && dune exec bin/run_tests.exe%s 2>&1" project_dir (if full then " -- --full" else "") | "js" | _ -> Printf.sprintf "cd %s && node hosts/javascript/run_tests.js%s 2>&1" project_dir (if full then " --full" else "") in let ic = Unix.open_process_in cmd in let lines = ref [] in (try while true do lines := input_line ic :: !lines done with End_of_file -> ()); ignore (Unix.close_process_in ic); let all_lines = List.rev !lines 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 | "sx_pretty_print" -> let file = args |> member "file" |> to_string in let exprs = Sx_parser.parse_all (In_channel.with_open_text file In_channel.input_all) in let source = pretty_print_file exprs in Out_channel.with_open_text file (fun oc -> output_string oc source); text_result (Printf.sprintf "OK — reformatted %s (%d bytes, %d forms)" file (String.length source) (List.length exprs)) | "sx_changed" -> let base_ref = args |> member "ref" |> to_string_option |> Option.value ~default:"main" in 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 in let cmd = Printf.sprintf "cd %s && git diff --name-only %s -- '*.sx' '*.sxc' 2>/dev/null" project_dir base_ref in let ic = Unix.open_process_in cmd in let files = ref [] in (try while true do files := input_line ic :: !files done with End_of_file -> ()); ignore (Unix.close_process_in ic); let changed = List.rev !files 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 project_dir 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 | "sx_diff_branch" -> let base_ref = args |> member "ref" |> to_string_option |> Option.value ~default:"main" in 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 in let cmd = Printf.sprintf "cd %s && git diff --name-only %s -- '*.sx' '*.sxc' 2>/dev/null" project_dir base_ref in let ic = Unix.open_process_in cmd in let files = ref [] in (try while true do files := input_line ic :: !files done with End_of_file -> ()); ignore (Unix.close_process_in ic); let changed = List.rev !files 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 project_dir rel in (* Get the base version via git show *) let base_cmd = Printf.sprintf "cd %s && git show %s:%s 2>/dev/null" project_dir base_ref rel in let ic2 = Unix.open_process_in base_cmd in let base_lines = ref [] in (try while true do base_lines := input_line ic2 :: !base_lines done with End_of_file -> ()); ignore (Unix.close_process_in ic2); let base_src = String.concat "\n" (List.rev !base_lines) 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 | "sx_blame" -> let file = args |> member "file" |> to_string in let path_str_arg = args |> member "path" |> to_string_option in 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 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:project_dir 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" project_dir escaped rel_file rel_file | None -> Printf.sprintf "cd %s && git blame -- %s 2>/dev/null | head -30" project_dir rel_file in let ic = Unix.open_process_in cmd in let lines = ref [] in (try while true do lines := input_line ic :: !lines done with End_of_file -> ()); ignore (Unix.close_process_in ic); text_result (String.concat "\n" (List.rev !lines)) | "sx_doc_gen" -> let dir = args |> member "dir" |> to_string in let files = glob_sx_files dir in let all_docs = 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" -> let params_str = match 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 Some (Printf.sprintf "## %s `%s`\nDefined in: %s\nType: %s\n%s" head name rel head params_str) | "defmacro" -> Some (Printf.sprintf "## %s `%s`\nDefined in: %s\nType: macro\n" head name rel) | _ -> None) | _ -> None ) exprs with _ -> [] ) files in if all_docs = [] then text_result "(no components found)" else text_result (String.concat "\n" all_docs) | "sx_nav" -> 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); (* 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); (* 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); 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); 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 Out_channel.with_open_text tf (fun oc -> output_string oc ts2); (* 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); 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); 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); (* 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); 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)) | "sx_playwright" -> 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 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 (* 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" project_dir spec_arg in let ic = Unix.open_process_in cmd in let lines = ref [] in (try while true do lines := input_line ic :: !lines done with End_of_file -> ()); ignore (Unix.close_process_in ic); let all_lines = List.rev !lines in let fails = List.filter (fun l -> let t = String.trim l in String.length t > 1 && (t.[0] = '\xE2' (* ✘ *) || (String.length t > 4 && String.sub t 0 4 = "FAIL"))) all_lines in 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 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 - 10) all_lines in String.concat "\n" last_n 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); ]) 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" project_dir shell_safe in let ic = Unix.open_process_in cmd in let lines = ref [] in (try while true do lines := input_line ic :: !lines done with End_of_file -> ()); ignore (Unix.close_process_in ic); let raw = String.concat "\n" (List.rev !lines) 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 | "sx_harness_eval" -> 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 e = !env in let warnings = ref [] in (* 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 (* Load each file *) List.iter (fun f -> try load_sx_file e f with exn -> warnings := Printf.sprintf "Warning: %s: %s" f (Printexc.to_string exn) :: !warnings ) all_files; (* 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 *) let mock_arg = match mock_str with | Some s -> let parsed = Sx_parser.parse_all s in if parsed <> [] then List [Keyword "platform"; List.hd parsed] 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]); (* Evaluate the expression *) 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 (* 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) | _ -> "\n\n(no IO calls)" in let warn_str = if !warnings = [] then "" else "\n\nWarnings:\n" ^ String.concat "\n" (List.rev !warnings) in text_result (Printf.sprintf "Result: %s%s%s" (Sx_types.inspect result) log_str warn_str) | "sx_write_file" -> let file = args |> member "file" |> to_string in let source = args |> member "source" |> to_string in (* Validate by parsing first *) (try let exprs = Sx_parser.parse_all source in if exprs = [] then error_result "Source parsed to empty — nothing to write" else begin let output = pretty_print_file exprs in Out_channel.with_open_text file (fun oc -> output_string oc output); text_result (Printf.sprintf "OK — wrote %d bytes (%d top-level forms) to %s" (String.length output) (List.length exprs) file) end with e -> error_result (Printf.sprintf "Parse error — file not written: %s" (Printexc.to_string e))) | "sx_rename_symbol" -> let file = args |> member "file" |> to_string in let tree = parse_file 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 file (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) | "sx_replace_by_pattern" -> let file = args |> member "file" |> to_string in let tree = parse_file 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 file (call_sx "replace-all-by-pattern" [tree; String pattern; String src]) else write_edit file (call_sx "replace-by-pattern" [tree; String pattern; String src]) | "sx_insert_near" -> let file = args |> member "file" |> to_string in let tree = parse_file 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 file (call_sx "insert-near-pattern" [tree; String pattern; String position; String src]) | "sx_rename_across" -> let dir = args |> member "dir" |> to_string 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 = parse_file 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 items = match new_tree with | List items | ListRef { contents = items } -> items | _ -> [new_tree] in let source = pretty_print_file items in Out_channel.with_open_text path (fun oc -> output_string oc source); 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) | "sx_comp_list" -> let dir = args |> member "dir" |> 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 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 text_result (Printf.sprintf "%-10s %-40s %-50s %s\n%s" "TYPE" "NAME" "FILE" "PARAMS" (String.concat "\n" all_lines)) | "sx_find_across" -> let dir = args |> member "dir" |> to_string 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 = call_sx "find-all" [tree; String pattern] in (match results with | List items | ListRef { contents = items } -> List.map (fun item -> match item with | List [p; s] | ListRef { contents = [p; s] } -> rel ^ " " ^ value_to_string (call_sx "path-str" [p]) ^ " " ^ value_to_string s | _ -> rel ^ " " ^ value_to_string item ) items | _ -> []) with _ -> [] ) files in if all_lines = [] then text_result "(no matches)" else text_result (String.concat "\n" all_lines) | "sx_diff" -> let file_a = args |> member "file_a" |> to_string in let file_b = args |> member "file_b" |> to_string 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])) | "sx_comp_usage" -> let dir = args |> member "dir" |> to_string 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 = call_sx "find-all" [tree; String name] in (match results with | List items | ListRef { contents = items } -> List.map (fun item -> match item with | List [p; s] | ListRef { contents = [p; s] } -> rel ^ " " ^ value_to_string (call_sx "path-str" [p]) ^ " " ^ value_to_string s | _ -> rel ^ " " ^ value_to_string item ) items | _ -> []) with _ -> [] ) files in if all_lines = [] then text_result "(no usages found)" else text_result (String.concat "\n" all_lines) | "sx_eval" -> let expr_str = args |> member "expr" |> to_string in let exprs = Sx_parser.parse_all expr_str in let e = !env in let result = List.fold_left (fun _acc expr -> Sx_ref.eval_expr expr (Env e) ) Nil exprs in text_result (Sx_runtime.value_to_str result) | "sx_guard" -> 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 ("")); 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) | "sx_render_trace" -> 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)) | "sx_trace" -> let expr_str = args |> member "expr" |> to_string in let max_steps = (try args |> member "max_steps" |> to_int with _ -> 200) 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)) | "sx_deps" -> let file = args |> member "file" |> to_string 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) | "sx_build_manifest" -> 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 project_dir = try Sys.getenv "SX_PROJECT_DIR" with Not_found -> try Sys.getenv "PWD" with Not_found -> "." in let cmd = Printf.sprintf "cd %s && python3 hosts/javascript/manifest.py 2>&1" (Filename.quote project_dir) in let ic = Unix.open_process_in cmd in let buf = Buffer.create 4096 in (try while true do Buffer.add_string buf (input_line ic ^ "\n") done with End_of_file -> ()); ignore (Unix.close_process_in ic); text_result (Buffer.contents buf)) | "sx_explain" -> 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))) | _ -> error_result ("Unknown tool: " ^ name) and write_edit file result = match result with | Dict d -> (match Hashtbl.find_opt d "ok" with | Some new_tree -> let items = match new_tree with | List items | ListRef { contents = items } -> items | _ -> [new_tree] in let source = pretty_print_file items in Out_channel.with_open_text file (fun oc -> output_string oc source); 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" (* ------------------------------------------------------------------ *) (* 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)")])] ["file"; "depth"]; 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 an SX expression. Environment has parser + tree-tools + primitives." [("expr", `Assoc [("type", `String "string"); ("description", `String "SX expression to evaluate")])] ["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_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." [dir_prop; ("pattern", `Assoc [("type", `String "string"); ("description", `String "Search pattern")])] ["dir"; "pattern"]; tool "sx_comp_list" "List all definitions (defcomp, defisland, defmacro, defpage, define) across .sx files in a directory." [dir_prop] ["dir"]; tool "sx_comp_usage" "Find all uses of a component or symbol name across .sx files in a directory." [dir_prop; ("name", `Assoc [("type", `String "string"); ("description", `String "Component or symbol name to search for")])] ["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. Set full=true for extensions+types." [("target", `Assoc [("type", `String "string"); ("description", `String "Build target: \"js\" (default) or \"ocaml\"")]); ("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")])] ["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)." [("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")]); ("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")])] []; ] (* ------------------------------------------------------------------ *) (* 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 (); try while true do let line = input_line stdin in if String.length line > 0 then begin 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 result = dispatch meth params in 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 end end done with End_of_file -> ()