diff --git a/CHANGELOG.md b/CHANGELOG.md index fba92ae26f..804c72a4bd 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -23,6 +23,7 @@ #### :nail_care: Polish - Conditionally print error message about record with missing label potentially being a component. https://github.com/rescript-lang/rescript-compiler/pull/6337 - Put definition in the bottom and the actual error at the top when reporting errors for supplying fields etc with the wrong name. https://github.com/rescript-lang/rescript-compiler/pull/6336 +- Fix left over places where polyvariant tag names were printed in OCaml syntax instead of ReScript. https://github.com/rescript-lang/rescript-compiler/pull/6348 # 11.0.0-beta.4 diff --git a/jscomp/build_tests/super_errors/expected/polyvariant_name_formatting.res.expected b/jscomp/build_tests/super_errors/expected/polyvariant_name_formatting.res.expected new file mode 100644 index 0000000000..6cd099ed47 --- /dev/null +++ b/jscomp/build_tests/super_errors/expected/polyvariant_name_formatting.res.expected @@ -0,0 +1,13 @@ + + We've found a bug for you! + /.../fixtures/polyvariant_name_formatting.res:6:3-10 + + 4 │ + 5 │ switch f { + 6 │ | #Invalid => () + 7 │ } + 8 │ + + This pattern matches values of type [? #Invalid] + but a pattern was expected which matches values of type polyvariant + The second variant type does not allow tag(s) #Invalid \ No newline at end of file diff --git a/jscomp/build_tests/super_errors/fixtures/polyvariant_name_formatting.res b/jscomp/build_tests/super_errors/fixtures/polyvariant_name_formatting.res new file mode 100644 index 0000000000..f28f200f56 --- /dev/null +++ b/jscomp/build_tests/super_errors/fixtures/polyvariant_name_formatting.res @@ -0,0 +1,7 @@ +type polyvariant = [#Error(string) | #Valid] + +let f: polyvariant = #Valid + +switch f { +| #Invalid => () +} diff --git a/jscomp/core/bs_conditional_initial.ml b/jscomp/core/bs_conditional_initial.ml index 167a5d1ab0..d53b367ea3 100644 --- a/jscomp/core/bs_conditional_initial.ml +++ b/jscomp/core/bs_conditional_initial.ml @@ -52,8 +52,10 @@ let setup_env () = Rescript_cpp.replace_directive_bool "BS" true; Rescript_cpp.replace_directive_bool "JS" true; + Printtyp.print_res_poly_identifier := Res_printer.polyVarIdentToString; Rescript_cpp.replace_directive_string "BS_VERSION" Bs_version.version (*; Switch.cut := 100*) (* tweakable but not very useful *) + let () = at_exit (fun _ -> Format.pp_print_flush Format.err_formatter ()) diff --git a/jscomp/gentype/EmitType.ml b/jscomp/gentype/EmitType.ml index 625898c132..1b7ec24ceb 100644 --- a/jscomp/gentype/EmitType.ml +++ b/jscomp/gentype/EmitType.ml @@ -163,13 +163,13 @@ let rec renderType ~(config : Config.t) ?(indent = None) ~typeNameIsInterface type_ |> renderType ~config ~indent ~typeNameIsInterface ~inFunType) in let noPayloadsRendered = noPayloads |> List.map labelJSToString in - let field ~name ?(docString = DocString.empty) value = + let field ~name value = { mutable_ = Mutable; nameJS = name; optional = Mandatory; type_ = TypeVar value; - docString; + docString = DocString.empty; } in let fields fields = diff --git a/jscomp/ml/ctype.ml b/jscomp/ml/ctype.ml index 1b92e9bbca..89143f44be 100644 --- a/jscomp/ml/ctype.ml +++ b/jscomp/ml/ctype.ml @@ -65,7 +65,7 @@ let () = Some Location. (errorf ~loc:(in_file !input_name) - "In this program,@ variant constructors@ `%s and `%s@ \ + "In this program,@ variant constructors@ #%s and #%s@ \ have the same hash value.@ Change one of them." l l' ) | _ -> None diff --git a/jscomp/ml/printtyp.ml b/jscomp/ml/printtyp.ml index 1f6a5da34a..01f06f9af9 100644 --- a/jscomp/ml/printtyp.ml +++ b/jscomp/ml/printtyp.ml @@ -25,6 +25,8 @@ open Types open Btype open Outcometree +let print_res_poly_identifier: (string -> string) ref = ref (fun _ -> assert false) + (* Print a long identifier *) let rec longident ppf = function @@ -1412,8 +1414,8 @@ let may_prepare_expansion compact (t, t') = let print_tags ppf fields = match fields with [] -> () | (t, _) :: fields -> - fprintf ppf "`%s" t; - List.iter (fun (t, _) -> fprintf ppf ",@ `%s" t) fields + fprintf ppf "%s" (!print_res_poly_identifier t); + List.iter (fun (t, _) -> fprintf ppf ",@ %s" (!print_res_poly_identifier t)) fields let has_explanation t3 t4 = match t3.desc, t4.desc with @@ -1493,7 +1495,7 @@ let explanation unif t3 t4 ppf = "@,@[The second variant type does not allow tag(s)@ @[%a@]@]" print_tags fields | [l1,_], true, [l2,_], true when l1 = l2 -> - fprintf ppf "@,Types for tag `%s are incompatible" l1 + fprintf ppf "@,Types for tag %s are incompatible" (!print_res_poly_identifier l1) | _ -> () end | _ -> () diff --git a/jscomp/ml/printtyp.mli b/jscomp/ml/printtyp.mli index 6a3be2eb2b..af92ffa01c 100644 --- a/jscomp/ml/printtyp.mli +++ b/jscomp/ml/printtyp.mli @@ -19,6 +19,7 @@ open Format open Types open Outcometree +val print_res_poly_identifier: (string -> string) ref val longident: formatter -> Longident.t -> unit val ident: formatter -> Ident.t -> unit val tree_of_path: Path.t -> out_ident diff --git a/jscomp/ml/typetexp.ml b/jscomp/ml/typetexp.ml index 8074e6b7b3..7825b4eef5 100644 --- a/jscomp/ml/typetexp.ml +++ b/jscomp/ml/typetexp.ml @@ -946,8 +946,8 @@ let report_error env ppf = function end | Variant_tags (lab1, lab2) -> fprintf ppf - "@[Variant tags `%s@ and `%s have the same hash value.@ %s@]" - lab1 lab2 "Change one of them." + "@[Variant tags %s@ and %s have the same hash value.@ %s@]" + (!Printtyp.print_res_poly_identifier lab1) (!Printtyp.print_res_poly_identifier lab2) "Change one of them." | Invalid_variable_name name -> fprintf ppf "The type variable name %s is not allowed in programs" name | Cannot_quantify (name, v) -> diff --git a/jscomp/syntax/src/res_printer.ml b/jscomp/syntax/src/res_printer.ml index c9331961b0..abd0811093 100644 --- a/jscomp/syntax/src/res_printer.ml +++ b/jscomp/syntax/src/res_printer.ml @@ -480,6 +480,10 @@ let printPolyVarIdent txt = | "" -> Doc.concat [Doc.text "\""; Doc.text txt; Doc.text "\""] | _ -> Doc.text txt) +let polyVarIdentToString polyVarIdent = + Doc.concat [Doc.text "#"; printPolyVarIdent polyVarIdent] + |> Doc.toString ~width:80 + let printLident l = let flatLidOpt lid = let rec flat accu = function diff --git a/jscomp/syntax/src/res_printer.mli b/jscomp/syntax/src/res_printer.mli index 2f854ef6b2..bca833da2b 100644 --- a/jscomp/syntax/src/res_printer.mli +++ b/jscomp/syntax/src/res_printer.mli @@ -24,3 +24,5 @@ val printImplementation : width:int -> Parsetree.structure -> comments:Res_comment.t list -> string val printInterface : width:int -> Parsetree.signature -> comments:Res_comment.t list -> string + +val polyVarIdentToString : string -> string [@@live]