Merge 5.2.0minus 16 retag2

src/ocaml/typing/datarepr.ml

@@ -107,10 +107,10 @@ let constructor_args ~current_unit priv cd_args cd_res path rep =
 
 let constructor_descrs ~current_unit ty_path decl cstrs rep =
   let ty_res = newgenconstr ty_path decl.type_params in
-  let cstr_shapes_and_arg_jkinds =
+  let cstr_shapes_and_arg_jkinds, is_unboxed =
     match rep, cstrs with
     | Variant_extensible, _ -> assert false
-    | Variant_boxed x, _ -> x
+    | Variant_boxed x, _ -> x, false
     | Variant_unboxed, [{ cd_args }] ->
       (* CR layouts: It's tempting just to use [decl.type_jkind] here, instead
          of grabbing the jkind from the argument. However, doing so does not
@@ -124,7 +124,7 @@ let constructor_descrs ~current_unit ty_path decl cstrs rep =
       begin match cd_args with
       | Cstr_tuple [{ ca_sort = sort }]
       | Cstr_record [{ ld_sort = sort }] ->
-        [| Constructor_uniform_value, [| sort |] |]
+        [| Constructor_uniform_value, [| sort |] |], true
       | Cstr_tuple ([] | _ :: _) | Cstr_record ([] | _ :: _) ->
         Misc.fatal_error "Multiple arguments in [@@unboxed] variant"
       end
@@ -135,15 +135,19 @@ let constructor_descrs ~current_unit ty_path decl cstrs rep =
          users to write their own null constructors. *)
       (* CR layouts v3.3: generalize to [any]. *)
       [| Constructor_uniform_value, [| |]
-       ; Constructor_uniform_value, [| Jkind.Sort.Const.value |] |]
+       ; Constructor_uniform_value, [| Jkind.Sort.Const.value |] |],
+      false
   in
   let num_consts = ref 0 and num_nonconsts = ref 0 in
   let cstr_constant =
     Array.map
       (fun (_, sorts) ->
          let all_void = Array.for_all Jkind.Sort.Const.all_void sorts in
-         if all_void then incr num_consts else incr num_nonconsts;
-         all_void)
+         (* constant constructors are constructors of non-[@@unboxed] variants
+            with 0 bits of payload *)
+         let is_const = all_void && not is_unboxed in
+         if is_const then incr num_consts else incr num_nonconsts;
+         is_const)
       cstr_shapes_and_arg_jkinds
   in
   let describe_constructor (src_index, const_tag, nonconst_tag, acc)

src/ocaml/typing/types.ml

@@ -960,7 +960,10 @@ type constructor_description =
     cstr_tag: tag;                      (* Tag for heap blocks *)
     cstr_repr: variant_representation;  (* Repr of the outer variant *)
     cstr_shape: constructor_representation; (* Repr of the constructor itself *)
-    cstr_constant: bool;                (* True if all args are void *)
+    cstr_constant: bool;
+    (* True if it's the constructor of a non-[@@unboxed] variant with 0 bits of
+       payload. (Or equivalently, if it's represented as either a tagged int or
+       the null pointer) *)
     cstr_consts: int;                   (* Number of constant constructors *)
     cstr_nonconsts: int;                (* Number of non-const constructors *)
     cstr_generalized: bool;             (* Constrained return type? *)

src/ocaml/typing/typetexp.ml

@@ -1446,6 +1446,7 @@ let transl_type_scheme_poly env attrs loc vars inner_type =
       ~post:(fun (_,_,typ) -> generalize_ctyp typ)
   in
   let _ : _ list = TyVarEnv.instance_poly_univars env loc univars in
+  remove_mode_and_jkind_variables typ.ctyp_type;
   { ctyp_desc = Ttyp_poly (typed_vars, typ);
     ctyp_type = typ.ctyp_type;
     ctyp_env = env;

upstream/ocaml_flambda/base-rev.txt

@@ -1 +1 @@
-31a75865c155563d3d9f84cd4ec5bcaaffa2c81d
+2314e9cbd6ae3e5c70fa08e95d49bb9dc27cc812

upstream/ocaml_flambda/typing/datarepr.ml

@@ -107,10 +107,10 @@ let constructor_args ~current_unit priv cd_args cd_res path rep =
 
 let constructor_descrs ~current_unit ty_path decl cstrs rep =
   let ty_res = newgenconstr ty_path decl.type_params in
-  let cstr_shapes_and_arg_jkinds =
+  let cstr_shapes_and_arg_jkinds, is_unboxed =
     match rep, cstrs with
     | Variant_extensible, _ -> assert false
-    | Variant_boxed x, _ -> x
+    | Variant_boxed x, _ -> x, false
     | Variant_unboxed, [{ cd_args }] ->
       (* CR layouts: It's tempting just to use [decl.type_jkind] here, instead
          of grabbing the jkind from the argument. However, doing so does not
@@ -124,7 +124,7 @@ let constructor_descrs ~current_unit ty_path decl cstrs rep =
       begin match cd_args with
       | Cstr_tuple [{ ca_sort = sort }]
       | Cstr_record [{ ld_sort = sort }] ->
-        [| Constructor_uniform_value, [| sort |] |]
+        [| Constructor_uniform_value, [| sort |] |], true
       | Cstr_tuple ([] | _ :: _) | Cstr_record ([] | _ :: _) ->
         Misc.fatal_error "Multiple arguments in [@@unboxed] variant"
       end
@@ -135,15 +135,19 @@ let constructor_descrs ~current_unit ty_path decl cstrs rep =
          users to write their own null constructors. *)
       (* CR layouts v3.3: generalize to [any]. *)
       [| Constructor_uniform_value, [| |]
-       ; Constructor_uniform_value, [| Jkind.Sort.Const.value |] |]
+       ; Constructor_uniform_value, [| Jkind.Sort.Const.value |] |],
+      false
   in
   let num_consts = ref 0 and num_nonconsts = ref 0 in
   let cstr_constant =
     Array.map
       (fun (_, sorts) ->
          let all_void = Array.for_all Jkind.Sort.Const.all_void sorts in
-         if all_void then incr num_consts else incr num_nonconsts;
-         all_void)
+         (* constant constructors are constructors of non-[@@unboxed] variants
+            with 0 bits of payload *)
+         let is_const = all_void && not is_unboxed in
+         if is_const then incr num_consts else incr num_nonconsts;
+         is_const)
       cstr_shapes_and_arg_jkinds
   in
   let describe_constructor (src_index, const_tag, nonconst_tag, acc)

upstream/ocaml_flambda/typing/types.ml

@@ -953,7 +953,10 @@ type constructor_description =
     cstr_tag: tag;                      (* Tag for heap blocks *)
     cstr_repr: variant_representation;  (* Repr of the outer variant *)
     cstr_shape: constructor_representation; (* Repr of the constructor itself *)
-    cstr_constant: bool;                (* True if all args are void *)
+    cstr_constant: bool;
+    (* True if it's the constructor of a non-[@@unboxed] variant with 0 bits of
+       payload. (Or equivalently, if it's represented as either a tagged int or
+       the null pointer) *)
     cstr_consts: int;                   (* Number of constant constructors *)
     cstr_nonconsts: int;                (* Number of non-const constructors *)
     cstr_generalized: bool;             (* Constrained return type? *)

upstream/ocaml_flambda/typing/typetexp.ml

@@ -1432,6 +1432,7 @@ let transl_type_scheme_poly env attrs loc vars inner_type =
     ~post:(fun (_,_,typ) -> generalize_ctyp typ)
   in
   let _ : _ list = TyVarEnv.instance_poly_univars env loc univars in
+  remove_mode_and_jkind_variables typ.ctyp_type;
   { ctyp_desc = Ttyp_poly (typed_vars, typ);
     ctyp_type = typ.ctyp_type;
     ctyp_env = env;