From ad170e9ecd611a5175fe202eee6337a438d6564f Mon Sep 17 00:00:00 2001
From: Richard Eisenberg <reisenberg@janestreet.com>
Date: Wed, 11 Dec 2024 15:51:23 -0500
Subject: [PATCH] Avoid propagating [all_void]

---
 typing/jkind.ml    | 22 +++++++++++++++-------
 typing/jkind.mli   |  6 ++----
 typing/typedecl.ml | 12 ++++++------
 3 files changed, 23 insertions(+), 17 deletions(-)

diff --git a/typing/jkind.ml b/typing/jkind.ml
index 2ae521ed5ea..71bceaa2d43 100644
--- a/typing/jkind.ml
+++ b/typing/jkind.ml
@@ -1459,6 +1459,11 @@ let has_mutable_label lbls =
       match lbl.ld_mutable with Immutable -> false | Mutable _ -> true)
     lbls
 
+let all_void_labels lbls =
+  List.for_all
+    (fun (lbl : Types.label_declaration) -> Sort.Const.(equal void lbl.ld_sort))
+    lbls
+
 let add_labels_as_baggage lbls jkind =
   List.fold_right
     (fun (lbl : Types.label_declaration) -> add_baggage ~baggage:lbl.ld_type)
@@ -1466,10 +1471,7 @@ let add_labels_as_baggage lbls jkind =
 
 (* CR layouts v2.8: This should take modalities into account. *)
 let for_boxed_record lbls =
-  if List.for_all
-       (fun (lbl : Types.label_declaration) ->
-         Sort.Const.(equal void lbl.ld_sort))
-       lbls
+  if all_void_labels lbls
   then Builtin.immediate ~why:Empty_record
   else
     let is_mutable = has_mutable_label lbls in
@@ -1480,11 +1482,17 @@ let for_boxed_record lbls =
     add_labels_as_baggage lbls base
 
 (* CR layouts v2.8: This should take modalities into account. *)
-let for_boxed_variant ~all_voids cstrs =
-  if all_voids
+let for_boxed_variant cstrs =
+  let open Types in
+  if List.for_all
+       (fun cstr ->
+         match cstr.cd_args with
+         | Cstr_tuple args ->
+           List.for_all (fun arg -> Sort.Const.(equal void arg.ca_sort)) args
+         | Cstr_record lbls -> all_void_labels lbls)
+       cstrs
   then Builtin.immediate ~why:Enumeration
   else
-    let open Types in
     let is_mutable =
       List.exists
         (fun cstr ->
diff --git a/typing/jkind.mli b/typing/jkind.mli
index 58db7a3861a..c14daa5c60c 100644
--- a/typing/jkind.mli
+++ b/typing/jkind.mli
@@ -398,10 +398,8 @@ val of_type_decl_default :
 (** Choose an appropriate jkind for a boxed record type *)
 val for_boxed_record : Types.label_declaration list -> jkind_l
 
-(** Choose an appropriate jkind for a boxed variant type, given whether
-    all of the fields of all of its constructors are [void]. *)
-val for_boxed_variant :
-  all_voids:bool -> Types.constructor_declaration list -> jkind_l
+(** Choose an appropriate jkind for a boxed variant type. *)
+val for_boxed_variant : Types.constructor_declaration list -> jkind_l
 
 (** The jkind of an arrow type. *)
 val for_arrow : jkind_l
diff --git a/typing/typedecl.ml b/typing/typedecl.ml
index fcace1d3afc..5f1bc2643d9 100644
--- a/typing/typedecl.ml
+++ b/typing/typedecl.ml
@@ -1691,8 +1691,8 @@ let update_decl_jkind env dpath decl =
           assert false
       end
     | cstrs, Variant_boxed cstr_shapes ->
-      let (_,cstrs,all_voids) =
-        List.fold_left (fun (idx,cstrs,all_voids) cstr ->
+      let (_,cstrs) =
+        List.fold_left (fun (idx,cstrs) cstr ->
           let arg_sorts =
             match cstr_shapes.(idx) with
             | Constructor_uniform_value, arg_sorts -> arg_sorts
@@ -1701,7 +1701,7 @@ let update_decl_jkind env dpath decl =
                   "Typedecl.update_variant_kind doesn't expect mixed \
                    constructor as input"
           in
-          let cd_args, all_void, jkinds =
+          let cd_args, _all_void, jkinds =
             update_constructor_arguments_sorts env cstr.Types.cd_loc
               cstr.Types.cd_args (Some arg_sorts)
           in
@@ -1716,10 +1716,10 @@ let update_decl_jkind env dpath decl =
             | Constructor_mixed _ -> cstr_shapes.(idx) <- cstr_repr, arg_sorts
           in
           let cstr = { cstr with Types.cd_args } in
-          (idx+1,cstr::cstrs,all_voids && all_void)
-        ) (0,[],true) cstrs
+          (idx+1,cstr::cstrs)
+        ) (0,[]) cstrs
       in
-      let jkind = Jkind.for_boxed_variant ~all_voids cstrs in
+      let jkind = Jkind.for_boxed_variant cstrs in
       List.rev cstrs, rep, jkind
     | (([] | (_ :: _)), Variant_unboxed | _, Variant_extensible) ->
       assert false