Support coercing string to elgible untagged variants (#6443)

* support coercing string to elgible untagged variants

* changelog

* fix

* all constructors in variant does not need to be coercable to string as long as there is a catch all case

* adapt changelog to changed constraints

Author: zth

CHANGELOG.md

@@ -14,6 +14,7 @@
 
 #### :rocket: New Feature
 - Allow coercing unboxed variants with only strings (now including with a single payload of string) to the primitive string. https://github.com/rescript-lang/rescript-compiler/pull/6441
+- Allow coercing strings to unboxed variants that has a catch-all unboxed string case. https://github.com/rescript-lang/rescript-compiler/pull/6443
 
 #### :bug: Bug Fix
 

jscomp/build_tests/super_errors/expected/variant_coercion_string_to_variant_no_payload.res.expected

@@ -0,0 +1,10 @@
+
+  We've found a bug for you!
+  /.../fixtures/variant_coercion_string_to_variant_no_payload.res:6:10-15
+
+  4 │ let x = "one"
+  5 │ 
+  6 │ let y = (x :> x)
+  7 │ 
+
+  Type string is not a subtype of x

jscomp/build_tests/super_errors/fixtures/variant_coercion_string_to_variant_no_payload.res

@@ -0,0 +1,6 @@
+@unboxed
+type x = One | Two
+
+let x = "one"
+
+let y = (x :> x)

jscomp/ml/ctype.ml

@@ -3951,6 +3951,19 @@ let rec subtype_rec env trace t1 t2 cstrs =
         end
     | (Tconstr(p1, _, _), _) when generic_private_abbrev env p1 ->
         subtype_rec env trace (expand_abbrev_opt env t1) t2 cstrs
+    | (Tconstr(path, [], _), Tconstr(_, [], _)) when Path.same path Predef.path_string && 
+        extract_concrete_typedecl env t2 |> Variant_coercion.can_try_coerce_variant_to_primitive |> Option.is_some
+        ->
+      (* type coercion for strings to elgible unboxed variants:
+         - must be unboxed
+         - must have a constructor case with a string 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
+          cstrs
+        else 
+          (trace, t1, t2, !univar_pairs)::cstrs
+      | _ -> (trace, t1, t2, !univar_pairs)::cstrs)
     | (Tconstr(_, [], _), Tconstr(path, [], _)) when Variant_coercion.can_coerce_path path && 
         extract_concrete_typedecl env t1 |> Variant_coercion.can_try_coerce_variant_to_primitive |> Option.is_some
         ->

jscomp/ml/variant_coercion.ml

@@ -9,6 +9,17 @@ let can_coerce_path (path : Path.t) =
 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 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
+    | _ -> false
+  in
+
+  constructors |> List.exists has_catch_all_string_case 
+
 (* 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

@@ -44,3 +44,15 @@ module CoerceWithPayload = {
   let d: float = (c :> float)
   let dd: float = (cc :> float)
 }
+
+module CoerceFromStringToVariant = {
+  @unboxed type strings = String(string) | First | Second | Third
+  let a = "hello"
+  let aa = "First"
+  let b: strings = (a :> strings)
+  let bb: strings = (aa :> strings)
+
+  @unboxed type mixed = String(string) | @as(1) One | @as(null) Null | Two
+  let c = "Hi"
+  let cc: mixed = (c :> mixed)
+}