Coercing int and float unboxed variant catch all cases (#6540)

* allow coercing int and float in addition to strings with unboxed variants with catch all cases

* changelog

Author: zth

CHANGELOG.md

@@ -15,6 +15,7 @@
 #### :rocket: New Feature
 
 - GenType: support `@deriving(accessors)` outputs. https://github.com/rescript-lang/rescript-compiler/pull/6537
+- Allow coercing ints and floats to unboxed variants that have a catch-all unboxed int or float case. https://github.com/rescript-lang/rescript-compiler/pull/6540
 
 # 11.0.0-rc.8
 

jscomp/ml/ctype.ml

@@ -3959,20 +3959,20 @@ let rec subtype_rec env trace t1 t2 cstrs =
         subtype_rec env trace (expand_abbrev_opt env t1) t2 cstrs
     | (Tconstr(p1, [], _), Tconstr(p2, [], _)) when Path.same p1 Predef.path_int && Path.same p2 Predef.path_float ->
         cstrs 
-    | (Tconstr(path, [], _), Tconstr(_, [], _)) when Path.same path Predef.path_string && 
+    | (Tconstr(path, [], _), Tconstr(_, [], _)) when Variant_coercion.can_coerce_primitive path && 
         extract_concrete_typedecl env t2 |> Variant_coercion.can_try_coerce_variant_to_primitive |> Option.is_some
         ->
-      (* type coercion for strings to elgible unboxed variants:
+      (* type coercion for primitives (int/float/string) to elgible unboxed variants:
          - must be unboxed
-         - must have a constructor case with a string payload *)
+         - must have a constructor case with a supported and matching primitive payload *)
       (match Variant_coercion.can_try_coerce_variant_to_primitive (extract_concrete_typedecl env t2) with
       | Some (constructors, true) -> 
-        if constructors |> Variant_coercion.variant_has_catch_all_string_case then
+        if Variant_coercion.variant_has_catch_all_case constructors (fun p -> Path.same p path) then
           cstrs
         else 
           (trace, t1, t2, !univar_pairs)::cstrs
       | _ -> (trace, t1, t2, !univar_pairs)::cstrs)
-    | (Tconstr(_, [], _), Tconstr(path, [], _)) when Variant_coercion.can_coerce_path path && 
+    | (Tconstr(_, [], _), Tconstr(path, [], _)) when Variant_coercion.can_coerce_primitive path && 
         extract_concrete_typedecl env t1 |> Variant_coercion.can_try_coerce_variant_to_primitive |> Option.is_some
         ->
       (* type coercion for variants to primitives *)

jscomp/ml/variant_coercion.ml

@@ -1,25 +1,28 @@
 (* TODO: Improve error messages? Say why we can't coerce. *)
 
 (* Right now we only allow coercing to primitives string/int/float *)
-let can_coerce_path (path : Path.t) =
+let can_coerce_primitive (path : Path.t) =
   Path.same path Predef.path_string
   || Path.same path Predef.path_int
   || Path.same path Predef.path_float
 
 let check_paths_same p1 p2 target_path =
   Path.same p1 target_path && Path.same p2 target_path
 
-let variant_has_catch_all_string_case (constructors : Types.constructor_declaration list) =
+let variant_has_catch_all_case (constructors : Types.constructor_declaration list) path_is_same =
   let has_catch_all_string_case (c : Types.constructor_declaration) =
     let args = c.cd_args in
     match args with
     | Cstr_tuple [{desc = Tconstr (p, [], _)}] ->
-      Path.same p Predef.path_string
+      path_is_same p
     | _ -> false
   in
 
   constructors |> List.exists has_catch_all_string_case 
 
+let variant_has_relevant_primitive_catch_all (constructors : Types.constructor_declaration list) = 
+  variant_has_catch_all_case constructors can_coerce_primitive
+
 (* Checks if every case of the variant has the same runtime representation as the target type. *)
 let variant_has_same_runtime_representation_as_target ~(targetPath : Path.t)
     ~unboxed (constructors : Types.constructor_declaration list) =

jscomp/test/VariantCoercion.js

@@ -56,3 +56,27 @@ module CoerceFromStringToVariant = {
   let c = "Hi"
   let cc: mixed = (c :> mixed)
 }
+
+module CoerceFromIntToVariant = {
+  @unboxed type ints = Int(int) | @as(1) First | @as(2) Second | @as(3) Third
+  let a = 100
+  let aa = 1
+  let b: ints = (a :> ints)
+  let bb: ints = (aa :> ints)
+
+  @unboxed type mixed = Int(int) | @as(1) One | @as(null) Null | Two
+  let c = 120
+  let cc: mixed = (c :> mixed)
+}
+
+module CoerceFromFloatToVariant = {
+  @unboxed type floats = Float(float) | @as(1.) First | @as(2.) Second | @as(3.) Third
+  let a = 100.
+  let aa = 1.
+  let b: floats = (a :> floats)
+  let bb: floats = (aa :> floats)
+
+  @unboxed type mixed = Float(float) | @as(1.) One | @as(null) Null | Two
+  let c = 120.
+  let cc: mixed = (c :> mixed)
+}