coerce elgible variants to float

Author: zth

jscomp/build_tests/super_errors/expected/variant_coercion_float.res.expected

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

jscomp/build_tests/super_errors/expected/variant_coercion_float_as.res.expected

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

jscomp/build_tests/super_errors/fixtures/variant_coercion_float.res

@@ -0,0 +1,5 @@
+type x = | @as(1.1) One(bool) | @as(2.2) Two
+
+let x = One(true)
+
+let y = (x :> float)

jscomp/build_tests/super_errors/fixtures/variant_coercion_float_as.res

@@ -0,0 +1,5 @@
+type x = | @as(1.1) One | Two
+
+let x = One
+
+let y = (x :> float)

jscomp/ml/ctype.ml

@@ -3967,6 +3967,14 @@ let rec subtype_rec env trace t1 t2 cstrs =
         else
           (trace, t1, t2, !univar_pairs)::cstrs
       | _ -> (trace, t1, t2, !univar_pairs)::cstrs)
+    | (Tconstr(_, [], _), Tconstr(p, [], _)) when Path.same p Predef.path_float -> (* type coercion for variants represented by floats *)
+      (match extract_concrete_typedecl env t1 with
+      | (_, _, {type_kind=Type_variant (constructors)}) ->
+        if Variant_coercion.can_coerce_to_float constructors then
+          cstrs
+        else
+          (trace, t1, t2, !univar_pairs)::cstrs
+      | _ -> (trace, t1, t2, !univar_pairs)::cstrs)
     | (Tconstr(_, [], _), Tconstr(_, [], _)) -> (* type coercion for records *)
       (match extract_concrete_typedecl env t1, extract_concrete_typedecl env t2 with
       | (_, _, {type_kind=Type_record (fields1, repr1)}), (_, _, {type_kind=Type_record (fields2, repr2)}) ->

jscomp/ml/variant_coercion.ml

@@ -1,5 +1,5 @@
 
-type variant_representation = String | Int | Other
+type variant_representation = String | Int | Float | Other
 
 let find_as_attribute_payload (attributes : Parsetree.attribute list) =
   attributes
@@ -23,6 +23,7 @@ let constructors_representations
          match (c.cd_args, c.cd_attributes |> find_as_attribute_payload) with
          | Cstr_tuple [], (Some (Pconst_string _) | None) -> String
          | Cstr_tuple [], Some (Pconst_integer _) -> Int
+         | Cstr_tuple [], Some (Pconst_float _) -> Float
          | _ -> Other)
 
 (* TODO: Improve error messages? Say why we can't coerce. *)
@@ -32,3 +33,6 @@ let can_coerce_to_string (constructors : Types.constructor_declaration list) =
 
 let can_coerce_to_int (constructors : Types.constructor_declaration list) =
   constructors |> constructors_representations |> List.for_all (( = ) Int)
+
+let can_coerce_to_float (constructors : Types.constructor_declaration list) =
+  constructors |> constructors_representations |> List.for_all (( = ) Float)

jscomp/test/VariantCoercion.res

@@ -9,3 +9,9 @@ type onlyInts = | @as(1) One1 | @as(2) Two2 | @as(3) Three3
 let i = One1
 
 let d = (i :> int)
+
+type onlyFloats = | @as(1.1) Onef | @as(2.2) Twof | @as(3.3) Threef
+
+let i = Onef
+
+let d = (i :> float)