diff options
| author | Hugo Herbelin | 2014-12-09 14:51:24 +0100 |
|---|---|---|
| committer | Hugo Herbelin | 2014-12-11 18:34:04 +0100 |
| commit | f37ce408e943b29ab41c979a7f95ee824813397b (patch) | |
| tree | 5a1a3fe814bf6b6f7c6b5b52fa435705ca9fecfe /pretyping | |
| parent | ccc7d1ec570e691a6824d9e6f43665f2eb4a1e3f (diff) | |
Added a CannotSolveConstraint unification error and made experiments
in reporting the chain of causes when unification fails.
Diffstat (limited to 'pretyping')
| -rw-r--r-- | pretyping/evarsolve.ml | 10 | ||||
| -rw-r--r-- | pretyping/pretype_errors.ml | 1 | ||||
| -rw-r--r-- | pretyping/pretype_errors.mli | 1 |
3 files changed, 9 insertions, 3 deletions
diff --git a/pretyping/evarsolve.ml b/pretyping/evarsolve.ml index 0e1ecda5cf..c62d567904 100644 --- a/pretyping/evarsolve.ml +++ b/pretyping/evarsolve.ml @@ -1497,10 +1497,14 @@ let status_changed lev (pbty,_,t1,t2) = let reconsider_conv_pbs conv_algo evd = let (evd,pbs) = extract_changed_conv_pbs evd status_changed in List.fold_left - (fun p (pbty,env,t1,t2) -> + (fun p (pbty,env,t1,t2 as x) -> match p with - | Success evd -> conv_algo env evd pbty t1 t2 - | UnifFailure _ as x -> x) (Success evd) + | Success evd -> + (match conv_algo env evd pbty t1 t2 with + | Success _ as x -> x + | UnifFailure (i,e) -> UnifFailure (i,CannotSolveConstraint (x,e))) + | UnifFailure _ as x -> x) + (Success evd) pbs (* Tries to solve problem t1 = t2. diff --git a/pretyping/pretype_errors.ml b/pretyping/pretype_errors.ml index 9b5b79284b..21604a8fc2 100644 --- a/pretyping/pretype_errors.ml +++ b/pretyping/pretype_errors.ml @@ -22,6 +22,7 @@ type unification_error = | MetaOccurInBody of existential_key | InstanceNotSameType of existential_key * env * types * types | UnifUnivInconsistency of Univ.univ_inconsistency + | CannotSolveConstraint of Evd.evar_constraint * unification_error type position = (Id.t * Locus.hyp_location_flag) option diff --git a/pretyping/pretype_errors.mli b/pretyping/pretype_errors.mli index 1222406217..741279a512 100644 --- a/pretyping/pretype_errors.mli +++ b/pretyping/pretype_errors.mli @@ -23,6 +23,7 @@ type unification_error = | MetaOccurInBody of existential_key | InstanceNotSameType of existential_key * env * types * types | UnifUnivInconsistency of Univ.univ_inconsistency + | CannotSolveConstraint of Evd.evar_constraint * unification_error type position = (Id.t * Locus.hyp_location_flag) option |