diff options
| author | Pierre Corbineau | 2014-12-16 15:59:52 +0100 |
|---|---|---|
| committer | Pierre Corbineau | 2014-12-16 16:01:25 +0100 |
| commit | 8029f7555f9c6f201cc70b5ecc538b11a861f0aa (patch) | |
| tree | c750b3ea7cafd5ec2176866bbd16208e5335978a /pretyping | |
| parent | d4f5bdd6f7304fac541bb5f4555ecdd6aa42699a (diff) | |
| parent | f88cce2698da000ab9054da31330db70997a41a4 (diff) | |
fix bug #2447 in congruence
Diffstat (limited to 'pretyping')
| -rw-r--r-- | pretyping/pretyping.ml | 15 |
1 files changed, 11 insertions, 4 deletions
diff --git a/pretyping/pretyping.ml b/pretyping/pretyping.ml index dfe018c33b..07cc36815b 100644 --- a/pretyping/pretyping.ml +++ b/pretyping/pretyping.ml @@ -77,7 +77,9 @@ let search_guard loc env possible_indexes fixdefs = let fix = ((indexes, 0),fixdefs) in (try check_fix env fix with reraise -> - let e = Errors.push reraise in Loc.raise loc e); + let (e, info) = Errors.push reraise in + let info = Loc.add_loc info loc in + iraise (e, info)); indexes else (* we now search recursively amoungst all combinations *) @@ -176,7 +178,7 @@ let apply_heuristics env evdref fail_evar = try evdref := consider_remaining_unif_problems ~ts:(Typeclasses.classes_transparent_state ()) env !evdref with e when Errors.noncritical e -> - let e = Errors.push e in if fail_evar then raise e + let e = Errors.push e in if fail_evar then iraise e let check_typeclasses_instances_are_solved env current_sigma pending = (* Naive way, call resolution again with failure flag *) @@ -542,7 +544,9 @@ let rec pretype resolve_tc (tycon : type_constraint) env evdref (lvar : ltac_var let cofix = (i,(names,ftys,fdefs)) in (try check_cofix env cofix with reraise -> - let e = Errors.push reraise in Loc.raise loc e); + let (e, info) = Errors.push reraise in + let info = Loc.add_loc info loc in + iraise (e, info)); make_judge (mkCoFix cofix) ftys.(i) in inh_conv_coerce_to_tycon loc env evdref fixj tycon @@ -672,7 +676,10 @@ let rec pretype resolve_tc (tycon : type_constraint) env evdref (lvar : ltac_var let resj = try judge_of_product env name j j' - with TypeError _ as e -> let e = Errors.push e in Loc.raise loc e in + with TypeError _ as e -> + let (e, info) = Errors.push e in + let info = Loc.add_loc info loc in + iraise (e, info) in inh_conv_coerce_to_tycon loc env evdref resj tycon | GLetIn(loc,name,c1,c2) -> |