OCaml 5: Backport flambda-backend#1960

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?
 |}]

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;

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 "@[<b 2>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

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