Fix recursive untagged variant type checking

CHANGELOG.md

@@ -25,6 +25,10 @@
 
 - Deprecate JSON.Classify.classify. https://github.com/rescript-lang/rescript/pull/7315
 
+#### :bug: Bug fix
+
+- Fix recursive untagged variant type checking by delaying well-formedness checks until environment construction completes. [#7320](https://github.com/rescript-lang/rescript/pull/7320)
+
 # 12.0.0-alpha.9
 
 #### :boom: Breaking Change

compiler/ml/ast_untagged_variants.ml

@@ -377,8 +377,12 @@ let names_from_type_variant ?(is_untagged_def = false) ~env
   let blocks = Ext_array.reverse_of_list blocks in
   Some {consts; blocks}
 
-let check_well_formed ~env ~is_untagged_def
-    (cstrs : Types.constructor_declaration list) =
+type well_formedness_check = {
+  is_untagged_def: bool;
+  cstrs: Types.constructor_declaration list;
+}
+
+let check_well_formed ~env {is_untagged_def; cstrs} =
   ignore (names_from_type_variant ~env ~is_untagged_def cstrs)
 
 let has_undefined_literal attrs = process_tag_type attrs = Some Undefined

compiler/ml/typedecl.ml

@@ -293,7 +293,7 @@ let make_constructor env type_path type_params sargs sret_type =
    any type variable present in [ty].
 *)
 
-let transl_declaration ~type_record_as_object env sdecl id =
+let transl_declaration ~type_record_as_object ~untagged_wfc env sdecl id =
   (* Bind type parameters *)
   reset_type_variables ();
   Ctype.begin_def ();
@@ -529,7 +529,11 @@ let transl_declaration ~type_record_as_object env sdecl id =
       let is_untagged_def =
         Ast_untagged_variants.has_untagged sdecl.ptype_attributes
       in
-      Ast_untagged_variants.check_well_formed ~env ~is_untagged_def cstrs;
+      let well_formedness_check : Ast_untagged_variants.well_formedness_check =
+        {is_untagged_def; cstrs}
+      in
+      (* delay the check until the newenv is created to handle recursive types *)
+      untagged_wfc := well_formedness_check :: !untagged_wfc;
       (Ttype_variant tcstrs, Type_variant cstrs, sdecl)
     | Ptype_record lbls_ -> (
       let optional_labels =
@@ -1467,10 +1471,12 @@ let transl_type_decl env rec_flag sdecl_list =
     | Asttypes.Recursive | Asttypes.Nonrecursive -> (id, None)
   in
   let type_record_as_object = ref false in
+  let untagged_wfc = ref [] in
   let transl_declaration name_sdecl (id, slot) =
     current_slot := slot;
     Builtin_attributes.warning_scope name_sdecl.ptype_attributes (fun () ->
-        transl_declaration ~type_record_as_object temp_env name_sdecl id)
+        transl_declaration ~type_record_as_object ~untagged_wfc temp_env
+          name_sdecl id)
   in
   let tdecls =
     List.map2 transl_declaration sdecl_list (List.map id_slots id_list)
@@ -1528,6 +1534,9 @@ let transl_type_decl env rec_flag sdecl_list =
       | None -> ())
     sdecl_list tdecls;
   (* Check that constraints are enforced *)
+  List.iter
+    (fun check -> Ast_untagged_variants.check_well_formed ~env:newenv check)
+    !untagged_wfc;
   List.iter2 (check_constraints ~type_record_as_object newenv) sdecl_list decls;
   (* Name recursion *)
   let decls =

tests/tests/src/UntaggedVariants.mjs

@@ -600,6 +600,12 @@ let ObjectAndNull = {
   printLength: printLength
 };
 
+let RecursiveType = {
+  o: {
+    foo: "hello"
+  }
+};
+
 let $$Array;
 
 let i = 42;
@@ -653,5 +659,6 @@ export {
   OnlyOne,
   MergeCases,
   ObjectAndNull,
+  RecursiveType,
 }
 /* l2 Not a pure module */

tests/tests/src/UntaggedVariants.res

@@ -469,3 +469,10 @@ module ObjectAndNull = {
     | _ => ()
     }
 }
+
+module RecursiveType = {
+  type rec object2 = {foo: string}
+  @unboxed and tagged2 = Object(object2) | Fn(unit => object2)
+
+  let o = Object({foo: "hello"})
+}