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

Add named path navigation: "defisland > let > letrec" resolves to index path

Browse Source 
Named paths let you navigate by structure name instead of opaque indices.
Both formats work in all MCP tools:
  - Index: "(0 3 2)"
  - Named: "defisland > let > letrec"

The server detects ">" in the path string and calls resolve-named-path
(SX function) which walks the tree matching child names at each level.

New SX functions: resolve-named-path, split-path-string, find-child-by-name.
MCP server: added trim/split primitives, resolve_path dispatcher.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-03-25 20:39:12 +00:00
parent 63babc0d2d
commit 3559ce44f2
2 changed files with 51 additions and 480 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -142,6 +142,12 @@ let setup_env () =
| [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 []);
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)
@@ -185,10 +191,17 @@ let parse_path_str s =
(* 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 _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
@@ -225,12 +238,12 @@ let rec handle_tool name args =
| "sx_read_subtree" ->
let tree = parse_file (args |> member "file" |> to_string) in
let path = args |> member "path" |> json_to_path 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 = args |> member "path" |> json_to_path 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" ->
@@ -251,7 +264,7 @@ let rec handle_tool name args =
| "sx_get_siblings" ->
let tree = parse_file (args |> member "file" |> to_string) in
let path = args |> member "path" |> json_to_path 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" ->
@@ -261,14 +274,14 @@ let rec handle_tool name args =
| "sx_replace_node" ->
let file = args |> member "file" |> to_string in
let tree = parse_file file in
let path = args |> member "path" |> json_to_path 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 = args |> member "path" |> json_to_path 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])
@@ -276,13 +289,13 @@ let rec handle_tool name args =
| "sx_delete_node" ->
let file = args |> member "file" |> to_string in
let tree = parse_file file in
let path = args |> member "path" |> json_to_path 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 = args |> member "path" |> json_to_path 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])