diff options
| author | Antal Spector-Zabusky <antal.b.sz@gmail.com> | 2021-06-17 01:26:39 -0400 |
|---|---|---|
| committer | Antal Spector-Zabusky <antal.b.sz@gmail.com> | 2021-06-21 14:43:37 -0400 |
| commit | 2d62e825cac245f44caef75fc6c2ed2875a766b3 (patch) | |
| tree | ddd5306d8da21c6ebcb40239b9e5a11a79776076 /typing/printtyp.ml | |
| parent | 4aacb71cb21bf27fe76ae66cf067c4c2cd576860 (diff) | |
| download | ocaml-2d62e825cac245f44caef75fc6c2ed2875a766b3.tar.gz | |
Make `Errortrace.*_error` only contain nonempty traces
This was done by making their constructors private, and introduce
smart constructors that raise a fatal error if passed an empty trace.
This change was made for `Errortrace.unification_error`,
`Errortrace.equality_error`, `Errortrace.moregen_error`, and the new
type `Errortrace.Subtype.error` (which now contains a (possibly-empty)
unification trace as well).
As a side effect, in order to ensure that all raised unification
errors were indeed nonempty, I had to modify `Ctype.filter_arrow`,
`Ctype.filter_method`, and `Ctype.filter_self_method` to raise bespoke
errors rather than empty unification traces. This also allowed me to
change the error messages printed in those cases to be more precise.
Diffstat (limited to 'typing/printtyp.ml')
| -rw-r--r-- | typing/printtyp.ml | 20 |
1 files changed, 12 insertions, 8 deletions
diff --git a/typing/printtyp.ml b/typing/printtyp.ml index 21492edfba..ea5b741f61 100644 --- a/typing/printtyp.ml +++ b/typing/printtyp.ml @@ -2421,21 +2421,25 @@ module Subtype = struct Some (Errortrace.map_diff (trees_of_type_expansion Type) diff) let report_error - ppf env tr1 txt1 ({trace=tr2} : Errortrace.unification_error) = + ppf + env + (Errortrace.Subtype.{trace = tr_sub; unification_trace = tr_unif}) + txt1 = wrap_printing_env ~error:true env (fun () -> reset (); - let tr1 = prepare_trace prepare_expansion tr1 in - let tr2 = prepare_unification_trace prepare_expansion tr2 in - let keep_first = match tr2 with + let tr_sub = prepare_trace prepare_expansion tr_sub in + let tr_unif = prepare_unification_trace prepare_expansion tr_unif in + let keep_first = match tr_unif with | [Obj _ | Variant _ | Escape _ ] | [] -> true | _ -> false in fprintf ppf "@[<v>%a" - (trace filter_subtype_trace subtype_get_diff true keep_first txt1) tr1; - if tr2 = [] then fprintf ppf "@]" else - let mis = mismatch (dprintf "Within this type") env tr2 in + (trace filter_subtype_trace subtype_get_diff true keep_first txt1) + tr_sub; + if tr_unif = [] then fprintf ppf "@]" else + let mis = mismatch (dprintf "Within this type") env tr_unif in fprintf ppf "%a%t%t@]" (trace filter_unification_trace unification_get_diff false - (mis = None) "is not compatible with type") tr2 + (mis = None) "is not compatible with type") tr_unif (explain mis) Conflicts.print_explanations ) |