From 9346d0b22d34a48b16f46c663064808063afb4a2 Mon Sep 17 00:00:00 2001 From: msozeau Date: Thu, 18 Jun 2009 17:59:35 +0000 Subject: Fix "unsatisfiable constraints" error messages to include all the necessary information. Fix implementation of [split_evars] and use splitting more wisely as it has a big performance impact. git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@12196 85f007b7-540e-0410-9357-904b9bb8a0f7 --- pretyping/typeclasses_errors.ml | 20 +++++++++----------- 1 file changed, 9 insertions(+), 11 deletions(-) (limited to 'pretyping/typeclasses_errors.ml') diff --git a/pretyping/typeclasses_errors.ml b/pretyping/typeclasses_errors.ml index c7e3895e0..cec46d780 100644 --- a/pretyping/typeclasses_errors.ml +++ b/pretyping/typeclasses_errors.ml @@ -28,7 +28,7 @@ type typeclass_error = | NotAClass of constr | UnboundMethod of global_reference * identifier located (* Class name, method *) | NoInstance of identifier located * constr list - | UnsatisfiableConstraints of evar_defs * (evar_info * hole_kind) option + | UnsatisfiableConstraints of evar_defs * (existential_key * hole_kind) option | MismatchedContextInstance of contexts * constr_expr list * rel_context (* found, expected *) exception TypeClassError of env * typeclass_error @@ -42,16 +42,14 @@ let unbound_method env cid id = typeclass_error env (UnboundMethod (cid, id)) let no_instance env id args = typeclass_error env (NoInstance (id, args)) let unsatisfiable_constraints env evd ev = - let evd = Evd.undefined_evars evd in - match ev with - | None -> - raise (TypeClassError (env, UnsatisfiableConstraints (evd, None))) - | Some ev -> - let evi = Evd.find evd ev in - let loc, kind = Evd.evar_source ev evd in - raise (Stdpp.Exc_located (loc, TypeClassError - (env, UnsatisfiableConstraints (evd, Some (evi, kind))))) - + match ev with + | None -> + raise (TypeClassError (env, UnsatisfiableConstraints (evd, None))) + | Some ev -> + let loc, kind = Evd.evar_source ev evd in + raise (Stdpp.Exc_located (loc, TypeClassError + (env, UnsatisfiableConstraints (evd, Some (ev, kind))))) + let mismatched_ctx_inst env c n m = typeclass_error env (MismatchedContextInstance (c, n, m)) let rec unsatisfiable_exception exn = -- cgit v1.2.3