wip coerce polyvariant to variant

Author: zth

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 (constructors); type_attributes}) -> 
+        (match Variant_coercion.can_coerce_polyvariant_to_variant ~row_fields ~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 
       -> 

jscomp/ml/variant_coercion.ml

@@ -151,3 +151,48 @@ 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 ~constructors ~type_attributes
+    =
+  let polyvariant_runtime_representations =
+    row_fields
+    |> List.filter_map (fun (label, (field : Types.row_field)) ->
+            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 ->
+          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 (Untagged StringType) when is_unboxed ->
+                    (* An unboxed variant that has a catch all case will match _any_ string, so it matches anything here. *)
+                    true
+                  | 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. *)
+                    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

jscomp/test/VariantCoercion.js

@@ -92,3 +92,23 @@ 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)
+}