diff --git a/jscomp/ml/printtyp.ml b/jscomp/ml/printtyp.ml index 41664610f1..46e420ecbd 100644 --- a/jscomp/ml/printtyp.ml +++ b/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 "@[%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@]" diff --git a/jscomp/ml/runtime_representation.ml b/jscomp/ml/runtime_representation.ml index 9eac9afd5f..326e9a7a18 100644 --- a/jscomp/ml/runtime_representation.ml +++ b/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} -> diff --git a/tst.res b/tst.res index 79c3639c60..43b9aac435 100644 --- a/tst.res +++ b/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)