diff --git a/testsuite/tests/typing-layouts-float64/parsing.ml b/testsuite/tests/typing-layouts-float64/parsing.ml index 8397420403f..c192bb5b6da 100644 --- a/testsuite/tests/typing-layouts-float64/parsing.ml +++ b/testsuite/tests/typing-layouts-float64/parsing.ml @@ -255,9 +255,20 @@ Error: The type constructor float# expects 0 argument(s), (* Hint for #float *) type t = #float;; [%%expect {| -Line 1, characters 10-15: +Line 1, characters 9-15: 1 | type t = #float;; - ^^^^^ + ^^^^^^ +Error: float isn't a class type. Did you mean the unboxed type float#? +|}] + +(* Hint should not show up in this case *) +class type floot = object end +class type c = float +[%%expect {| +class type floot = object end +Line 2, characters 15-20: +2 | class type c = float + ^^^^^ Error: Unbound class type float -Hint: Did you mean float#? +Hint: Did you mean floot? |}] diff --git a/typing/env.ml b/typing/env.ml index dbf28ce9a9f..7a52e623fbe 100644 --- a/typing/env.ml +++ b/typing/env.ml @@ -3901,12 +3901,7 @@ let report_lookup_error _loc env ppf = function end | Unbound_cltype lid -> fprintf ppf "Unbound class type %a" !print_longident lid; - begin match lid with - | Lident "float" -> - Misc.did_you_mean ppf (fun () -> ["float#"]) - | Lident _ | Ldot _ | Lapply _ -> - spellcheck ppf extract_cltypes env lid - end; + spellcheck ppf extract_cltypes env lid | Unbound_instance_variable s -> fprintf ppf "Unbound instance variable %s" s; spellcheck_name ppf extract_instance_variables env s; diff --git a/typing/typetexp.ml b/typing/typetexp.ml index 1277f889e9a..e26f0644454 100644 --- a/typing/typetexp.ml +++ b/typing/typetexp.ml @@ -77,6 +77,7 @@ type error = | Non_sort of {vloc : sort_loc; typ : type_expr; err : Jkind.Violation.t} | Bad_jkind_annot of type_expr * Jkind.Violation.t + | Did_you_mean_unboxed of Longident.t exception Error of Location.t * Env.t * error exception Error_forward of Location.error @@ -730,8 +731,22 @@ and transl_type_aux env ~row_context ~aliased ~policy mode styp = ctyp (Ttyp_object (fields, o)) (newobj ty) | Ptyp_class(lid, stl) -> let (path, decl) = - let path, decl = Env.lookup_cltype ~loc:lid.loc lid.txt env in - (path, decl.clty_hash_type) + match Env.lookup_cltype ~loc:lid.loc lid.txt env with + | (path, decl) -> (path, decl.clty_hash_type) + (* Raise a different error if it matches the name of an unboxed type *) + | exception + (Env.Error (Lookup_error (_, _, Unbound_cltype _)) as exn) + -> + let unboxed_lid : Longident.t = + match lid.txt with + | Lident s -> Lident (s ^ "#") + | Ldot (l, s) -> Ldot (l, s ^ "#") + | Lapply _ -> fatal_error "Typetexp.transl_type" + in + match Env.find_type_by_name unboxed_lid env with + | exception Not_found -> raise exn + | (_ : _ * _) -> + raise (Error (styp.ptyp_loc, env, Did_you_mean_unboxed lid.txt)) in if List.length stl <> decl.type_arity then raise(Error(styp.ptyp_loc, env, @@ -1426,6 +1441,9 @@ let report_error env ppf = function fprintf ppf "@[Bad layout annotation:@ %a@]" (Jkind.Violation.report_with_offender ~offender:(fun ppf -> Printtyp.type_expr ppf ty)) violation + | Did_you_mean_unboxed lid -> + fprintf ppf "@[%a isn't a class type.@ \ + Did you mean the unboxed type %a#?@]" longident lid longident lid let () = Location.register_error_of_exn diff --git a/typing/typetexp.mli b/typing/typetexp.mli index 878b15b9feb..02b1d4ea588 100644 --- a/typing/typetexp.mli +++ b/typing/typetexp.mli @@ -119,6 +119,7 @@ type error = | Non_sort of {vloc : sort_loc; typ : type_expr; err : Jkind.Violation.t} | Bad_jkind_annot of type_expr * Jkind.Violation.t + | Did_you_mean_unboxed of Longident.t exception Error of Location.t * Env.t * error