Fix detection of immediate64 types through unboxed types

typing/typedecl.ml

@@ -134,14 +134,9 @@ let update_type temp_env env id loc =
       with Ctype.Unify err ->
         raise (Error(loc, Type_clash (env, err)))
 
-let get_unboxed_type_representation env ty =
-  match Typedecl_unboxed.get_unboxed_type_representation env ty with
-  | Typedecl_unboxed.This x -> Some x
-  | _ -> None
-
 (* Determine if a type's values are represented by floats at run-time. *)
 let is_float env ty =
-  match get_unboxed_type_representation env ty with
+  match Typedecl_unboxed.get_unboxed_type_representation env ty with
     Some ty' ->
       begin match get_desc ty' with
         Tconstr(p, _, _) -> Path.same p Predef.path_float

typing/typedecl.mli

@@ -58,10 +58,6 @@ val check_coherence:
 (* for fixed types *)
 val is_fixed_type : Parsetree.type_declaration -> bool
 
-(* for typeopt.ml *)
-val get_unboxed_type_representation:
-    Env.t -> type_expr -> type_expr option
-
 type native_repr_kind = Unboxed | Untagged
 
 type error =

typing/typedecl_immediacy.ml

@@ -26,12 +26,8 @@ let compute_decl env tdecl =
                    Variant_unboxed)
     | Type_record ([{ld_type = arg; _}], Record_unboxed _)), _ ->
     begin match Typedecl_unboxed.get_unboxed_type_representation env arg with
-    | Typedecl_unboxed.Unavailable -> Type_immediacy.Unknown
-    | Typedecl_unboxed.This argrepr -> Ctype.immediacy env argrepr
-    | Typedecl_unboxed.Only_on_64_bits argrepr ->
-        match Ctype.immediacy env argrepr with
-        | Type_immediacy.Always -> Type_immediacy.Always_on_64bits
-        | Type_immediacy.Always_on_64bits | Type_immediacy.Unknown as x -> x
+    | None -> Type_immediacy.Unknown
+    | Some argrepr -> Ctype.immediacy env argrepr
     end
   | (Type_variant (_ :: _ as cstrs, _), _) ->
     if not (List.exists (fun c -> c.Types.cd_args <> Types.Cstr_tuple []) cstrs)

typing/typedecl_unboxed.ml

@@ -16,24 +16,15 @@
 
 open Types
 
-type t =
-  | Unavailable
-  | This of type_expr
-  | Only_on_64_bits of type_expr
-
 (* We use the Ctype.expand_head_opt version of expand_head to get access
    to the manifest type of private abbreviations. *)
 let rec get_unboxed_type_representation env ty fuel =
-  if fuel < 0 then Unavailable else
+  if fuel < 0 then None else
   let ty = Ctype.expand_head_opt env ty in
   match get_desc ty with
   | Tconstr (p, args, _) ->
     begin match Env.find_type p env with
-    | exception Not_found -> This ty
-    | {type_immediate = Always; _} ->
-        This Predef.type_int
-    | {type_immediate = Always_on_64bits; _} ->
-        Only_on_64_bits Predef.type_int
+    | exception Not_found -> Some ty
     | {type_params; type_kind =
          Type_record ([{ld_type = ty2; _}], Record_unboxed _)
        | Type_variant ([{cd_args = Cstr_tuple [ty2]; _}], Variant_unboxed)
@@ -43,9 +34,9 @@ let rec get_unboxed_type_representation env ty fuel =
         let ty2 = match get_desc ty2 with Tpoly (t, _) -> t | _ -> ty2 in
         get_unboxed_type_representation env
           (Ctype.apply env type_params ty2 args) (fuel - 1)
-    | _ -> This ty
+    | _ -> Some ty
     end
-  | _ -> This ty
+  | _ -> Some ty
 
 let get_unboxed_type_representation env ty =
   (* Do not give too much fuel: PR#7424 *)

typing/typedecl_unboxed.mli

@@ -16,10 +16,5 @@
 
 open Types
 
-type t =
-  | Unavailable
-  | This of type_expr
-  | Only_on_64_bits of type_expr
-
 (* for typeopt.ml *)
-val get_unboxed_type_representation: Env.t -> type_expr -> t
+val get_unboxed_type_representation: Env.t -> type_expr -> type_expr option

typing/typeopt.ml

@@ -27,10 +27,10 @@ let scrape_ty env ty =
   | Tconstr (p, _, _) ->
       begin match Env.find_type p env with
       | {type_kind = ( Type_variant (_, Variant_unboxed)
-                     | Type_record (_, Record_unboxed _) ); _} ->
-        begin match Typedecl.get_unboxed_type_representation env ty with
-        | None -> ty
-        | Some ty2 -> ty2
+                     | Type_record (_, Record_unboxed _) ); _} -> begin
+          match Typedecl_unboxed.get_unboxed_type_representation env ty with
+          | None -> ty
+          | Some ty2 -> ty2
         end
       | _ -> ty
       | exception Not_found -> ty