coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add 15 new MCP tools to sx-tree: project-wide search, smart editing, dev workflow

Browse Source 
New comprehension tools:
- sx_find_across: search pattern across all .sx files in a directory
- sx_comp_list: list all definitions (defcomp/defisland/defmacro/defpage/define)
- sx_comp_usage: find all uses of a component across files
- sx_diff: structural diff between two .sx files (ADDED/REMOVED/CHANGED)
- sx_eval: REPL — evaluate SX expressions in the MCP server env

Smart read_tree enhancements:
- Auto-summarise large files (>200 lines)
- focus param: expand only matching subtrees, collapse rest
- max_depth/max_lines/offset for depth limiting and pagination

Smart editing tools:
- sx_rename_symbol: rename all occurrences of a symbol in a file
- sx_replace_by_pattern: find+replace first/all pattern matches
- sx_insert_near: insert before/after a pattern match (top-level)
- sx_rename_across: rename symbol across all .sx files (with dry_run)
- sx_write_file: create .sx files with parse validation

Development tools:
- sx_pretty_print: reformat .sx files with indentation (also used by all edit tools)
- sx_build: build JS bundle or OCaml binary
- sx_test: run test suites with structured pass/fail results
- sx_format_check: lint for empty bindings, missing bodies, duplicate params
- sx_macroexpand: evaluate expressions with a file's macro definitions loaded

Also: updated hook to block Write on .sx files, added custom explore agent.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-03-25 23:19:10 +00:00
parent 68c05dcd28
commit 76ce0c3ecb
6 changed files with 560 additions and 11 deletions
Download Patch File Download Diff File Expand all files Collapse all files

27
.claude/agents/explore.md Normal file
View File

@@ -0,0 +1,27 @@
---
name: explore
description: Explore codebase using sx-tree MCP tools for .sx files
tools: Read, Grep, Glob, Bash, mcp__sx-tree__sx_summarise, mcp__sx-tree__sx_read_tree, mcp__sx-tree__sx_read_subtree, mcp__sx-tree__sx_find_all, mcp__sx-tree__sx_get_context, mcp__sx-tree__sx_get_siblings, mcp__sx-tree__sx_validate
hooks:
PreToolUse:
- matcher: "Read"
hooks:
- type: command
command: "bash .claude/hooks/block-sx-edit.sh"
---
Fast codebase exploration agent. Use for finding files, searching code, and answering questions about the codebase.
## Critical rule for .sx and .sxc files
NEVER use Read on .sx or .sxc files. The hook will block it. Instead use the sx-tree MCP tools:
- `mcp__sx-tree__sx_summarise` — structural overview at configurable depth
- `mcp__sx-tree__sx_read_tree` — full annotated tree with path labels
- `mcp__sx-tree__sx_read_subtree` — expand a specific subtree by path
- `mcp__sx-tree__sx_find_all` — search for nodes matching a pattern
- `mcp__sx-tree__sx_get_context` — enclosing chain from root to target
- `mcp__sx-tree__sx_get_siblings` — siblings of a node with target marked
- `mcp__sx-tree__sx_validate` — structural integrity checks
For all other file types, use Read, Grep, Glob, and Bash as normal.

7
.claude/hooks/block-sx-edit.sh Executable file
View File

@@ -0,0 +1,7 @@
#!/bin/bash
# Block Edit/Read/Write on .sx/.sxc files — force use of sx-tree MCP tools
FILE=$(jq -r '.tool_input.file_path // .tool_input.file // empty' 2>/dev/null)
if [ -n "$FILE" ] && echo "$FILE" | grep -qE '\.(sx|sxc)$'; then
printf '{"decision":"block","reason":"Use sx-tree MCP tools instead of Edit/Read/Write on .sx/.sxc files. For new files use sx_write_file, for reading use sx_read_tree/sx_summarise, for editing use sx_replace_node/sx_rename_symbol/etc. See CLAUDE.md for the protocol."}'
exit 2
fi

2
hosts/ocaml/bin/dune
View File

@@ -4,4 +4,4 @@
(executable
(name mcp_tree)
(libraries sx unix yojson))
(libraries sx unix yojson str))

447
hosts/ocaml/bin/mcp_tree.ml
View File

@@ -220,6 +220,90 @@ let error_result 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 *)
(* ------------------------------------------------------------------ *)
@@ -228,8 +312,35 @@ let rec handle_tool name args =
let open Yojson.Safe.Util in
match name with
| "sx_read_tree" ->
let tree = parse_file (args |> member "file" |> to_string) in
text_result (value_to_string (call_sx "annotate-tree" [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
@@ -299,6 +410,265 @@ let rec handle_tool name args =
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_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_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)
| _ -> error_result ("Unknown tool: " ^ name)
and write_edit file result =
@@ -306,12 +676,11 @@ and write_edit file result =
| Dict d ->
(match Hashtbl.find_opt d "ok" with
| Some new_tree ->
let parts = match new_tree with
| List items | ListRef { contents = items } ->
List.map (fun expr -> Sx_runtime.value_to_str expr) items
| _ -> [Sx_runtime.value_to_str new_tree]
let items = match new_tree with
| List items | ListRef { contents = items } -> items
| _ -> [new_tree]
in
let source = String.concat "\n\n" parts ^ "\n" 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 ->
@@ -336,10 +705,16 @@ let tool name desc props required =
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 on every node. Use this to understand structure before editing."
[file_prop] ["file"];
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."
@@ -360,6 +735,60 @@ let tool_definitions = `List [
[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_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_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"];
]
(* ------------------------------------------------------------------ *)

86
lib/tree-tools.sx
View File

@@ -57,3 +57,89 @@
(define list-insert :effects () (fn (lst idx val) (concat (slice lst 0 idx) (list val) (slice lst idx))))
(define list-remove :effects () (fn (lst idx) (concat (slice lst 0 idx) (slice lst (+ idx 1)))))
(define tree-diff :effects () (fn (exprs-a exprs-b) (let ((nodes-a (if (list? exprs-a) exprs-a (list exprs-a))) (nodes-b (if (list? exprs-b) exprs-b (list exprs-b))) (results (list))) (diff-children nodes-a nodes-b (list) results) (if (empty? results) "No differences" (join "\n" results)))))
(define diff-children :effects () (fn (list-a list-b path results) (let ((len-a (len list-a)) (len-b (len list-b)) (min-len (if (< len-a len-b) len-a len-b))) (for-each (fn (i) (diff-node (nth list-a i) (nth list-b i) (concat path (list i)) results)) (range 0 min-len)) (when (> len-b min-len) (for-each (fn (i) (append! results (str "ADDED " (path-str (concat path (list i))) " " (node-summary-short (nth list-b i))))) (range min-len len-b))) (when (> len-a min-len) (for-each (fn (i) (append! results (str "REMOVED " (path-str (concat path (list i))) " " (node-summary-short (nth list-a i))))) (range min-len len-a))))))
(define diff-node :effects () (fn (a b path results) (cond (and (list? a) (list? b)) (diff-children a b path results) (and (not (list? a)) (not (list? b))) (when (not (= (node-display a) (node-display b))) (append! results (str "CHANGED " (path-str path) " " (node-display a) " → " (node-display b)))) :else (append! results (str "CHANGED " (path-str path) " " (node-summary-short a) " → " (node-summary-short b))))))
(define path-prefix? :effects () (fn (prefix path) (if (> (len prefix) (len path)) false (let ((result true)) (for-each (fn (i) (when (not (= (nth prefix i) (nth path i))) (set! result false))) (range 0 (len prefix))) result))))
(define path-on-match-route? :effects () (fn (path match-paths) (let ((found false)) (for-each (fn (i) (when (not found) (let ((mp (first (nth match-paths i)))) (when (or (path-prefix? path mp) (path-prefix? mp path)) (set! found true))))) (range 0 (len match-paths))) found)))
(define annotate-focused :effects () (fn (exprs pattern) (let ((nodes (if (list? exprs) exprs (list exprs))) (match-paths (find-all nodes pattern)) (result (list))) (for-each (fn (i) (annotate-node-focused (nth nodes i) (list i) 0 match-paths result)) (range 0 (len nodes))) (join "\n" result))))
(define annotate-node-focused :effects () (fn (node path depth match-paths result) (let ((indent (join "" (map (fn (_) " ") (range 0 depth)))) (label (path-str path))) (if (list? node) (if (empty? node) (append! result (str indent label " ()")) (let ((head (first node)) (head-str (node-display head)) (on-route (path-on-match-route? path match-paths))) (if on-route (do (append! result (str indent label " (" head-str)) (for-each (fn (i) (annotate-node-focused (nth node i) (concat path (list i)) (+ depth 1) match-paths result)) (range 1 (len node))) (append! result (str indent " )"))) (append! result (str indent label " (" head-str (if (> (len node) 1) (str " ... " (- (len node) 1) " children") "") ")"))))) (append! result (str indent label " " (node-display node)))))))
(define annotate-paginated :effects () (fn (exprs offset limit) (let ((nodes (if (list? exprs) exprs (list exprs))) (all-lines (list))) (for-each (fn (i) (annotate-node (nth nodes i) (list i) 0 all-lines)) (range 0 (len nodes))) (let ((total (len all-lines)) (end (if (> (+ offset limit) total) total (+ offset limit))) (sliced (slice all-lines offset end)) (header (str ";; Lines " offset "-" end " of " total (if (< end total) " (more available)" " (complete)")))) (str header "\n" (join "\n" sliced))))))
(define rename-symbol :effects () (fn (exprs old-name new-name) (let ((nodes (if (list? exprs) exprs (list exprs)))) (map (fn (node) (rename-in-node node old-name new-name)) nodes))))
(define rename-in-node :effects () (fn (node old-name new-name) (cond (and (= (type-of node) "symbol") (= (symbol-name node) old-name)) (make-symbol new-name) (list? node) (map (fn (child) (rename-in-node child old-name new-name)) node) :else node)))
(define count-renames :effects () (fn (exprs old-name) (let ((nodes (if (list? exprs) exprs (list exprs))) (hits (list))) (count-in-node nodes old-name hits) (len hits))))
(define count-in-node :effects () (fn (node old-name hits) (cond (and (= (type-of node) "symbol") (= (symbol-name node) old-name)) (append! hits true) (list? node) (for-each (fn (child) (count-in-node child old-name hits)) node) :else nil)))
(define replace-by-pattern :effects () (fn (exprs pattern new-source) (let ((nodes (if (list? exprs) exprs (list exprs))) (matches (find-all nodes pattern))) (if (empty? matches) {:error (str "No nodes matching pattern: " pattern)} (let ((target-path (first (first matches))) (fragment (sx-parse new-source))) (if (empty? fragment) {:error (str "Failed to parse new source: " new-source)} (let ((new-node (first fragment)) (result (tree-set nodes target-path new-node))) (if (nil? result) {:error (str "Failed to set node at path " (path-str target-path))} {:ok result :path target-path}))))))))
(define replace-all-by-pattern :effects () (fn (exprs pattern new-source) (let ((nodes (if (list? exprs) exprs (list exprs))) (matches (find-all nodes pattern)) (fragment (sx-parse new-source))) (if (empty? matches) {:error (str "No nodes matching pattern: " pattern)} (if (empty? fragment) {:error (str "Failed to parse new source: " new-source)} (let ((new-node (first fragment)) (current nodes) (count 0)) (for-each (fn (i) (let ((idx (- (- (len matches) 1) i)) (match (nth matches idx)) (target-path (first match)) (result (tree-set current target-path new-node))) (when (not (nil? result)) (set! current result) (set! count (+ count 1))))) (range 0 (len matches))) {:count count :ok current}))))))
(define insert-near-pattern :effects () (fn (exprs pattern position new-source) (let ((nodes (if (list? exprs) exprs (list exprs))) (matches (find-all nodes pattern))) (if (empty? matches) {:error (str "No nodes matching pattern: " pattern)} (let ((match-path (first (first matches))) (fragment (sx-parse new-source))) (if (empty? fragment) {:error (str "Failed to parse new source: " new-source)} (if (empty? match-path) {:error "Cannot insert near root node"} (let ((top-idx (first match-path)) (insert-idx (if (= position "after") (+ top-idx 1) top-idx)) (new-node (first fragment)) (new-tree (list-insert nodes insert-idx new-node))) {:ok new-tree :path (list insert-idx)}))))))))
;; --- Format / lint checks ---
(define lint-file :effects ()
(fn (exprs)
(let ((nodes (if (list? exprs) exprs (list exprs)))
(warnings (list)))
(for-each (fn (i) (lint-node (nth nodes i) (list i) warnings))
(range 0 (len nodes)))
warnings)))
(define lint-node :effects ()
(fn (node path warnings)
(when (list? node)
(when (not (empty? node))
(let ((head (first node))
(head-name (if (= (type-of head) "symbol") (symbol-name head) "")))
;; Empty let/letrec bindings
(when (or (= head-name "let") (= head-name "letrec"))
(when (>= (len node) 2)
(let ((bindings (nth node 1)))
(when (and (list? bindings) (empty? bindings))
(append! warnings
(str "WARN " (path-str path) ": " head-name " with empty bindings"))))))
;; defcomp/defisland with too few args
(when (or (= head-name "defcomp") (= head-name "defisland"))
(when (< (len node) 4)
(append! warnings
(str "ERROR " (path-str path) ": " head-name " needs (name params body), has "
(- (len node) 1) " args"))))
;; define with no body
(when (= head-name "define")
(let ((effective-len (len (filter (fn (x) (not (= (type-of x) "keyword"))) (rest node)))))
(when (< effective-len 2)
(append! warnings
(str "WARN " (path-str path) ": define with no body")))))
;; Duplicate keys in keyword args
(when (or (= head-name "defcomp") (= head-name "defisland"))
(when (>= (len node) 3)
(let ((params (nth node 2)))
(when (list? params)
(let ((seen (list)))
(for-each (fn (p)
(when (= (type-of p) "symbol")
(let ((pname (symbol-name p)))
(when (and (not (= pname "&key"))
(not (= pname "&rest"))
(not (starts-with? pname "&")))
(when (contains? seen pname)
(append! warnings
(str "ERROR " (path-str path) ": duplicate param " pname)))
(append! seen pname)))))
params))))))
;; Recurse into children
(for-each (fn (i) (lint-node (nth node i) (concat path (list i)) warnings))
(range 0 (len node))))))))

2
sx/sx/sx-tools.sx
View File

File diff suppressed because one or more lines are too long