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

Interior comments, fragment comments, get_siblings + doc_gen comment support

Browse Source 
Parser: read_value/read_list now capture Comment nodes inside lists
when ~comments:true. Module-level _preserve_comments ref threads the
flag through the recursive descent without changing signatures.

Pretty printer: has_interior_comments (recursive) forces multi-line
when any nested list contains comments. Comment nodes inside lists
emit as indented comment lines.

Edit tools: separate_comments strips interior comments recursively
via strip_interior_comments before passing to tree-tools (paths stay
correct). extract_fragment_comments parses new source with comments,
attaches leading comments to the target position in the comment map.

sx_get_siblings: injects comments for top-level siblings.

sx_doc_gen: parses with comments, tracks preceding Comment node,
includes cleaned comment text in generated component documentation.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-03 17:00:56 +00:00
parent 033b2cb304
commit 38556af423
2 changed files with 193 additions and 57 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -322,6 +322,18 @@ type comment_map = {
trailing : value list; (* comments after last expression *)
}
(* Recursively strip Comment nodes from inside lists — tree-tools
must not see them or index-based paths break. *)
let rec strip_interior_comments v =
match v with
| List items ->
let clean = List.filter (function Comment _ -> false | _ -> true) items in
List (List.map strip_interior_comments clean)
| ListRef { contents = items } ->
let clean = List.filter (function Comment _ -> false | _ -> true) items in
List (List.map strip_interior_comments clean)
| _ -> v
let separate_comments items =
let before = Hashtbl.create 16 in
let exprs = ref [] in
@@ -334,7 +346,8 @@ let separate_comments items =
if !pending <> [] then
Hashtbl.replace before !idx (List.rev !pending);
pending := [];
exprs := item :: !exprs;
(* Strip interior comments from the expression before passing to tree-tools *)
exprs := strip_interior_comments item :: !exprs;
incr idx
) items;
let trailing = List.rev !pending in
@@ -351,6 +364,29 @@ let reinterleave exprs cmap =
List.iter (fun c -> result := c :: !result) cmap.trailing;
List.rev !result
(* Extract leading comments from fragment source and attach to a position
in the comment map. Returns the clean source (comments stripped). *)
let extract_fragment_comments src cmap target_idx =
let items = Sx_parser.parse_all ~comments:true src in
let cmt_nodes = ref [] in
let expr_nodes = ref [] in
List.iter (fun item ->
match item with
| Comment _ -> cmt_nodes := item :: !cmt_nodes
| _ -> expr_nodes := item :: !expr_nodes
) items;
let cmts = List.rev !cmt_nodes in
if cmts <> [] then begin
let existing = match Hashtbl.find_opt cmap.before target_idx with
| Some cs -> cs | None -> [] in
Hashtbl.replace cmap.before target_idx (existing @ cmts)
end;
(* Reconstruct source without comments *)
if cmts = [] then src
else
let clean = List.rev !expr_nodes in
String.concat " " (List.map inspect clean)
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. *)
@@ -434,13 +470,24 @@ let rec est_width = function
2 + List.fold_left (fun acc x -> acc + est_width x + 1) 0 items
| _ -> 10
let rec has_interior_comments = function
| List items | ListRef { contents = items } ->
List.exists (fun item -> match item with
| Comment _ -> true
| List _ | ListRef _ -> has_interior_comments item
| _ -> false
) items
| _ -> false
let pretty_print_value ?(max_width=80) v =
let buf = Buffer.create 4096 in
let rec pp indent v =
match v with
| Comment text ->
Buffer.add_string buf text
| List items | ListRef { contents = items } when items <> [] ->
if est_width v <= max_width - indent then
(* Fits on one line *)
if est_width v <= max_width - indent && not (has_interior_comments v) then
(* Fits on one line and has no comments *)
Buffer.add_string buf (pp_atom v)
else begin
(* Multi-line *)
@@ -449,9 +496,14 @@ let pretty_print_value ?(max_width=80) v =
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
| [] -> ()
| Comment text :: rest ->
(* Interior comment: indented, on its own line *)
Buffer.add_char buf '\n';
Buffer.add_string buf (String.make child_indent ' ');
Buffer.add_string buf text;
emit rest
| Keyword k :: v :: rest ->
Buffer.add_char buf '\n';
Buffer.add_string buf (String.make child_indent ' ');
@@ -626,9 +678,15 @@ let handle_tool name args =
text_result (String.concat "\n" lines)
| "sx_get_siblings" ->
let tree = parse_file (args |> member "file" |> to_string) in
let file = args |> member "file" |> to_string in
let tree, cmap = parse_file_with_comments file in
let path = resolve_path tree (args |> member "path" |> to_string) in
text_result (value_to_string (call_sx "get-siblings" [tree; path]))
let output = value_to_string (call_sx "get-siblings" [tree; path]) in
(* Inject comments for top-level siblings *)
let is_top_level = match path with
| List [Number _] | List [Number _; Number _] -> true
| _ -> false in
text_result (if is_top_level then inject_comments output cmap else output)
| "sx_validate" ->
let tree = parse_file (args |> member "file" |> to_string) in
@@ -638,7 +696,12 @@ let handle_tool name args =
let file = args |> member "file" |> to_string in
let tree, cmap = parse_file_with_comments file in
let path = resolve_path tree (args |> member "path" |> to_string) in
let src = args |> member "new_source" |> to_string in
let raw_src = args |> member "new_source" |> to_string in
(* Extract leading comments from fragment, attach to target position *)
let top_idx = match path with List (Number n :: _) -> Some (int_of_float n) | _ -> None in
let src = match top_idx with
| Some idx -> extract_fragment_comments raw_src cmap idx
| None -> raw_src in
write_edit_with_comments file cmap (call_sx "replace-node" [tree; path; String src])
| "sx_insert_child" ->
@@ -960,16 +1023,36 @@ let handle_tool name args =
| "sx_doc_gen" ->
let dir = args |> member "dir" |> to_string in
let files = glob_sx_files dir in
let strip_comment_prefix text =
let lines = String.split_on_char '\n' text in
let cleaned = List.map (fun line ->
let s = String.trim line in
if String.length s >= 3 && s.[0] = ';' && s.[1] = ';' && s.[2] = ' ' then
String.sub s 3 (String.length s - 3)
else if String.length s >= 2 && s.[0] = ';' && s.[1] = ';' then
String.sub s 2 (String.length s - 2)
else s
) lines in
(* Filter out section divider lines (═══, ---) *)
let non_dividers = List.filter (fun s ->
not (String.length s > 3 && (s.[0] = '=' || s.[0] = '-' || s.[0] = '#'))
) cleaned in
let trimmed = List.filter (fun s -> String.trim s <> "") non_dividers in
String.concat "\n" trimmed
in
let all_docs = List.concat_map (fun path ->
let rel = relative_path ~base:dir path in
try
let 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
let exprs = Sx_parser.parse_all ~comments:true (In_channel.with_open_text path In_channel.input_all) in
(* Walk list tracking preceding comment *)
let rec collect prev_comment = function
| [] -> []
| Comment text :: rest -> collect (Some text) rest
| (List (Symbol head :: Symbol name :: params_rest) as _expr) :: rest
| (ListRef { contents = Symbol head :: Symbol name :: params_rest } as _expr) :: rest ->
let doc = match head with
| "defcomp" | "defisland" ->
let params_str = match rest with
let params_str = match params_rest with
| List ps :: _ | ListRef { contents = ps } :: _ ->
let keys = List.filter_map (fun p -> match p with
| Symbol s when s <> "&key" && s <> "&rest" && not (String.length s > 0 && s.[0] = '&') -> Some s
@@ -982,12 +1065,27 @@ let handle_tool name args =
key_str ^ rest_str
| _ -> ""
in
Some (Printf.sprintf "## %s `%s`\nDefined in: %s\nType: %s\n%s" head name rel head params_str)
let comment_str = match prev_comment with
| Some text ->
let cleaned = strip_comment_prefix text in
if cleaned = "" then "" else " " ^ cleaned ^ "\n"
| None -> ""
in
Some (Printf.sprintf "## %s `%s`\nDefined in: %s\nType: %s\n%s%s" head name rel head comment_str params_str)
| "defmacro" ->
Some (Printf.sprintf "## %s `%s`\nDefined in: %s\nType: macro\n" head name rel)
| _ -> None)
| _ -> None
) exprs
let comment_str = match prev_comment with
| Some text ->
let cleaned = strip_comment_prefix text in
if cleaned = "" then "" else " " ^ cleaned ^ "\n"
| None -> ""
in
Some (Printf.sprintf "## %s `%s`\nDefined in: %s\nType: macro\n%s" head name rel comment_str)
| _ -> None
in
(match doc with Some d -> d :: collect None rest | None -> collect None rest)
| _ :: rest -> collect None rest
in
collect None exprs
with _ -> []
) files in
if all_docs = [] then text_result "(no components found)"
@@ -1523,7 +1621,19 @@ let handle_tool name args =
let tree, cmap = parse_file_with_comments 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
let raw_src = args |> member "new_source" |> to_string in
(* Find the match index so we can attach fragment comments *)
let match_result = call_sx "find-all" [tree; String pattern] in
let target_idx = match match_result with
| List (List (List (Number n :: _) :: _) :: _) -> Some (int_of_float n)
| List (List (Number n :: _) :: _) -> Some (int_of_float n)
| _ -> None in
let insert_idx = match target_idx with
| Some n -> Some (if position = "before" then n else n + 1)
| None -> None in
let src = match insert_idx with
| Some idx -> extract_fragment_comments raw_src cmap idx
| None -> raw_src in
write_edit_with_comments file cmap (call_sx "insert-near-pattern" [tree; String pattern; String position; String src])
| "sx_rename_across" ->

102
hosts/ocaml/lib/sx_parser.ml
View File

@@ -110,7 +110,35 @@ let try_number str =
| Some n -> Some (Number n)
| None -> None
(* Module-level flag — when true, comments are captured as Comment nodes.
Set by parse_all ~comments:true, reset after. *)
let _preserve_comments = ref false
(* Collect consecutive comment lines into a Comment node *)
let collect_comment_node s =
let lines = ref [] in
let rec go () =
skip_whitespace s;
if not (at_end s) && s.src.[s.pos] = ';' then begin
lines := read_comment s :: !lines;
go ()
end
in
go ();
Comment (String.concat "\n" (List.rev !lines))
let rec read_value s : value =
(* In comment-preserving mode, check for comments first *)
if !_preserve_comments then begin
skip_whitespace s;
if not (at_end s) && s.src.[s.pos] = ';' then
collect_comment_node s
else
read_value_core s
end else
read_value_core s
and read_value_core s : value =
skip_whitespace_and_comments s;
if at_end s then begin
let line = ref 1 in
@@ -184,14 +212,29 @@ and read_list s close_char =
advance s; (* skip opening paren/bracket *)
let items = ref [] in
let rec go () =
skip_whitespace_and_comments s;
if at_end s then raise (Parse_error "Unterminated list");
if s.src.[s.pos] = close_char then begin
advance s;
List (List.rev !items)
if !_preserve_comments then begin
skip_whitespace s;
if at_end s then raise (Parse_error "Unterminated list");
if s.src.[s.pos] = close_char then begin
advance s;
List (List.rev !items)
end else if s.src.[s.pos] = ';' then begin
items := collect_comment_node s :: !items;
go ()
end else begin
items := read_value_core s :: !items;
go ()
end
end else begin
items := read_value s :: !items;
go ()
skip_whitespace_and_comments s;
if at_end s then raise (Parse_error "Unterminated list");
if s.src.[s.pos] = close_char then begin
advance s;
List (List.rev !items)
end else begin
items := read_value s :: !items;
go ()
end
end
in go ()
@@ -220,42 +263,25 @@ and read_dict s =
(** Parse a string into a list of SX values.
When [~comments:true], top-level ;; comments are preserved as [Comment]
nodes in the result list. Default is [false] (strip comments). *)
When [~comments:true], comments are preserved as [Comment] nodes —
both at top level and inside lists. Default is [false] (strip). *)
let parse_all ?(comments=false) src =
_preserve_comments := comments;
let s = make_state src in
let results = ref [] in
let rec go () =
if comments then begin
skip_whitespace s;
if at_end s then List.rev !results
else if s.src.[s.pos] = ';' then begin
(* Collect consecutive comment lines into one Comment node *)
let lines = ref [] in
let rec collect () =
skip_whitespace s;
if not (at_end s) && s.src.[s.pos] = ';' then begin
lines := read_comment s :: !lines;
collect ()
end
in
collect ();
let text = String.concat "\n" (List.rev !lines) in
results := Comment text :: !results;
go ()
end else begin
results := read_value s :: !results;
go ()
end
end else begin
skip_whitespace_and_comments s;
if at_end s then List.rev !results
else begin
results := read_value s :: !results;
go ()
end
if !_preserve_comments then skip_whitespace s
else skip_whitespace_and_comments s;
if at_end s then (
_preserve_comments := false;
List.rev !results
) else begin
results := read_value s :: !results;
go ()
end
in go ()
in
try go ()
with e -> _preserve_comments := false; raise e
(** Parse a file into a list of SX values. *)
let parse_file ?(comments=false) path =