fix discrepancy between the executables generated by

ocamlc.opt and ocamlc.byte (and between ocamlopt.opt and ocamlopt.byte)
(reported by Sebastien Hinderer)

10 files changed, 32 insertions, 19 deletions

diff --git a/typing/ctype.ml b/typing/ctype.ml
index a1ca91dad8..e06b6c005a 100644
--- a/typing/ctype.ml
+++ b/typing/ctype.ml
@@ -1100,7 +1100,7 @@ let new_declaration newtype manifest =
     type_loc = Location.none;
     type_attributes = [];
     type_immediate = false;
-    type_unboxed = { unboxed = false; default = false };
+    type_unboxed = unboxed_false_default_false;
   }
 
 let instance_constructor ?in_pattern cstr =
diff --git a/typing/datarepr.ml b/typing/datarepr.ml
index 178af39665..5c46ae156b 100644
--- a/typing/datarepr.ml
+++ b/typing/datarepr.ml
@@ -74,8 +74,8 @@ let constructor_args priv cd_args cd_res path rep =
       let type_params = TypeSet.elements arg_vars_set in
       let type_unboxed =
         match rep with
-        | Record_unboxed _ -> { unboxed = true; default = false }
-        | _ -> { unboxed = false; default = false }
+        | Record_unboxed _ -> unboxed_true_default_false
+        | _ -> unboxed_false_default_false
       in
       let tdecl =
         {
diff --git a/typing/predef.ml b/typing/predef.ml
index be90b46009..a16997f96e 100644
--- a/typing/predef.ml
+++ b/typing/predef.ml
@@ -125,7 +125,7 @@ let decl_abstr =
    type_newtype_level = None;
    type_attributes = [];
    type_immediate = false;
-   type_unboxed = { unboxed = false; default = false };
+   type_unboxed = unboxed_false_default_false;
   }
 
 let decl_abstr_imm = {decl_abstr with type_immediate = true}
diff --git a/typing/printtyp.ml b/typing/printtyp.ml
index d20ce1cf4a..a95c9f31e7 100644
--- a/typing/printtyp.ml
+++ b/typing/printtyp.ml
@@ -1163,7 +1163,7 @@ let dummy =
     type_newtype_level = None; type_loc = Location.none;
     type_attributes = [];
     type_immediate = false;
-    type_unboxed = { unboxed = false; default = false };
+    type_unboxed = unboxed_false_default_false;
   }
 
 let hide_rec_items = function
diff --git a/typing/typeclass.ml b/typing/typeclass.ml
index 587e2de16f..7f3b5b1ab6 100644
--- a/typing/typeclass.ml
+++ b/typing/typeclass.ml
@@ -1243,7 +1243,7 @@ let temp_abbrev loc env id arity =
        type_loc = loc;
        type_attributes = []; (* or keep attrs from the class decl? *)
        type_immediate = false;
-       type_unboxed = { unboxed = false; default = false };
+       type_unboxed = unboxed_false_default_false;
       }
       env
   in
@@ -1491,7 +1491,7 @@ let class_infos define_class kind
      type_loc = cl.pci_loc;
      type_attributes = []; (* or keep attrs from cl? *)
      type_immediate = false;
-     type_unboxed = { unboxed = false; default = false };
+     type_unboxed = unboxed_false_default_false;
     }
   in
   let (cl_params, cl_ty) =
@@ -1510,7 +1510,7 @@ let class_infos define_class kind
      type_loc = cl.pci_loc;
      type_attributes = []; (* or keep attrs from cl? *)
      type_immediate = false;
-     type_unboxed = { unboxed = false; default = false };
+     type_unboxed = unboxed_false_default_false;
     }
   in
   ((cl, id, clty, ty_id, cltydef, obj_id, obj_abbr, cl_id, cl_abbr, ci_params,
diff --git a/typing/typecore.ml b/typing/typecore.ml
index b529bc3439..91eebcb4a4 100644
--- a/typing/typecore.ml
+++ b/typing/typecore.ml
@@ -2913,7 +2913,7 @@ and type_expect_ ?in_function ?(recarg=Rejected) env sexp ty_expected =
         type_loc = loc;
         type_attributes = [];
         type_immediate = false;
-        type_unboxed = { unboxed = false; default = false };
+        type_unboxed = unboxed_false_default_false;
       }
       in
       Ident.set_current_time ty.level;
diff --git a/typing/typedecl.ml b/typing/typedecl.ml
index fb83286cdc..6e0f310827 100644
--- a/typing/typedecl.ml
+++ b/typing/typedecl.ml
@@ -71,10 +71,10 @@ let get_unboxed_from_attributes sdecl =
   let boxed = Builtin_attributes.has_boxed sdecl.ptype_attributes in
   match boxed, unboxed, !Clflags.unboxed_types with
   | true, true, _ -> raise (Error(sdecl.ptype_loc, Boxed_and_unboxed))
-  | true, false, _ -> { unboxed = false; default = false }
-  | false, true, _ -> { unboxed = true; default = false }
-  | false, false, false -> { unboxed = false; default = true }
-  | false, false, true -> { unboxed = true; default = true }
+  | true, false, _ -> unboxed_false_default_false
+  | false, true, _ -> unboxed_true_default_false
+  | false, false, false -> unboxed_false_default_true
+  | false, false, true -> unboxed_true_default_true
 
 (* Enter all declared types in the environment as abstract types *)
 
@@ -93,7 +93,7 @@ let enter_type env sdecl id =
       type_loc = sdecl.ptype_loc;
       type_attributes = sdecl.ptype_attributes;
       type_immediate = false;
-      type_unboxed = { unboxed = false; default = false };
+      type_unboxed = unboxed_false_default_false;
     }
   in
   Env.add_type ~check:true id decl env
@@ -349,7 +349,7 @@ let transl_declaration env sdecl id =
       | Ptype_record [{pld_mutable = Immutable; _}] ->
     raw_status
     | _ -> (* The type is not unboxable, mark it as boxed *)
-      { unboxed = false; default = false }
+      unboxed_false_default_false
   in
   let unbox = unboxed_status.unboxed in
   let (tkind, kind) =
@@ -1735,7 +1735,7 @@ let transl_with_constraint env id row_path orig_decl sdecl =
     if arity_ok && man <> None then
       orig_decl.type_kind, orig_decl.type_unboxed
     else
-      Type_abstract, {unboxed = false; default = false}
+      Type_abstract, unboxed_false_default_false
   in
   let decl =
     { type_params = params;
@@ -1796,7 +1796,7 @@ let abstract_type_decl arity =
       type_loc = Location.none;
       type_attributes = [];
       type_immediate = false;
-      type_unboxed = { unboxed = false; default = false };
+      type_unboxed = unboxed_false_default_false;
      } in
   Ctype.end_def();
   generalize_decl decl;
diff --git a/typing/typemod.ml b/typing/typemod.ml
index 9a6b45adaa..cda620b2e7 100644
--- a/typing/typemod.ml
+++ b/typing/typemod.ml
@@ -184,7 +184,7 @@ let merge_constraint initial_env loc sg constr =
             type_newtype_level = None;
             type_attributes = [];
             type_immediate = false;
-            type_unboxed = { unboxed = false; default = false };
+            type_unboxed = unboxed_false_default_false;
           }
         and id_row = Ident.create (s^"#row") in
         let initial_env =
diff --git a/typing/types.ml b/typing/types.ml
index dc14845930..0e85644f0e 100644
--- a/typing/types.ml
+++ b/typing/types.ml
@@ -193,6 +193,11 @@ and unboxed_status =
     default: bool; (* False if the unboxed field was set from an attribute. *)
   }
 
+let unboxed_false_default_false = {unboxed = false; default = false}
+let unboxed_false_default_true = {unboxed = false; default = true}
+let unboxed_true_default_false = {unboxed = true; default = false}
+let unboxed_true_default_true = {unboxed = true; default = true}
+
 type extension_constructor =
     { ext_type_path: Path.t;
       ext_type_params: type_expr list;
diff --git a/typing/types.mli b/typing/types.mli
index 71060b170a..2dc1481ee0 100644
--- a/typing/types.mli
+++ b/typing/types.mli
@@ -333,12 +333,20 @@ and constructor_arguments =
   | Cstr_tuple of type_expr list
   | Cstr_record of label_declaration list
 
-and unboxed_status =
+and unboxed_status = private
+  (* This type must be private in order to ensure perfect sharing of the
+     four possible values. Otherwise, ocamlc.byte and ocamlc.opt produce
+     different executables. *)
   {
     unboxed: bool;
     default: bool; (* True for unannotated unboxable types. *)
   }
 
+val unboxed_false_default_false : unboxed_status
+val unboxed_false_default_true : unboxed_status
+val unboxed_true_default_false : unboxed_status
+val unboxed_true_default_true : unboxed_status
+
 type extension_constructor =
     {
       ext_type_path: Path.t;