aboutsummaryrefslogtreecommitdiff
path: root/kernel
diff options
context:
space:
mode:
authorPierre-Marie Pédrot2018-11-19 13:51:59 +0100
committerPierre-Marie Pédrot2018-11-19 13:51:59 +0100
commitf9a890aa9ff9d199bd6c98ee33274894fd5d8972 (patch)
treecabbb7c9767a7c6b12862fbf36a54c3cc6077f47 /kernel
parent1ca5089ebc8250073575ba0b63242a36e66a803e (diff)
parent3d49ce63bd1aa35ef2e8abc9cc359ad6031c21bb (diff)
Merge PR #8894: Print full binders in subtyping incompatible polymorphism error.
Diffstat (limited to 'kernel')
-rw-r--r--kernel/modops.ml3
-rw-r--r--kernel/modops.mli3
-rw-r--r--kernel/subtyping.ml6
-rw-r--r--kernel/univ.ml6
4 files changed, 7 insertions, 11 deletions
diff --git a/kernel/modops.ml b/kernel/modops.ml
index bab2eae3df..0dde1c7e75 100644
--- a/kernel/modops.ml
+++ b/kernel/modops.ml
@@ -47,10 +47,9 @@ type signature_mismatch_error =
| RecordFieldExpected of bool
| RecordProjectionsExpected of Name.t list
| NotEqualInductiveAliases
- | IncompatibleInstances
| IncompatibleUniverses of Univ.univ_inconsistency
| IncompatiblePolymorphism of env * types * types
- | IncompatibleConstraints of Univ.AUContext.t
+ | IncompatibleConstraints of { got : Univ.AUContext.t; expect : Univ.AUContext.t }
type module_typing_error =
| SignatureMismatch of
diff --git a/kernel/modops.mli b/kernel/modops.mli
index 8e7e618fcd..0acd09fb12 100644
--- a/kernel/modops.mli
+++ b/kernel/modops.mli
@@ -106,10 +106,9 @@ type signature_mismatch_error =
| RecordFieldExpected of bool
| RecordProjectionsExpected of Name.t list
| NotEqualInductiveAliases
- | IncompatibleInstances
| IncompatibleUniverses of Univ.univ_inconsistency
| IncompatiblePolymorphism of env * types * types
- | IncompatibleConstraints of Univ.AUContext.t
+ | IncompatibleConstraints of { got : Univ.AUContext.t; expect : Univ.AUContext.t }
type module_typing_error =
| SignatureMismatch of
diff --git a/kernel/subtyping.ml b/kernel/subtyping.ml
index d64342dbb0..347c30dd64 100644
--- a/kernel/subtyping.ml
+++ b/kernel/subtyping.ml
@@ -93,10 +93,8 @@ let check_conv_error error why cst poly f env a1 a2 =
| Univ.UniverseInconsistency e -> error (IncompatibleUniverses e)
let check_polymorphic_instance error env auctx1 auctx2 =
- if not (Univ.AUContext.size auctx1 == Univ.AUContext.size auctx2) then
- error IncompatibleInstances
- else if not (UGraph.check_subtype (Environ.universes env) auctx2 auctx1) then
- error (IncompatibleConstraints auctx1)
+ if not (UGraph.check_subtype (Environ.universes env) auctx2 auctx1) then
+ error (IncompatibleConstraints { got = auctx1; expect = auctx2; } )
else
Environ.push_context ~strict:false (Univ.AUContext.repr auctx2) env
diff --git a/kernel/univ.ml b/kernel/univ.ml
index 0edf750997..2b3b4f9486 100644
--- a/kernel/univ.ml
+++ b/kernel/univ.ml
@@ -570,9 +570,9 @@ struct
include S
let pr prl c =
- fold (fun (u1,op,u2) pp_std ->
- pp_std ++ prl u1 ++ pr_constraint_type op ++
- prl u2 ++ fnl () ) c (str "")
+ v 0 (prlist_with_sep spc (fun (u1,op,u2) ->
+ hov 0 (prl u1 ++ pr_constraint_type op ++ prl u2))
+ (elements c))
end