From 2896fae52efdaab34ea3abcffe43d2ffa266a2c4 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Fri, 2 Oct 2026 06:57:51 +0200 Subject: [PATCH 1/4] Remove the unused Scope.item_to_string Scope.item_to_string in analysis/src/scope.ml was kept only by its [@@live] annotation. git grep over the whole repository (sources, tests, docs, scripts) finds no reference to Scope.item_to_string, no open or include of Scope that would expose it, and no other caller. The debug printing of scope items in completions.ml uses Shared_types.Scope_types.item_to_string, which stays. To restore it, git revert this commit. Co-Authored-By: Claude Opus 5.5 Signed-off-by: Cristiano Calcagno --- analysis/src/scope.ml | 13 ------------- 1 file changed, 13 deletions(-) diff --git a/analysis/src/scope.ml b/analysis/src/scope.ml index f7bf118693..2fafbcc788 100644 --- a/analysis/src/scope.ml +++ b/analysis/src/scope.ml @@ -4,19 +4,6 @@ type t = item list open Shared_types.Scope_types -let item_to_string item = - let str s = if s = "" then "\"\"" else s in - let list l = "[" ^ (l |> List.map str |> String.concat ", ") ^ "]" in - match item with - | Constructor (s, loc) -> "Constructor " ^ s ^ " " ^ Loc.to_string loc - | Field (s, loc) -> "Field " ^ s ^ " " ^ Loc.to_string loc - | Open sl -> "Open " ^ list sl - | Module (s, loc) -> "Module " ^ s ^ " " ^ Loc.to_string loc - | Value (s, loc, _, _) -> "Value " ^ s ^ " " ^ Loc.to_string loc - | Type (s, loc) -> "Type " ^ s ^ " " ^ Loc.to_string loc - | Include (s, loc) -> "Include " ^ s ^ " " ^ Loc.to_string loc -[@@live] - let create () : t = [] let add_constructor ~name ~loc x = Constructor (name, loc) :: x let add_field ~name ~loc x = Field (name, loc) :: x From 70944665395e702a6d28da71924988e2ab3f034f Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Fri, 2 Oct 2026 06:57:52 +0200 Subject: [PATCH 2/4] Remove the unused Res_doc.debug and Res_outcome_printer.parenthesized_ident Both were exported with [@@live] and have no consumer: - Res_doc.debug printed a document tree to stdout. Its only mention was the commented-out "(* Doc.debug doc; *)" in Res_printer.print_implementation, deleted here with it. - Res_outcome_printer.parenthesized_ident always returned true and has no call site, inside the outcome printer or elsewhere, so no call site simplifies. Oprint.parenthesized_ident in compiler/ml is a separate function and stays. git grep over the whole repository (sources, tests, docs, scripts) finds no other reference; the matches in tests/syntax_benchmarks/data and tests/syntax_tests/data/idempotency are ReScript copies of old sources used as parser input, not callers. To restore them, git revert this commit. Co-Authored-By: Claude Opus 5.5 Signed-off-by: Cristiano Calcagno --- compiler/syntax/src/res_doc.ml | 92 --------------------- compiler/syntax/src/res_doc.mli | 1 - compiler/syntax/src/res_outcome_printer.ml | 4 - compiler/syntax/src/res_outcome_printer.mli | 2 - compiler/syntax/src/res_printer.ml | 1 - 5 files changed, 100 deletions(-) diff --git a/compiler/syntax/src/res_doc.ml b/compiler/syntax/src/res_doc.ml index 655522c158..479015a6e3 100644 --- a/compiler/syntax/src/res_doc.ml +++ b/compiler/syntax/src/res_doc.ml @@ -260,95 +260,3 @@ let to_string ~width doc = in process ~pos:0 [] [(0, Flat, doc)]; Mini_buffer.contents buffer - -let debug t = - let rec to_doc = function - | Nil -> text "nil" - | BreakParent -> text "breakparent" - | Text txt -> text ("text(\"" ^ txt ^ "\")") - | LineSuffix doc -> - group - (concat - [ - text "linesuffix("; - indent (concat [line; to_doc doc]); - line; - text ")"; - ]) - | Concat [] -> text "concat()" - | Concat docs -> - group - (concat - [ - text "concat("; - indent - (concat - [ - line; - join ~sep:(concat [text ","; line]) (List.map to_doc docs); - ]); - line; - text ")"; - ]) - | CustomLayout docs -> - group - (concat - [ - text "customLayout("; - indent - (concat - [ - line; - join ~sep:(concat [text ","; line]) (List.map to_doc docs); - ]); - line; - text ")"; - ]) - | Indent doc -> - concat [text "indent("; soft_line; to_doc doc; soft_line; text ")"] - | IfBreaks {yes = true_doc; broken = true} -> to_doc true_doc - | IfBreaks {yes = true_doc; no = false_doc} -> - group - (concat - [ - text "ifBreaks("; - indent - (concat - [ - line; - to_doc true_doc; - concat [text ","; line]; - to_doc false_doc; - ]); - line; - text ")"; - ]) - | LineBreak break -> - let break_txt = - match break with - | Classic -> "Classic" - | Soft -> "Soft" - | Hard -> "Hard" - | Literal -> "Liteal" - in - text ("LineBreak(" ^ break_txt ^ ")") - | Group {should_break; doc} -> - group - (concat - [ - text "Group("; - indent - (concat - [ - line; - text ("{shouldBreak: " ^ string_of_bool should_break ^ "}"); - concat [text ","; line]; - to_doc doc; - ]); - line; - text ")"; - ]) - in - let doc = to_doc t in - to_string ~width:10 doc |> print_endline -[@@live] diff --git a/compiler/syntax/src/res_doc.mli b/compiler/syntax/src/res_doc.mli index 721dedb537..253dc6043a 100644 --- a/compiler/syntax/src/res_doc.mli +++ b/compiler/syntax/src/res_doc.mli @@ -51,4 +51,3 @@ val will_break : t -> bool [break_parent] to propagate it to the parent document. *) val to_string : width:int -> t -> string -val debug : t -> unit [@@live] diff --git a/compiler/syntax/src/res_outcome_printer.ml b/compiler/syntax/src/res_outcome_printer.ml index 4876006d8a..8b9905d6b2 100644 --- a/compiler/syntax/src/res_outcome_printer.ml +++ b/compiler/syntax/src/res_outcome_printer.ml @@ -10,10 +10,6 @@ module Doc = Res_doc module Printer = Res_printer -(* ReScript doesn't have parenthesized identifiers. - * We don't support custom operators. *) -let parenthesized_ident _name = true - (* TODO: better allocation strategy for the buffer *) let escape_string_contents s = let len = String.length s in diff --git a/compiler/syntax/src/res_outcome_printer.mli b/compiler/syntax/src/res_outcome_printer.mli index 609644e777..f874ce66b6 100644 --- a/compiler/syntax/src/res_outcome_printer.mli +++ b/compiler/syntax/src/res_outcome_printer.mli @@ -7,8 +7,6 @@ * * In general it represent messages to show results or errors to the user. *) -val parenthesized_ident : string -> bool [@@live] - val setup : unit lazy_t [@@live] (* Needed for e.g. the playground to print typedtree data *) diff --git a/compiler/syntax/src/res_printer.ml b/compiler/syntax/src/res_printer.ml index c52fd4a655..251f4b2d91 100644 --- a/compiler/syntax/src/res_printer.ml +++ b/compiler/syntax/src/res_printer.ml @@ -6240,7 +6240,6 @@ let print_implementation ?(width = default_print_width) let cmt_tbl = Comment_table.make () in Comment_table.walk_structure s cmt_tbl comments; let doc = print_structure ~state:(State.init ()) s cmt_tbl in - (* Doc.debug doc; *) Doc.to_string ~width doc ^ "\n" let print_interface ?(width = default_print_width) (s : Parsetree.signature) From 214025c6f9497d5b397770ee9f57b9c8450cb0de Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Fri, 2 Oct 2026 06:57:52 +0200 Subject: [PATCH 3/4] Remove the unused Translate_structure.add_annotations_to_fields add_annotations_to_fields was kept only by its [@@live] annotation; its only caller was itself. git grep over the whole repository (sources, tests, docs, scripts) finds no other reference; the matches in tests/syntax_tests/data/idempotency/genType are ReScript copies of old sources used as parser input, not callers. Its removal leaves Translate_type_declarations.rename_record_field with no caller, so that goes too. The comment on declared_field_name referred to it, and now describes declared_field_name itself. To restore them, git revert this commit. Co-Authored-By: Claude Opus 5.5 Signed-off-by: Cristiano Calcagno --- compiler/gentype/translate_structure.ml | 15 -------------- .../gentype/translate_type_declarations.ml | 20 +++---------------- 2 files changed, 3 insertions(+), 32 deletions(-) diff --git a/compiler/gentype/translate_structure.ml b/compiler/gentype/translate_structure.ml index 56b81dac26..2222f96148 100644 --- a/compiler/gentype/translate_structure.ml +++ b/compiler/gentype/translate_structure.ml @@ -38,21 +38,6 @@ and add_annotations_to_types ~config ~(expr : Typedtree.expression) {a_name = a_name ^ "_" ^ string_of_int i; a_type}) else arg_types -and add_annotations_to_fields ~config (expr : Typedtree.expression) - (fields : fields) (arg_types : arg_type list) = - match fields with - | [] -> ([], arg_types |> add_annotations_to_types ~config ~expr) - | field :: next_fields -> - let next_fields1, types1 = - add_annotations_to_fields ~config expr next_fields arg_types - in - let name = - Translate_type_declarations.rename_record_field - ~attributes:expr.exp_attributes ~name:field.name_js - in - ({field with name_js = name} :: next_fields1, types1) -[@@live] - (** Recover from expr the renaming annotations on named arguments. *) let add_annotations_to_function_type ~config (expr : Typedtree.expression) (type_ : type_) = diff --git a/compiler/gentype/translate_type_declarations.ml b/compiler/gentype/translate_type_declarations.ml index 246c26e3ff..ea6052600c 100644 --- a/compiler/gentype/translate_type_declarations.ml +++ b/compiler/gentype/translate_type_declarations.ml @@ -52,23 +52,9 @@ let create_variant_case label = function | Some Variant_runtime.Undefined -> {label_js = UndefinedLabel} | None -> {label_js = StringLabel label} -(** - * Rename record fields. - * If @genType.as is used, perform renaming conversion. - * If @as is used (with records-as-objects active), escape and quote if - * the identifier contains characters which are invalid as JS property names. - * For escaped identifiers like \"foo-bar", strip the surrounding \"..." - * since they are part of the ReScript syntax, not the actual field name. - * The resulting name will be quoted later in EmitType if needed. -*) -let rename_record_field ~attributes ~name = - attributes |> Annotation.check_unsupported_gentype_as_renaming; - match attributes |> Annotation.get_as_string with - | Some s -> Emit_text.escape_string_contents s - | None -> name |> Ext_ident.unwrap_uppercase_exotic - -(* A declared field carries its runtime name; only the renaming that reaches - gentype through an expression's attributes still has to be read off one. *) +(* The JS name of a declared record field: its runtime name (set by @as), + escaped as string contents, or else its identifier with the \"..." of an + exotic name removed. *) let declared_field_name (ld : Types.label_declaration) = ld.ld_attributes |> Annotation.check_unsupported_gentype_as_renaming; match ld.ld_runtime_name with From f349d7fc1002522394978e630d602517f814cfce Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sun, 4 Oct 2026 08:30:45 +0100 Subject: [PATCH 4/4] Print the printer's document tree with res_parser -print doc Res_doc.debug stays and becomes the -print doc engine of res_parser, which prints the document Res_printer builds for a file. Res_printer exposes implementation_doc and interface_doc for it. Co-Authored-By: Claude Opus 5.5 Signed-off-by: Cristiano Calcagno --- compiler/syntax/README.md | 1 + compiler/syntax/cli/res_cli.ml | 8 ++- compiler/syntax/src/res_ast_debugger.ml | 10 +++ compiler/syntax/src/res_ast_debugger.mli | 1 + compiler/syntax/src/res_doc.ml | 91 ++++++++++++++++++++++++ compiler/syntax/src/res_doc.mli | 1 + compiler/syntax/src/res_printer.ml | 19 +++-- compiler/syntax/src/res_printer.mli | 5 ++ 8 files changed, 126 insertions(+), 10 deletions(-) diff --git a/compiler/syntax/README.md b/compiler/syntax/README.md index 2ed720b90f..1bbc1504dc 100644 --- a/compiler/syntax/README.md +++ b/compiler/syntax/README.md @@ -44,6 +44,7 @@ dune exec res_parser -- example.res dune exec res_parser -- -print tokens example.res dune exec res_parser -- -print ast -recover example.res dune exec res_parser -- -print comments example.res +dune exec res_parser -- -print doc example.res dune exec res_parser -- -print ml example.res dune exec res_parser -- -print res -width 80 example.res ``` diff --git a/compiler/syntax/cli/res_cli.ml b/compiler/syntax/cli/res_cli.ml index 939076df17..c703d35c26 100644 --- a/compiler/syntax/cli/res_cli.ml +++ b/compiler/syntax/cli/res_cli.ml @@ -39,7 +39,8 @@ end = struct ("-recover", Arg.Unit (fun () -> recover := true), "Emit partial ast"); ( "-print", Arg.String (fun txt -> print := txt), - "Print either ml, ast, sexp, comments, tokens or res. Default: res" ); + "Print either ml, ast, sexp, comments, tokens, doc or res. Default: res" + ); ( "-width", Arg.Int (fun w -> width := w), "Specify the line length for the printer (formatter)" ); @@ -80,10 +81,11 @@ module Cli_arg_processor = struct | "comments" -> Res_ast_debugger.comments_print_engine | "tokens" -> Res_token_debugger.token_print_engine | "res" -> Res_driver.print_engine + | "doc" -> Res_ast_debugger.doc_print_engine | target -> print_endline - ("-print needs to be either ml, ast, sexp, comments, tokens or res. \ - You provided " ^ target); + ("-print needs to be either ml, ast, sexp, comments, tokens, doc or \ + res. You provided " ^ target); exit 1 in diff --git a/compiler/syntax/src/res_ast_debugger.ml b/compiler/syntax/src/res_ast_debugger.ml index d6c195d26b..c3b58b1b6c 100644 --- a/compiler/syntax/src/res_ast_debugger.ml +++ b/compiler/syntax/src/res_ast_debugger.ml @@ -1078,3 +1078,13 @@ let comments_print_engine = Comment_table.walk_signature s cmt_tbl comments; Comment_table.log cmt_tbl); } + +let doc_print_engine = + { + Res_driver.print_implementation = + (fun ~width:_ ~filename:_ ~comments s -> + Res_doc.debug (Res_printer.implementation_doc s ~comments)); + Res_driver.print_interface = + (fun ~width:_ ~filename:_ ~comments s -> + Res_doc.debug (Res_printer.interface_doc s ~comments)); + } diff --git a/compiler/syntax/src/res_ast_debugger.mli b/compiler/syntax/src/res_ast_debugger.mli index 66588af592..beb92d8224 100644 --- a/compiler/syntax/src/res_ast_debugger.mli +++ b/compiler/syntax/src/res_ast_debugger.mli @@ -1,3 +1,4 @@ val print_engine : Res_driver.print_engine val sexp_print_engine : Res_driver.print_engine val comments_print_engine : Res_driver.print_engine +val doc_print_engine : Res_driver.print_engine diff --git a/compiler/syntax/src/res_doc.ml b/compiler/syntax/src/res_doc.ml index 479015a6e3..2f727d3f3b 100644 --- a/compiler/syntax/src/res_doc.ml +++ b/compiler/syntax/src/res_doc.ml @@ -260,3 +260,94 @@ let to_string ~width doc = in process ~pos:0 [] [(0, Flat, doc)]; Mini_buffer.contents buffer + +let debug t = + let rec to_doc = function + | Nil -> text "nil" + | BreakParent -> text "breakparent" + | Text txt -> text ("text(\"" ^ txt ^ "\")") + | LineSuffix doc -> + group + (concat + [ + text "linesuffix("; + indent (concat [line; to_doc doc]); + line; + text ")"; + ]) + | Concat [] -> text "concat()" + | Concat docs -> + group + (concat + [ + text "concat("; + indent + (concat + [ + line; + join ~sep:(concat [text ","; line]) (List.map to_doc docs); + ]); + line; + text ")"; + ]) + | CustomLayout docs -> + group + (concat + [ + text "customLayout("; + indent + (concat + [ + line; + join ~sep:(concat [text ","; line]) (List.map to_doc docs); + ]); + line; + text ")"; + ]) + | Indent doc -> + concat [text "indent("; soft_line; to_doc doc; soft_line; text ")"] + | IfBreaks {yes = true_doc; broken = true} -> to_doc true_doc + | IfBreaks {yes = true_doc; no = false_doc} -> + group + (concat + [ + text "ifBreaks("; + indent + (concat + [ + line; + to_doc true_doc; + concat [text ","; line]; + to_doc false_doc; + ]); + line; + text ")"; + ]) + | LineBreak break -> + let break_txt = + match break with + | Classic -> "Classic" + | Soft -> "Soft" + | Hard -> "Hard" + | Literal -> "Literal" + in + text ("LineBreak(" ^ break_txt ^ ")") + | Group {should_break; doc} -> + group + (concat + [ + text "Group("; + indent + (concat + [ + line; + text ("{shouldBreak: " ^ string_of_bool should_break ^ "}"); + concat [text ","; line]; + to_doc doc; + ]); + line; + text ")"; + ]) + in + let doc = to_doc t in + to_string ~width:10 doc |> print_endline diff --git a/compiler/syntax/src/res_doc.mli b/compiler/syntax/src/res_doc.mli index 253dc6043a..652e2fee49 100644 --- a/compiler/syntax/src/res_doc.mli +++ b/compiler/syntax/src/res_doc.mli @@ -51,3 +51,4 @@ val will_break : t -> bool [break_parent] to propagate it to the parent document. *) val to_string : width:int -> t -> string +val debug : t -> unit diff --git a/compiler/syntax/src/res_printer.ml b/compiler/syntax/src/res_printer.ml index 251f4b2d91..7ffe10d8fb 100644 --- a/compiler/syntax/src/res_printer.ml +++ b/compiler/syntax/src/res_printer.ml @@ -6235,17 +6235,22 @@ let print_typ_expr t = print_typ_expr ~state:(State.init ()) t let print_expression e = print_expression ~state:(State.init ()) e let print_pattern p = print_pattern ~state:(State.init ()) p -let print_implementation ?(width = default_print_width) - (s : Parsetree.structure) ~comments = +let implementation_doc (s : Parsetree.structure) ~comments = let cmt_tbl = Comment_table.make () in Comment_table.walk_structure s cmt_tbl comments; - let doc = print_structure ~state:(State.init ()) s cmt_tbl in - Doc.to_string ~width doc ^ "\n" + print_structure ~state:(State.init ()) s cmt_tbl -let print_interface ?(width = default_print_width) (s : Parsetree.signature) - ~comments = +let interface_doc (s : Parsetree.signature) ~comments = let cmt_tbl = Comment_table.make () in Comment_table.walk_signature s cmt_tbl comments; - Doc.to_string ~width (print_signature ~state:(State.init ()) s cmt_tbl) ^ "\n" + print_signature ~state:(State.init ()) s cmt_tbl + +let print_implementation ?(width = default_print_width) + (s : Parsetree.structure) ~comments = + Doc.to_string ~width (implementation_doc s ~comments) ^ "\n" + +let print_interface ?(width = default_print_width) (s : Parsetree.signature) + ~comments = + Doc.to_string ~width (interface_doc s ~comments) ^ "\n" let print_structure = print_structure ~state:(State.init ()) diff --git a/compiler/syntax/src/res_printer.mli b/compiler/syntax/src/res_printer.mli index 33461d7714..d4e74bf91e 100644 --- a/compiler/syntax/src/res_printer.mli +++ b/compiler/syntax/src/res_printer.mli @@ -19,6 +19,11 @@ val print_pattern : Parsetree.pattern -> Res_comments_table.t -> Res_doc.t val print_structure : Parsetree.structure -> Res_comments_table.t -> Res_doc.t [@@live] +val implementation_doc : + Parsetree.structure -> comments:Res_comment.t list -> Res_doc.t +val interface_doc : + Parsetree.signature -> comments:Res_comment.t list -> Res_doc.t + val print_implementation : ?width:int -> Parsetree.structure -> comments:Res_comment.t list -> string val print_interface :