broken poc of how one could leverage the runtime representation for e…

…rror messages

jscomp/ml/printtyp.ml

@@ -1523,6 +1523,22 @@ let report_subtyping_error ppf env tr1 txt1 tr2 =
     let tr1 = List.map prepare_expansion tr1
     and tr2 = List.map prepare_expansion tr2 in
     fprintf ppf "@[<v>%a" (trace true (tr2 = []) txt1) tr1;
+    (match tr1 with 
+    | [(t1, _); (_, t2)] ->
+      let a_runtime_representation = Runtime_representation.to_runtime_representation t2 env in
+      let b_runtime_representation = Runtime_representation.to_runtime_representation t1 env in
+      a_runtime_representation |> List.iter(
+        fun a_value -> 
+          b_runtime_representation |> List.iter(
+            fun b_value -> 
+              if Runtime_representation.runtime_values_match a_value b_value then (
+                ()
+              ) 
+              else Runtime_representation.explain_why_not_matching a_value b_value 
+                |> List.iter(fun s -> fprintf ppf "@ %s" s)
+          ))
+          | _ -> ()
+    );
     if tr2 = [] then fprintf ppf "@]" else
     let mis = mismatch tr2 in
     fprintf ppf "%a%t@]"

jscomp/ml/runtime_representation.ml

@@ -213,6 +213,14 @@ let rec to_runtime_representation (type_expr : Types.type_expr) (env : Env.t)
     |> List.concat
   | _ -> []
 
+let explain_why_not_matching (a : runtime_js_value) (b : runtime_js_value) = 
+  match (a, b) with
+  | StringLiteral {value = a_value}, StringLiteral {value = b_value} when a_value != b_value ->
+    [Printf.sprintf "The left hand is will be the string '%s' in runtime, and the right hand will be '%s'." b_value a_value]
+  | Any, _ -> ["We don't know what value left hand side would have at runtime."]
+  | _, Any -> ["We don't know what value right hand side would have at runtime."]
+  | _ -> []
+
 let runtime_values_match (a : runtime_js_value) (b : runtime_js_value) =
   match (a, b) with
   | StringLiteral {value = a_value}, StringLiteral {value = b_value} ->

tst.res

@@ -1,12 +1,6 @@
-type x = [#One | #Two]
+type one = OK
+type two = NOPE
 
-@tag("kind")
-type y = | @as("one") One({hello: [#hello]}) | @as(null) Two
+let one: one = OK
 
-let x: x = #One
-
-let xx = #One({"hello": "hi"})
-
-let y: y = One({hello: #hello})
-
-let z = (x :> y)
+let two = (one :> two)