Allow coercing unboxed with payload to primitive when applicable (#6441)

* allow coercing unboxed with payload to primitive when applicable

* test

* changelog

* tests

* refactor

Author: zth

CHANGELOG.md

@@ -12,6 +12,9 @@
 
 # 11.0.0-rc.5 (Unreleased)
 
+#### :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
+
 #### :bug: Bug Fix
 
 - Fix issue with dynamic import of module in nested expressions https://github.com/rescript-lang/rescript-compiler/pull/6431

jscomp/build_tests/super_errors/expected/variant_coercion_string_unboxed.res.expected

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

jscomp/build_tests/super_errors/fixtures/variant_coercion_string_unboxed.res

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

jscomp/ml/ctype.ml

@@ -3956,8 +3956,8 @@ let rec subtype_rec env trace t1 t2 cstrs =
         ->
       (* type coercion for variants to primitives *)
       (match Variant_coercion.can_try_coerce_variant_to_primitive (extract_concrete_typedecl env t1) with
-      | Some constructors -> 
-        if constructors |> Variant_coercion.can_coerce_variant ~path then
+      | Some (constructors, unboxed) -> 
+        if constructors |> Variant_coercion.variant_has_same_runtime_representation_as_target ~targetPath:path ~unboxed then
           cstrs
         else 
           (trace, t1, t2, !univar_pairs)::cstrs

jscomp/ml/variant_coercion.ml

@@ -6,28 +6,44 @@ let can_coerce_path (path : Path.t) =
   || Path.same path Predef.path_int
   || Path.same path Predef.path_float
 
-let can_coerce_variant ~(path : Path.t)
-    (constructors : Types.constructor_declaration list) =
-  constructors
-  |> List.for_all (fun (c : Types.constructor_declaration) ->
-         let args = c.cd_args in
-         let payload = Ast_untagged_variants.process_tag_type c.cd_attributes in
-         match args with
-         | Cstr_tuple [] -> (
-           match payload with
-           | None | Some (String _) -> Path.same path Predef.path_string
-           | Some (Int _) -> Path.same path Predef.path_int
-           | Some (Float _) -> Path.same path Predef.path_float
-           | Some (Null | Undefined | Bool _ | Untagged _) -> false)
-         | _ -> false)
+let check_paths_same p1 p2 target_path =
+  Path.same p1 target_path && Path.same p2 target_path
+
+(* 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) =
+  (* Helper function to check if a constructor has the same runtime representation as the target type *)
+  let has_same_runtime_representation (c : Types.constructor_declaration) =
+    let args = c.cd_args in
+    let asPayload = Ast_untagged_variants.process_tag_type c.cd_attributes in
+
+    match args with
+    | Cstr_tuple [{desc = Tconstr (p, [], _)}] when unboxed ->
+      let path_same = check_paths_same p targetPath in
+      (* unboxed String(string) :> string *)
+      path_same Predef.path_string
+      || (* unboxed Number(float) :> float *)
+      path_same Predef.path_float
+    | Cstr_tuple [] -> (
+      (* Check that @as payloads match with the target path to coerce to.
+           No @as means the default encoding, which is string *)
+      match asPayload with
+      | None | Some (String _) -> Path.same targetPath Predef.path_string
+      | Some (Int _) -> Path.same targetPath Predef.path_int
+      | Some (Float _) -> Path.same targetPath Predef.path_float
+      | Some (Null | Undefined | Bool _ | Untagged _) -> false)
+    | _ -> false
+  in
+
+  List.for_all has_same_runtime_representation constructors
 
 let can_try_coerce_variant_to_primitive
     ((_, p, typedecl) : Path.t * Path.t * Types.type_declaration) =
   match typedecl with
-  | {type_kind = Type_variant constructors; type_params = []}
+  | {type_kind = Type_variant constructors; type_params = []; type_attributes}
     when Path.name p <> "bool" ->
     (* bool is represented as a variant internally, so we need to account for that *)
-    Some constructors
+    Some (constructors, type_attributes |> Ast_untagged_variants.has_untagged)
   | _ -> None
 
 let variant_representation_matches (c1_attrs : Parsetree.attributes)

jscomp/test/VariantCoercion.js

@@ -30,3 +30,17 @@ module CoerceVariants = {
   let x: x = One({age: 1})
   let y: y = (x :> y)
 }
+
+module CoerceWithPayload = {
+  @unboxed type strings = String(string) | First | Second | Third
+  let a: strings = String("hello")
+  let aa: strings = First
+  let b: string = (a :> string)
+  let bb: string = (aa :> string)
+
+  @unboxed type floats = Number(float) | @as(1.) First | @as(2.) Second | @as(3.) Third
+  let c: floats = Number(100.)
+  let cc: floats = Second
+  let d: float = (c :> float)
+  let dd: float = (cc :> float)
+}