error messsages: convert most hints to submessage (#13838)

This commit

* converts most hints in error messages to separate submessages
* removes some non-modular boxing
* inlines grammatical contents in format strings

in order to improve the indentation of such hints and pave the way to reunifying the error and warning formats for compiler report.

Author: Octachron

.depend

@@ -1884,7 +1884,6 @@ typing/typedecl.cmi : \
     parsing/location.cmi \
     typing/includecore.cmi \
     typing/ident.cmi \
-    utils/format_doc.cmi \
     typing/errortrace.cmi \
     typing/env.cmi \
     parsing/asttypes.cmi
@@ -2258,7 +2257,6 @@ typing/typetexp.cmi : \
     parsing/parsetree.cmi \
     parsing/longident.cmi \
     parsing/location.cmi \
-    utils/format_doc.cmi \
     typing/errortrace.cmi \
     typing/env.cmi \
     parsing/asttypes.cmi

Changes

@@ -348,6 +348,9 @@ Working version
               Hint:              Did you mean "array"?
   (Florian Angeletti, suggestion by Daniel Bünzli, review by Gabriel Scherer)
 
+- #13818: better delimited hints in error message
+  (Florian Angeletti, review by Gabriel Scherer)
+
 ### Internal/compiler-libs changes:
 
 - #13314: Comment the code of Translclass

parsing/lexer.mll

@@ -400,7 +400,10 @@ let prepare_error loc = function
       let msg = "Illegal empty character literal ''" in
       let sub =
         [Location.msg
-           "@{<hint>Hint@}: Did you mean ' ' or a type variable 'a?"] in
+           "@{<hint>Hint@}: Did you mean %a or a type variable %a?"
+           Style.inline_code "' '"
+           Style.inline_code "'a"
+        ] in
       Location.error ~loc ~sub msg
   | Keyword_as_label kwd ->
       Location.errorf ~loc

parsing/location.ml

@@ -739,7 +739,7 @@ let batch_mode_printer : report_printer =
       | Misc.Error_style.Short ->
           ()
     in
-    Format.fprintf ppf "@[<v>%a:@ %a@]" print_loc loc
+    Format.fprintf ppf "%a:@ %a" print_loc loc
       (Fmt.compat highlight) loc
   in
   let pp_txt ppf txt = Format.fprintf ppf "%a" Fmt.Doc.format txt in
@@ -802,9 +802,12 @@ let batch_mode_printer : report_printer =
     ) msgs
   in
   let pp_submsg self report ppf { loc; txt } =
-    Format.fprintf ppf "@[%a  @[%a@]@]"
-      (self.pp_submsg_loc self report) loc
-      (self.pp_submsg_txt self report) txt
+    if loc.loc_ghost then
+      Format.fprintf ppf "@[%a@]" (self.pp_submsg_txt self report) txt
+    else
+      Format.fprintf ppf "%a  @[%a@]"
+        (self.pp_submsg_loc self report) loc
+        (self.pp_submsg_txt self report) txt
   in
   let pp_submsg_loc self report ppf loc =
     if not loc.loc_ghost then
@@ -870,6 +873,16 @@ let mkerror loc sub footnote txt =
 let errorf ?(loc = none) ?(sub = []) ?(footnote=Fun.const None) =
   Fmt.kdoc_printf (mkerror loc sub footnote)
 
+let aligned_error_hint
+    ?(loc = none) ?(sub = []) ?(footnote=Fun.const None) fmt =
+  Fmt.kdoc_printf (fun main hint ->
+      match hint with
+      | None -> mkerror loc sub footnote main
+      | Some hint ->
+          let main, hint = Misc.align_error_hint ~main ~hint in
+          mkerror loc (mknoloc hint :: sub) footnote main
+  ) fmt
+
 let error ?(loc = none) ?(sub = []) ?(footnote=Fun.const None) msg_str =
   mkerror loc sub footnote Fmt.Doc.(string msg_str empty)
 

parsing/location.mli

@@ -335,6 +335,13 @@ val error: ?loc:t -> ?sub:msg list -> ?footnote:delayed_msg -> string -> error
 val errorf: ?loc:t -> ?sub:msg list -> ?footnote:delayed_msg ->
   ('a, Format_doc.formatter, unit, error) format4 -> 'a
 
+val aligned_error_hint:
+  ?loc:t -> ?sub:msg list -> ?footnote:delayed_msg ->
+  ('a, Format_doc.formatter, unit, Format_doc.t option ->  error) format4 -> 'a
+(** [aligned_error_hint ?loc ?sub ?footnote fmt ... aligned_hint] produces an
+    error report where the potential [aligned_hint] message has been aligned
+    with the main error message before being added to the list of submessages.*)
+
 val error_of_printer: ?loc:t -> ?sub:msg list -> ?footnote:delayed_msg ->
   (Format_doc.formatter -> 'a -> unit) -> 'a -> error
 

parsing/parse.ml

@@ -119,11 +119,11 @@ let prepare_error err =
   | Unclosed(opening_loc, opening, closing_loc, closing) ->
       Location.errorf
         ~loc:closing_loc
+        "Syntax error: %a expected" Style.inline_code closing
         ~sub:[
           Location.msg ~loc:opening_loc
             "This %a might be unmatched" Style.inline_code opening
         ]
-        "Syntax error: %a expected" Style.inline_code closing
 
   | Expecting (loc, nonterm) ->
       Location.errorf ~loc "Syntax error: %a expected."
@@ -167,12 +167,18 @@ let prepare_error err =
       Location.errorf ~loc "Syntax error: invalid package type: %a" invalid ipt
   | Removed_string_set loc ->
       Location.errorf ~loc
-        "Syntax error: strings are immutable, there is no assignment \
-         syntax for them.\n\
-         @{<hint>Hint@}: Mutable sequences of bytes are available in \
-         the Bytes module.\n\
-         @{<hint>Hint@}: Did you mean to use %a?"
-        Style.inline_code "Bytes.set"
+        "Syntax error: strings are immutable,@ there@ is@ no@ assignment@ \
+         syntax@ for@ them."
+        ~sub:[
+          Location.msg
+            "@{<hint>Hint@}: Mutable sequences of bytes are available in \
+             the %a module."
+            Style.inline_code "Bytes";
+          Location.msg
+            "@{<hint>Hint@}: Did you mean to use %a?"
+            Style.inline_code "Bytes.set"
+        ]
+
 let () =
   Location.register_error_of_exn
     (function

testsuite/tests/formatting/errors_batch.reference

@@ -6,5 +6,5 @@ File "hello.ml", line 20, characters 4-8:
 File "hello.ml", line 20, characters 6-8:
   Longer sub-messages that do not fit on the same line as the location get
   indented.
-  This second sub-message does not have a location;
-  ghost locations of submessages are not printed.
+This second sub-message does not have a location;
+ghost locations of submessages are not printed.

testsuite/tests/generated-parse-errors/errors.compilers.reference

@@ -1945,7 +1945,8 @@ File "implementation: TRUE DOT LBRACE UIDENT WITH", line 1, characters 7-8:
 File "implementation: TRUE DOT LBRACE WITH", line 1, characters 9-13:
 Error: Syntax error
 File "implementation: TRUE DOT LBRACKET UIDENT RBRACKET LESSMINUS OBJECT END WHILE", line 1, characters 0-31:
-Error: Syntax error: strings are immutable, there is no assignment syntax for them.
+Error: Syntax error: strings are immutable, there is no assignment syntax for
+       them.
 Hint: Mutable sequences of bytes are available in the Bytes module.
 Hint: Did you mean to use Bytes.set?
 File "implementation: TRUE DOT LBRACKET UIDENT RBRACKET LESSMINUS WITH", line 1, characters 21-25:

testsuite/tests/let-syntax/let_syntax.ml

@@ -217,7 +217,7 @@ Line 3, characters 13-14:
                  ^
 Error: The constant "1" has type "int" but an expression was expected of type
          "float"
-  Hint: Did you mean "1."?
+Hint: Did you mean "1."?
 |}];;
 
 module Ill_typed_3 = struct

testsuite/tests/tool-toplevel/error_highlighting.compilers.reference

@@ -24,7 +24,7 @@ Line 3, characters 8-9:
             ^
 Error: The constant 1 has type int but an expression was expected of type
          float
-  Hint: Did you mean 1.?
+Hint: Did you mean 1.?
 Line 4, characters 2-4:
 4 | 2 in
       ^^

testsuite/tests/typing-core-bugs/const_int_hint.ml

@@ -9,7 +9,7 @@ Line 1, characters 19-20:
                        ^
 Error: The constant "1" has type "int" but an expression was expected of type
          "int32"
-  Hint: Did you mean "1l"?
+Hint: Did you mean "1l"?
 |}]
 
 let _ : int32 * int32 = 42l, 43;;
@@ -19,7 +19,7 @@ Line 1, characters 29-31:
                                  ^^
 Error: The constant "43" has type "int" but an expression was expected of type
          "int32"
-  Hint: Did you mean "43l"?
+Hint: Did you mean "43l"?
 |}]
 
 let _ : int32 * nativeint = 42l, 43;;
@@ -29,7 +29,7 @@ Line 1, characters 33-35:
                                      ^^
 Error: The constant "43" has type "int" but an expression was expected of type
          "nativeint"
-  Hint: Did you mean "43n"?
+Hint: Did you mean "43n"?
 |}]
 
 let _ = min 6L 7;;
@@ -39,7 +39,7 @@ Line 1, characters 15-16:
                    ^
 Error: The constant "7" has type "int" but an expression was expected of type
          "int64"
-  Hint: Did you mean "7L"?
+Hint: Did you mean "7L"?
 |}]
 
 let _ : float = 123;;
@@ -49,7 +49,7 @@ Line 1, characters 16-19:
                     ^^^
 Error: The constant "123" has type "int" but an expression was expected of type
          "float"
-  Hint: Did you mean "123."?
+Hint: Did you mean "123."?
 |}]
 
 (* no hint *)
@@ -73,7 +73,7 @@ Line 2, characters 4-5:
         ^
 Error: This pattern matches values of type "int"
        but a pattern was expected which matches values of type "int32"
-  Hint: Did you mean "0l"?
+Hint: Did you mean "0l"?
 |}]
 
 let _ : int64 -> int64 = function
@@ -85,7 +85,7 @@ Line 2, characters 9-10:
              ^
 Error: This pattern matches values of type "int"
        but a pattern was expected which matches values of type "int64"
-  Hint: Did you mean "2L"?
+Hint: Did you mean "2L"?
 |}]
 
 (* symmetric *)
@@ -96,7 +96,7 @@ Line 1, characters 16-18:
                     ^^
 Error: The constant "1L" has type "int64" but an expression was expected of type
          "int32"
-  Hint: Did you mean "1l"?
+Hint: Did you mean "1l"?
 |}]
 let _ : float = 1L;;
 [%%expect{|
@@ -105,7 +105,7 @@ Line 1, characters 16-18:
                     ^^
 Error: The constant "1L" has type "int64" but an expression was expected of type
          "float"
-  Hint: Did you mean "1."?
+Hint: Did you mean "1."?
 |}]
 let _ : int64 = 1n;;
 [%%expect{|
@@ -114,7 +114,7 @@ Line 1, characters 16-18:
                     ^^
 Error: The constant "1n" has type "nativeint"
        but an expression was expected of type "int64"
-  Hint: Did you mean "1L"?
+Hint: Did you mean "1L"?
 |}]
 let _ : nativeint = 1l;;
 [%%expect{|
@@ -123,7 +123,7 @@ Line 1, characters 20-22:
                         ^^
 Error: The constant "1l" has type "int32" but an expression was expected of type
          "nativeint"
-  Hint: Did you mean "1n"?
+Hint: Did you mean "1n"?
 |}]
 
 (* not implemented *)
@@ -153,7 +153,7 @@ Line 1, characters 23-28:
                            ^^^^^
 Error: The constant "1_000" has type "int" but an expression was expected of type
          "int64"
-  Hint: Did you mean "1_000L"?
+Hint: Did you mean "1_000L"?
 |}]
 let _ : nativeint * nativeint = 0n, 0xAA_BBL;;
 [%%expect{|
@@ -162,7 +162,7 @@ Line 1, characters 36-44:
                                         ^^^^^^^^
 Error: The constant "0xAA_BBL" has type "int64"
        but an expression was expected of type "nativeint"
-  Hint: Did you mean "0xAA_BBn"?
+Hint: Did you mean "0xAA_BBn"?
 |}]
 let _ : int32 -> int32 = function
   | 1l | 0o2_345 -> 3l
@@ -173,7 +173,7 @@ Line 2, characters 9-16:
              ^^^^^^^
 Error: This pattern matches values of type "int"
        but a pattern was expected which matches values of type "int32"
-  Hint: Did you mean "0o2_345l"?
+Hint: Did you mean "0o2_345l"?
 |}]
 let _ : int32 -> int32 = fun x -> match x with
   | 1l | 0b1000_1101 -> 3l
@@ -184,7 +184,7 @@ Line 2, characters 9-20:
              ^^^^^^^^^^^
 Error: This pattern matches values of type "int"
        but a pattern was expected which matches values of type "int32"
-  Hint: Did you mean "0b1000_1101l"?
+Hint: Did you mean "0b1000_1101l"?
 |}]
 type t1 = {f1: int32};; let _ = fun x -> x.f1 <- 1_000n;;
 [%%expect{|
@@ -194,5 +194,5 @@ Line 1, characters 49-55:
                                                      ^^^^^^
 Error: The constant "1_000n" has type "nativeint"
        but an expression was expected of type "int32"
-  Hint: Did you mean "1_000l"?
+Hint: Did you mean "1_000l"?
 |}]

testsuite/tests/typing-core-bugs/type_expected_explanation.ml

@@ -168,7 +168,7 @@ Line 3, characters 22-26:
 3 |   else if x > y then [y;x]
                           ^^^^
 Error: This variant expression is expected to have type "unit"
-         because it is in the result of a conditional with no else branch
+       because it is in the result of a conditional with no else branch
        There is no constructor "::" within type "unit"
 |}];;
 
@@ -192,6 +192,6 @@ Line 1, characters 35-39:
 1 | if false then (match () with () -> true);;
                                        ^^^^
 Error: This variant expression is expected to have type "unit"
-         because it is in the result of a conditional with no else branch
+       because it is in the result of a conditional with no else branch
        There is no constructor "true" within type "unit"
 |}]

testsuite/tests/typing-extensions/iarray.ml

@@ -58,7 +58,7 @@ Line 3, characters 4-5:
         ^
 Error: This pattern matches values of type "int"
        but a pattern was expected which matches values of type "float"
-  Hint: Did you mean "1."?
+Hint: Did you mean "1."?
 |}];;
 
 match marray with

testsuite/tests/typing-gadts/syntactic-arity.ml

@@ -33,8 +33,7 @@ Line 1, characters 14-21:
                   ^^^^^^^
 Error: This expression has type "'a -> 'b"
        but an expression was expected of type "string"
-  Hint: This function application is partial, maybe some arguments
-  are missing.
+Hint: This function application is partial, maybe some arguments are missing.
 |}];;
 
 (* And the fully polymorphic definition is rejected. *)