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 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 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 655522c158..2f727d3f3b 100644 --- a/compiler/syntax/src/res_doc.ml +++ b/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] diff --git a/compiler/syntax/src/res_doc.mli b/compiler/syntax/src/res_doc.mli index 721dedb537..652e2fee49 100644 --- a/compiler/syntax/src/res_doc.mli +++ b/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 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..7ffe10d8fb 100644 --- a/compiler/syntax/src/res_printer.ml +++ b/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 ()) 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 :