diff --git a/hosts/ocaml/bin/mcp_tree.ml b/hosts/ocaml/bin/mcp_tree.ml index 2ec947b6..663ad2ba 100644 --- a/hosts/ocaml/bin/mcp_tree.ml +++ b/hosts/ocaml/bin/mcp_tree.ml @@ -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" -> diff --git a/hosts/ocaml/lib/sx_parser.ml b/hosts/ocaml/lib/sx_parser.ml index f71d1364..9be3f71d 100644 --- a/hosts/ocaml/lib/sx_parser.ml +++ b/hosts/ocaml/lib/sx_parser.ml @@ -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 =