Merge pull request ocaml#13813 from Octachron/tune_spellchecker_hint

ocaml#13788: spellchecking hint, keep module context

Author: Octachron

Changes

@@ -306,6 +306,11 @@ Working version
   references another recursive module type.
   (Stefan Muenzel, review by Florian Angeletti and Gabriel Scherer)
 
+- #13788, #13813: Keep the module context in spellchecking hints.
+  `Fun.protact` now prompts `Did you mean "Fun.protect?"` rather than
+  `Did you mean "protect?"`.
+  (Florian Angeletti, suggestion by Daniel Bünzli, review by Gabriel Scherer)
+
 - #13809: Distinguish `(module M : S)` and `(module M) : (module S)` and
   change locations of error messages when `S` is ill-typed in `(module S)`
   (Samuel Vivien, review by Florian Angeletti and Gabriel Scherer)

testsuite/tests/messages/spellcheck.ml

@@ -22,7 +22,7 @@ Line 1, characters 8-19:
 1 | let _ = Fun.pratect
             ^^^^^^^^^^^
 Error: Unbound value "Fun.pratect"
-Hint: Did you mean "protect"?
+Hint: Did you mean "Fun.protect"?
 |}];;
 
 type 'a t = 'a aray
@@ -40,7 +40,7 @@ Line 1, characters 11-22:
 1 | module _ = Stdlib.Aray
                ^^^^^^^^^^^
 Error: Unbound module "Stdlib.Aray"
-Hint: Did you mean "Array"?
+Hint: Did you mean "Stdlib.Array"?
 |}];;
 
 let x = Same 42
@@ -213,3 +213,18 @@ Line 3, characters 18-35:
 Error: Unbound instance variable "foobaz"
 Hint: Did you mean "foobar"?
 |}];;
+
+let closely = ()
+module M = struct
+  let close = ()
+end
+let () = M.closer
+[%%expect {|
+val closely : unit = ()
+module M : sig val close : unit end
+Line 5, characters 9-17:
+5 | let () = M.closer
+             ^^^^^^^^
+Error: Unbound value "M.closer"
+Hint: Did you mean "M.close"?
+|}]

typing/env.ml

@@ -3536,14 +3536,20 @@ open Format_doc
 let print_path: Path.t printer ref = ref (fun _ _ -> assert false)
 let pp_path ppf l = !print_path ppf l
 
+module Style = Misc.Style
+
+let quoted_longident = Style.as_inline_code Pprintast.Doc.longident
+let quoted_constr = Style.as_inline_code Pprintast.Doc.constr
+
 let spellcheck ppf extract env lid =
   let choices ~path name = Misc.spellcheck (extract path env) name in
   match lid with
     | Longident.Lapply _ -> ()
     | Longident.Lident s ->
        Misc.did_you_mean ppf (fun () -> choices ~path:None s)
     | Longident.Ldot (r, s) ->
-       Misc.did_you_mean ppf (fun () -> choices ~path:(Some r) s)
+       let pp ppf s = quoted_longident ppf (Longident.Ldot(r,s)) in
+       Misc.did_you_mean ~pp ppf (fun () -> choices ~path:(Some r) s)
 
 let spellcheck_name ppf extract env name =
   Misc.did_you_mean ppf
@@ -3572,11 +3578,6 @@ let extract_instance_variables env =
        | Val_ivar _ -> name :: acc
        | _ -> acc) None env []
 
-module Style = Misc.Style
-
-let quoted_longident = Style.as_inline_code Pprintast.Doc.longident
-let quoted_constr = Style.as_inline_code Pprintast.Doc.constr
-
 let report_lookup_error_doc _loc env ppf = function
   | Unbound_value(lid, hint) -> begin
       fprintf ppf "Unbound value %a" quoted_longident lid;

typing/typetexp.ml

@@ -876,7 +876,7 @@ let report_error_doc env ppf = function
   | Unbound_type_variable (name, in_scope_names) ->
     fprintf ppf "The type variable %a is unbound in this type declaration.@ %a"
       Style.inline_code name
-      did_you_mean (fun () -> Misc.spellcheck in_scope_names name )
+      (did_you_mean ?pp:None) (fun () -> Misc.spellcheck in_scope_names name )
   | No_type_wildcards ->
       fprintf ppf "A type wildcard %a is not allowed in this type declaration."
         Style.inline_code "_"

utils/misc.ml

@@ -1014,7 +1014,7 @@ let spellcheck env name =
   fst (List.fold_left (compare name) ([], max_int) env)
 
 
-let did_you_mean ppf get_choices =
+let did_you_mean ?(pp=Style.inline_code) ppf get_choices =
   let open Format_doc in
   (* flush now to get the error report early, in the (unheard of) case
      where the search in the get_choices function would take a bit of
@@ -1026,9 +1026,9 @@ let did_you_mean ppf get_choices =
   | choices ->
     let rest, last = split_last choices in
      fprintf ppf "@\n@[@{<hint>Hint@}: Did you mean %a%s%a?@]"
-       (pp_print_list ~pp_sep:comma Style.inline_code) rest
+       (pp_print_list ~pp_sep:comma pp) rest
        (if rest = [] then "" else " or ")
-       Style.inline_code last
+       pp last
 
 module Error_style = struct
   type setting =

utils/misc.mli

@@ -450,7 +450,8 @@ val spellcheck : string list -> string -> string list
     [name] that it may be a typo for one of them. *)
 
 val did_you_mean :
-    Format_doc.formatter -> (unit -> string list) -> unit
+    ?pp:string Format_doc.printer -> Format_doc.formatter ->
+    (unit -> string list) -> unit
 (** [did_you_mean ppf get_choices] hints that the user may have meant
     one of the option returned by calling [get_choices]. It does nothing
     if the returned list is empty.