Fix recursive untagged variant type checking

Fixes #7314

- Delay untagged variant well-formedness checks until after environment construction
- Collect all untagged variant checks during type declaration processing
- Perform checks once all recursive types are available in the environment
- Add test case for valid recursive untagged variant type definitions

This fixes issues where recursive references in untagged variants would fail validation due to premature checking before the full type environment was built.

Author: cristianoc

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"})
+}