diff --git a/CHANGELOG.md b/CHANGELOG.md index 189d7119b2..811f920637 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -12,6 +12,10 @@ # 12.0.0-alpha.2 (Unreleased) +#### :rocket: New Feature + +- Allow coercing polyvariants to variants when we can guarantee that the runtime representation matches. https://github.com/rescript-lang/rescript-compiler/pull/6981 + #### :nail_care: Polish - Improve formatting in the generated js code. https://github.com/rescript-lang/rescript-compiler/pull/6932 diff --git a/jscomp/build_tests/super_errors/expected/variant_coercion_open_polyvariant.res.expected b/jscomp/build_tests/super_errors/expected/variant_coercion_open_polyvariant.res.expected new file mode 100644 index 0000000000..09d50b5705 --- /dev/null +++ b/jscomp/build_tests/super_errors/expected/variant_coercion_open_polyvariant.res.expected @@ -0,0 +1,10 @@ + + We've found a bug for you! + /.../fixtures/variant_coercion_open_polyvariant.res:5:19-30 + + 3 │ let p = #One + 4 │ + 5 │ let v: variant = (p :> variant) + 6 │ + + Type [> #One] is not a subtype of variant \ No newline at end of file diff --git a/jscomp/build_tests/super_errors/expected/variant_coercion_polyvariant_mismatch_as_attribute.res.expected b/jscomp/build_tests/super_errors/expected/variant_coercion_polyvariant_mismatch_as_attribute.res.expected new file mode 100644 index 0000000000..1cb2f9c5ca --- /dev/null +++ b/jscomp/build_tests/super_errors/expected/variant_coercion_polyvariant_mismatch_as_attribute.res.expected @@ -0,0 +1,10 @@ + + We've found a bug for you! + /.../fixtures/variant_coercion_polyvariant_mismatch_as_attribute.res:7:19-30 + + 5 │ let p: poly = #One + 6 │ + 7 │ let v: variant = (p :> variant) + 8 │ + + Type poly = [#One | #Two] is not a subtype of variant \ No newline at end of file diff --git a/jscomp/build_tests/super_errors/expected/variant_coercion_polyvariant_mismatch_as_attribute2.res.expected b/jscomp/build_tests/super_errors/expected/variant_coercion_polyvariant_mismatch_as_attribute2.res.expected new file mode 100644 index 0000000000..08645d2909 --- /dev/null +++ b/jscomp/build_tests/super_errors/expected/variant_coercion_polyvariant_mismatch_as_attribute2.res.expected @@ -0,0 +1,10 @@ + + We've found a bug for you! + /.../fixtures/variant_coercion_polyvariant_mismatch_as_attribute2.res:7:19-30 + + 5 │ let p: poly = #One + 6 │ + 7 │ let v: variant = (p :> variant) + 8 │ + + Type poly = [#One | #Two] is not a subtype of variant \ No newline at end of file diff --git a/jscomp/build_tests/super_errors/expected/variant_coercion_polyvariant_unmatched_cases.res.expected b/jscomp/build_tests/super_errors/expected/variant_coercion_polyvariant_unmatched_cases.res.expected new file mode 100644 index 0000000000..945199bd84 --- /dev/null +++ b/jscomp/build_tests/super_errors/expected/variant_coercion_polyvariant_unmatched_cases.res.expected @@ -0,0 +1,10 @@ + + We've found a bug for you! + /.../fixtures/variant_coercion_polyvariant_unmatched_cases.res:7:19-30 + + 5 │ let p: poly = #One + 6 │ + 7 │ let v: variant = (p :> variant) + 8 │ + + Type poly = [#One | #Two] is not a subtype of variant \ No newline at end of file diff --git a/jscomp/build_tests/super_errors/expected/variant_coercion_polyvariant_with_payload.res.expected b/jscomp/build_tests/super_errors/expected/variant_coercion_polyvariant_with_payload.res.expected new file mode 100644 index 0000000000..27dba4e3f0 --- /dev/null +++ b/jscomp/build_tests/super_errors/expected/variant_coercion_polyvariant_with_payload.res.expected @@ -0,0 +1,10 @@ + + We've found a bug for you! + /.../fixtures/variant_coercion_polyvariant_with_payload.res:7:19-30 + + 5 │ let p: poly = #One + 6 │ + 7 │ let v: variant = (p :> variant) + 8 │ + + Type poly = [#One | #Two(string)] is not a subtype of variant \ No newline at end of file diff --git a/jscomp/build_tests/super_errors/fixtures/variant_coercion_open_polyvariant.res b/jscomp/build_tests/super_errors/fixtures/variant_coercion_open_polyvariant.res new file mode 100644 index 0000000000..572de278a1 --- /dev/null +++ b/jscomp/build_tests/super_errors/fixtures/variant_coercion_open_polyvariant.res @@ -0,0 +1,5 @@ +type variant = One | Two + +let p = #One + +let v: variant = (p :> variant) diff --git a/jscomp/build_tests/super_errors/fixtures/variant_coercion_polyvariant_mismatch_as_attribute.res b/jscomp/build_tests/super_errors/fixtures/variant_coercion_polyvariant_mismatch_as_attribute.res new file mode 100644 index 0000000000..11a48d12b2 --- /dev/null +++ b/jscomp/build_tests/super_errors/fixtures/variant_coercion_polyvariant_mismatch_as_attribute.res @@ -0,0 +1,7 @@ +type poly = [#One | #Two] + +type variant = One | @as("two") Two + +let p: poly = #One + +let v: variant = (p :> variant) diff --git a/jscomp/build_tests/super_errors/fixtures/variant_coercion_polyvariant_mismatch_as_attribute2.res b/jscomp/build_tests/super_errors/fixtures/variant_coercion_polyvariant_mismatch_as_attribute2.res new file mode 100644 index 0000000000..3d97a3a8cf --- /dev/null +++ b/jscomp/build_tests/super_errors/fixtures/variant_coercion_polyvariant_mismatch_as_attribute2.res @@ -0,0 +1,7 @@ +type poly = [#One | #Two] + +type variant = One | @as(2) Two + +let p: poly = #One + +let v: variant = (p :> variant) diff --git a/jscomp/build_tests/super_errors/fixtures/variant_coercion_polyvariant_unmatched_cases.res b/jscomp/build_tests/super_errors/fixtures/variant_coercion_polyvariant_unmatched_cases.res new file mode 100644 index 0000000000..0299777fb5 --- /dev/null +++ b/jscomp/build_tests/super_errors/fixtures/variant_coercion_polyvariant_unmatched_cases.res @@ -0,0 +1,7 @@ +type poly = [#One | #Two] + +type variant = One + +let p: poly = #One + +let v: variant = (p :> variant) diff --git a/jscomp/build_tests/super_errors/fixtures/variant_coercion_polyvariant_with_payload.res b/jscomp/build_tests/super_errors/fixtures/variant_coercion_polyvariant_with_payload.res new file mode 100644 index 0000000000..cfc9501a97 --- /dev/null +++ b/jscomp/build_tests/super_errors/fixtures/variant_coercion_polyvariant_with_payload.res @@ -0,0 +1,7 @@ +type poly = [#One | #Two(string)] + +type variant = One | Two + +let p: poly = #One + +let v: variant = (p :> variant) diff --git a/jscomp/ml/ctype.ml b/jscomp/ml/ctype.ml index 76257a14c9..950a1a598f 100644 --- a/jscomp/ml/ctype.ml +++ b/jscomp/ml/ctype.ml @@ -3701,6 +3701,14 @@ let rec subtype_rec env trace t1 t2 cstrs = with Exit -> (trace, t1, t2, !univar_pairs)::cstrs end + | (Tvariant {row_closed=true; row_fields}, Tconstr (_, [], _)) + when extract_concrete_typedecl_opt env t2 |> Variant_coercion.type_is_variant -> + (match extract_concrete_typedecl env t2 with + | (_, _, {type_kind=Type_variant variant_constructors; type_attributes}) -> + (match Variant_coercion.can_coerce_polyvariant_to_variant ~row_fields ~variant_constructors ~type_attributes with + | Ok _ -> cstrs + | Error _ -> (trace, t1, t2, !univar_pairs)::cstrs) + | _ -> (trace, t1, t2, !univar_pairs)::cstrs) | Tvariant v, _ when !variant_is_subtype env (row_repr v) t2 -> diff --git a/jscomp/ml/variant_coercion.ml b/jscomp/ml/variant_coercion.ml index 86f525ad2c..d05e932007 100644 --- a/jscomp/ml/variant_coercion.ml +++ b/jscomp/ml/variant_coercion.ml @@ -151,3 +151,55 @@ let variant_configuration_can_be_coerced_raises ~is_spread_context ~left_loc right_loc; error = TagName {left_tag; right_tag}; })) + +let can_coerce_polyvariant_to_variant ~row_fields ~variant_constructors ~type_attributes + = + let polyvariant_runtime_representations = + row_fields + |> List.filter_map (fun (label, (field : Types.row_field)) -> + (* Check that there's no payload in the polyvariant *) + match field with + | Rpresent None -> Some label + | _ -> None) + in + if List.length polyvariant_runtime_representations <> List.length row_fields + then + (* Error: At least one polyvariant constructor has a payload. Cannot have payloads. *) + Error `PolyvariantConstructorHasPayload + else + let is_unboxed = Ast_untagged_variants.has_untagged type_attributes in + if + List.for_all + (fun polyvariant_value -> + variant_constructors + |> List.exists (fun (c : Types.constructor_declaration) -> + let constructor_name = Ident.name c.cd_id in + match + Ast_untagged_variants.process_tag_type c.cd_attributes + with + | Some (String as_runtime_string) -> + (* `@as("")`, does the configured string match the polyvariant value? *) + as_runtime_string = polyvariant_value + | Some _ -> + (* Any other `@as` can't match since it's by definition not a string *) + false + | None -> + (* No `@as` means the runtime representation will be the constructor + name as a string. + + However, there's a special case with unboxed types where there's a + string catch-all case. In that case, any polyvariant will match, + since the catch-all case will match any string. *) + (match is_unboxed, c.cd_args with + | true, Cstr_tuple [{desc=Tconstr (p, _, _)}] -> + Path.same p Predef.path_string + | _ -> polyvariant_value = constructor_name) + )) + polyvariant_runtime_representations + then Ok () + else Error `Unknown + +let type_is_variant (typ: (Path.t * Path.t * Types.type_declaration) option) = + match typ with + | Some (_, _, {type_kind = Type_variant _; _}) -> true + | _ -> false \ No newline at end of file diff --git a/jscomp/test/VariantCoercion.js b/jscomp/test/VariantCoercion.js index 90e334d343..1cea8b731b 100644 --- a/jscomp/test/VariantCoercion.js +++ b/jscomp/test/VariantCoercion.js @@ -71,6 +71,17 @@ let CoerceFromBigintToVariant = { cc: 120n }; +let CoerceFromPolyvariantToVariant = { + simple: "One", + simpleP: "One", + withAs: "One", + withAsP: "One", + withMoreVariantConstructors: "One", + withMoreVariantConstructorsP: "One", + withUnboxedCatchAll: "One", + withUnboxedCatchAllP: "One" +}; + let a$2 = "Three"; let b = "Three"; @@ -95,4 +106,5 @@ exports.CoerceFromStringToVariant = CoerceFromStringToVariant; exports.CoerceFromIntToVariant = CoerceFromIntToVariant; exports.CoerceFromFloatToVariant = CoerceFromFloatToVariant; exports.CoerceFromBigintToVariant = CoerceFromBigintToVariant; +exports.CoerceFromPolyvariantToVariant = CoerceFromPolyvariantToVariant; /* No side effect */ diff --git a/jscomp/test/VariantCoercion.res b/jscomp/test/VariantCoercion.res index 5c31324efc..f8f0826f67 100644 --- a/jscomp/test/VariantCoercion.res +++ b/jscomp/test/VariantCoercion.res @@ -92,3 +92,31 @@ module CoerceFromBigintToVariant = { let c = 120n let cc: mixed = (c :> mixed) } + +module CoerceFromPolyvariantToVariant = { + type simple = [#One | #Two] + type simpleP = One | Two + + let simple: simple = #One + let simpleP = (simple :> simpleP) + + type withAs = [#One | #two] + type withAsP = One | @as("two") Two + + let withAs: withAs = #One + let withAsP = (withAs :> withAsP) + + type withMoreVariantConstructors = [#One | #two] + type withMoreVariantConstructorsP = One | @as("two") Two | Three + + let withMoreVariantConstructors: withMoreVariantConstructors = #One + let withMoreVariantConstructorsP = (withMoreVariantConstructors :> withMoreVariantConstructorsP) + + type withUnboxedCatchAll = [#One | #someOtherThing] + + @unboxed + type withUnboxedCatchAllP = One | @as("two") Two | Three | Other(string) + + let withUnboxedCatchAll: withUnboxedCatchAll = #One + let withUnboxedCatchAllP = (withUnboxedCatchAll :> withUnboxedCatchAllP) +}