diff --git a/src/ocaml/typing/datarepr.ml b/src/ocaml/typing/datarepr.ml index acfa9b486..30042568a 100644 --- a/src/ocaml/typing/datarepr.ml +++ b/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) diff --git a/src/ocaml/typing/types.ml b/src/ocaml/typing/types.ml index 311e23085..afc3b070e 100644 --- a/src/ocaml/typing/types.ml +++ b/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? *) diff --git a/src/ocaml/typing/typetexp.ml b/src/ocaml/typing/typetexp.ml index 7fc90ade1..5d3592158 100644 --- a/src/ocaml/typing/typetexp.ml +++ b/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; diff --git a/upstream/ocaml_flambda/base-rev.txt b/upstream/ocaml_flambda/base-rev.txt index 136c52803..3f28cfdba 100644 --- a/upstream/ocaml_flambda/base-rev.txt +++ b/upstream/ocaml_flambda/base-rev.txt @@ -1 +1 @@ -31a75865c155563d3d9f84cd4ec5bcaaffa2c81d +2314e9cbd6ae3e5c70fa08e95d49bb9dc27cc812 diff --git a/upstream/ocaml_flambda/typing/datarepr.ml b/upstream/ocaml_flambda/typing/datarepr.ml index acfa9b486..30042568a 100644 --- a/upstream/ocaml_flambda/typing/datarepr.ml +++ b/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) diff --git a/upstream/ocaml_flambda/typing/types.ml b/upstream/ocaml_flambda/typing/types.ml index 055c63c95..37975cc21 100644 --- a/upstream/ocaml_flambda/typing/types.ml +++ b/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? *) diff --git a/upstream/ocaml_flambda/typing/typetexp.ml b/upstream/ocaml_flambda/typing/typetexp.ml index eb6899669..586acf028 100644 --- a/upstream/ocaml_flambda/typing/typetexp.ml +++ b/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;