From 627aa90e71671af015dbc2c2eb3bb59d7fb069bf Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Thu, 6 Mar 2025 13:25:07 +0100 Subject: [PATCH] Fix recursive untagged variant type checking Fixes https://github.com/rescript-lang/rescript/issues/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. --- CHANGELOG.md | 4 ++++ compiler/ml/ast_untagged_variants.ml | 8 ++++++-- compiler/ml/typedecl.ml | 15 ++++++++++++--- tests/tests/src/UntaggedVariants.mjs | 7 +++++++ tests/tests/src/UntaggedVariants.res | 7 +++++++ 5 files changed, 36 insertions(+), 5 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 6efb676a86..a5b3c14401 100644 --- a/CHANGELOG.md +++ b/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 diff --git a/compiler/ml/ast_untagged_variants.ml b/compiler/ml/ast_untagged_variants.ml index d5c8940a65..6966a7a10e 100644 --- a/compiler/ml/ast_untagged_variants.ml +++ b/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 diff --git a/compiler/ml/typedecl.ml b/compiler/ml/typedecl.ml index 902964f76b..f31ae8f7fd 100644 --- a/compiler/ml/typedecl.ml +++ b/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 = diff --git a/tests/tests/src/UntaggedVariants.mjs b/tests/tests/src/UntaggedVariants.mjs index 51da690507..eab12455bb 100644 --- a/tests/tests/src/UntaggedVariants.mjs +++ b/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 */ diff --git a/tests/tests/src/UntaggedVariants.res b/tests/tests/src/UntaggedVariants.res index 72644ce1c2..e35fec2afd 100644 --- a/tests/tests/src/UntaggedVariants.res +++ b/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"}) +}