diff options
| author | Antal Spector-Zabusky <antal.b.sz@gmail.com> | 2021-04-27 18:04:52 -0400 |
|---|---|---|
| committer | Antal Spector-Zabusky <antal.b.sz@gmail.com> | 2021-05-06 20:46:34 -0400 |
| commit | 16564969f6b2d90d3e9e7d43eed69d33e32fa29d (patch) | |
| tree | 9cdce5e394d5685718ed23add8297e21a29babe3 /typing/printtyp.ml | |
| parent | bd030c0e12c9eb98c6653c7293fe6423bdd7bcb7 (diff) | |
| download | ocaml-16564969f6b2d90d3e9e7d43eed69d33e32fa29d.tar.gz | |
Change `Printtyp.trace_format` into a GADT and expose it
Diffstat (limited to 'typing/printtyp.ml')
| -rw-r--r-- | typing/printtyp.ml | 18 |
1 files changed, 10 insertions, 8 deletions
diff --git a/typing/printtyp.ml b/typing/printtyp.ml index 095541b85c..e6160794e7 100644 --- a/typing/printtyp.ml +++ b/typing/printtyp.ml @@ -2015,13 +2015,15 @@ let diff_printing_status { Errortrace.got=t1, t1'; expected=t2, t2'} = else Keep (* A record that's kept abstract for ease of future extensibility *) -type 'variety trace_format = { - incompatibility_phrase : string -} +type 'variety trace_format = + | Unification : Errortrace.unification trace_format + | Equality : Errortrace.comparison trace_format + | Moregen : Errortrace.comparison trace_format -let unification = { incompatibility_phrase = "is not compatible with type" } -let equality = { incompatibility_phrase = "is not equal to type" } -let moregen = { incompatibility_phrase = "is not compatible with type" } +let incompatibility_phrase (type variety) : variety trace_format -> string = function + | Unification -> "is not compatible with type" + | Equality -> "is not equal to type" + | Moregen -> "is not compatible with type" let printing_status = function | Errortrace.Diff d -> diff_printing_status d @@ -2291,7 +2293,7 @@ let error trace_format env tr txt1 ppf txt2 ty_expect_explanation = @]" head_error ty_expect_explanation - (trace false trace_format.incompatibility_phrase) tr + (trace false (incompatibility_phrase trace_format)) tr (explain mis); if env <> Env.empty then warn_on_missing_defs env ppf head; @@ -2343,7 +2345,7 @@ module Subtype = struct print_labels := true; raise exn - let filter_unification_trace = filter_trace unification + let filter_unification_trace = filter_trace Unification let rec filter_subtype_trace keep_last = function | [] -> [] |