Remove unused debugging aids

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

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_) =

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

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
 ```

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
 

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));
+  }

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

compiler/syntax/src/res_doc.ml

@@ -329,7 +329,7 @@ let debug t =
         | Classic -> "Classic"
         | Soft -> "Soft"
         | Hard -> "Hard"
-        | Literal -> "Liteal"
+        | Literal -> "Literal"
       in
       text ("LineBreak(" ^ break_txt ^ ")")
     | Group {should_break; doc} ->
@@ -351,4 +351,3 @@ let debug t =
   in
   let doc = to_doc t in
   to_string ~width:10 doc |> print_endline
-[@@live]

compiler/syntax/src/res_doc.mli

@@ -51,4 +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 [@@live]
+val debug : t -> unit

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

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 *)

compiler/syntax/src/res_printer.ml

@@ -6235,18 +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.debug doc; *)
-  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 ())

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 :