Support coercing string to elgible untagged variants

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 are coercable to string and 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.res

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