Remove Comment variant and old comment-mode parser — CST handles all
Delete from sx_types.ml: - Comment of string variant (no longer needed) Delete from sx_parser.ml: - _preserve_comments mutable ref - collect_comment_node function - comment-mode branches in read_value, read_list - ~comments parameter from parse_all and parse_file - skip_whitespace and read_comment (only used by old comment mode) Delete from mcp_tree.ml: - has_interior_comments function - Comment handling in pretty_print_value - pretty_print_file function (replaced by CST write-back) - ~comments parameter from local parse_file Migrate sx_pretty_print, sx_write_file, sx_doc_gen to CST path. Net: -69 lines. 24/24 CST round-trips, 2583/2583 evaluator tests. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -308,9 +308,9 @@ let call_sx fn_name args =
|
||||
let fn = env_get e fn_name in
|
||||
Sx_ref.cek_call fn (List args)
|
||||
|
||||
let parse_file ?(comments=false) path =
|
||||
let parse_file path =
|
||||
let src = In_channel.with_open_text path In_channel.input_all in
|
||||
let exprs = Sx_parser.parse_all ~comments src in
|
||||
let exprs = Sx_parser.parse_all src in
|
||||
List exprs
|
||||
|
||||
(* CST-based round-tripping — replaces comment_map machinery.
|
||||
@@ -461,23 +461,12 @@ 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 && not (has_interior_comments v) then
|
||||
if est_width v <= max_width - indent then
|
||||
(* Fits on one line and has no comments *)
|
||||
Buffer.add_string buf (pp_atom v)
|
||||
else begin
|
||||
@@ -489,12 +478,6 @@ let pretty_print_value ?(max_width=80) v =
|
||||
let rest = List.tl items in
|
||||
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 ' ');
|
||||
@@ -517,30 +500,6 @@ let pretty_print_value ?(max_width=80) v =
|
||||
pp 0 v;
|
||||
Buffer.contents buf
|
||||
|
||||
let pretty_print_file exprs =
|
||||
(* Comments attach to the following expression — no blank line between
|
||||
comment and expression. Non-comment expressions get one blank line
|
||||
between them (matching the old String.concat "\n\n" behaviour). *)
|
||||
let buf = Buffer.create 4096 in
|
||||
let rec emit first prev_was_comment = function
|
||||
| [] -> ()
|
||||
| Comment text :: rest ->
|
||||
(* Blank line before comment block, unless it's the first item
|
||||
or follows another comment *)
|
||||
if not first && not prev_was_comment then Buffer.add_char buf '\n';
|
||||
Buffer.add_string buf text;
|
||||
Buffer.add_char buf '\n';
|
||||
emit false true rest
|
||||
| v :: rest ->
|
||||
(* Blank line between non-comment expressions; no blank line
|
||||
after a comment (comment sticks to its expression) *)
|
||||
if not first && not prev_was_comment then Buffer.add_char buf '\n';
|
||||
Buffer.add_string buf (pretty_print_value v);
|
||||
Buffer.add_char buf '\n';
|
||||
emit false false rest
|
||||
in
|
||||
emit true false exprs;
|
||||
Buffer.contents buf
|
||||
|
||||
|
||||
(* Apply an AST-level edit result back to the CST and write the file.
|
||||
@@ -892,10 +851,28 @@ let handle_tool name args =
|
||||
|
||||
| "sx_pretty_print" ->
|
||||
let file = args |> member "file" |> to_string in
|
||||
let exprs = Sx_parser.parse_all ~comments:true (In_channel.with_open_text file In_channel.input_all) in
|
||||
let source = pretty_print_file exprs in
|
||||
let cst = Sx_parser.parse_file_cst file in
|
||||
(* Reformat each node's code while preserving trivia (comments, spacing) *)
|
||||
let reformatted = List.map (fun node ->
|
||||
let trivia = match node with
|
||||
| Sx_cst.CstAtom r -> r.leading_trivia
|
||||
| Sx_cst.CstList r -> r.leading_trivia
|
||||
| Sx_cst.CstDict r -> r.leading_trivia
|
||||
in
|
||||
let ast = Sx_cst.cst_to_ast node in
|
||||
let pp = pretty_print_value ast in
|
||||
let new_cst = Sx_parser.parse_all_cst pp in
|
||||
match new_cst.nodes with
|
||||
| [n] ->
|
||||
(match n with
|
||||
| Sx_cst.CstAtom r -> Sx_cst.CstAtom { r with leading_trivia = trivia }
|
||||
| Sx_cst.CstList r -> Sx_cst.CstList { r with leading_trivia = trivia }
|
||||
| Sx_cst.CstDict r -> Sx_cst.CstDict { r with leading_trivia = trivia })
|
||||
| _ -> node
|
||||
) cst.nodes in
|
||||
let source = Sx_cst.cst_file_to_source reformatted cst.trailing_trivia 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))
|
||||
text_result (Printf.sprintf "OK — reformatted %s (%d bytes, %d forms)" file (String.length source) (List.length cst.nodes))
|
||||
|
||||
| "sx_changed" ->
|
||||
let base_ref = args |> member "ref" |> to_string_option |> Option.value ~default:"main" in
|
||||
@@ -1021,14 +998,24 @@ let handle_tool name args =
|
||||
let all_docs = List.concat_map (fun path ->
|
||||
let rel = relative_path ~base:dir path in
|
||||
try
|
||||
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
|
||||
let cst = Sx_parser.parse_file_cst path in
|
||||
List.filter_map (fun node ->
|
||||
(* Extract leading comment trivia from CST node *)
|
||||
let trivia = match node with
|
||||
| Sx_cst.CstAtom r -> r.leading_trivia
|
||||
| Sx_cst.CstList r -> r.leading_trivia
|
||||
| Sx_cst.CstDict r -> r.leading_trivia
|
||||
in
|
||||
let comment_text = List.filter_map (function
|
||||
| Sx_cst.LineComment text -> Some text | _ -> None
|
||||
) trivia in
|
||||
let prev_comment = if comment_text = [] then None
|
||||
else Some (String.concat "" comment_text) in
|
||||
let expr = Sx_cst.cst_to_ast node in
|
||||
match expr with
|
||||
| List (Symbol head :: Symbol name :: params_rest)
|
||||
| ListRef { contents = Symbol head :: Symbol name :: params_rest } ->
|
||||
(match head with
|
||||
| "defcomp" | "defisland" ->
|
||||
let params_str = match params_rest with
|
||||
| List ps :: _ | ListRef { contents = ps } :: _ ->
|
||||
@@ -1058,12 +1045,9 @@ let handle_tool name args =
|
||||
| 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
|
||||
| _ -> None)
|
||||
| _ -> None
|
||||
) cst.nodes
|
||||
with _ -> []
|
||||
) files in
|
||||
if all_docs = [] then text_result "(no components found)"
|
||||
@@ -1557,14 +1541,32 @@ let handle_tool name args =
|
||||
| "sx_write_file" ->
|
||||
let file = args |> member "file" |> to_string in
|
||||
let source = args |> member "source" |> to_string in
|
||||
(* Validate by parsing first — preserve comments *)
|
||||
(* Validate by parsing as CST — preserves comments and formatting *)
|
||||
(try
|
||||
let exprs = Sx_parser.parse_all ~comments:true source in
|
||||
if exprs = [] then error_result "Source parsed to empty — nothing to write"
|
||||
let cst = Sx_parser.parse_all_cst source in
|
||||
if cst.nodes = [] then error_result "Source parsed to empty — nothing to write"
|
||||
else begin
|
||||
let output = pretty_print_file exprs in
|
||||
(* Pretty-print each node but keep trivia *)
|
||||
let reformatted = List.map (fun node ->
|
||||
let trivia = match node with
|
||||
| Sx_cst.CstAtom r -> r.leading_trivia
|
||||
| Sx_cst.CstList r -> r.leading_trivia
|
||||
| Sx_cst.CstDict r -> r.leading_trivia
|
||||
in
|
||||
let ast = Sx_cst.cst_to_ast node in
|
||||
let pp = pretty_print_value ast in
|
||||
let new_cst = Sx_parser.parse_all_cst pp in
|
||||
match new_cst.nodes with
|
||||
| [n] ->
|
||||
(match n with
|
||||
| Sx_cst.CstAtom r -> Sx_cst.CstAtom { r with leading_trivia = trivia }
|
||||
| Sx_cst.CstList r -> Sx_cst.CstList { r with leading_trivia = trivia }
|
||||
| Sx_cst.CstDict r -> Sx_cst.CstDict { r with leading_trivia = trivia })
|
||||
| _ -> node
|
||||
) cst.nodes in
|
||||
let output = Sx_cst.cst_file_to_source reformatted cst.trailing_trivia 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)
|
||||
text_result (Printf.sprintf "OK — wrote %d bytes (%d top-level forms) to %s" (String.length output) (List.length cst.nodes) file)
|
||||
end
|
||||
with e -> error_result (Printf.sprintf "Parse error — file not written: %s" (Printexc.to_string e)))
|
||||
|
||||
|
||||
Reference in New Issue
Block a user