diff options
| author | ppedrot | 2013-01-28 21:06:02 +0000 |
|---|---|---|
| committer | ppedrot | 2013-01-28 21:06:02 +0000 |
| commit | 0892990d7bbeb770de458a3b4ef2ffe34a1b11e3 (patch) | |
| tree | 685770a3b85870caac91e23302e6c188e4b3ca77 /pretyping | |
| parent | 1ce2c89e8fd2f80b49fcac9e045667b7233391ef (diff) | |
Actually adding backtrace handling.
I hope I did not forget some [with] clauses. Otherwise, some
stack frame will be missing from the debug.
git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@16167 85f007b7-540e-0410-9357-904b9bb8a0f7
Diffstat (limited to 'pretyping')
| -rw-r--r-- | pretyping/pretyping.ml | 8 |
1 files changed, 4 insertions, 4 deletions
diff --git a/pretyping/pretyping.ml b/pretyping/pretyping.ml index bcabf1cd98..ed087fa255 100644 --- a/pretyping/pretyping.ml +++ b/pretyping/pretyping.ml @@ -69,7 +69,7 @@ let search_guard loc env possible_indexes fixdefs = let indexes = Array.of_list (List.map List.hd possible_indexes) in let fix = ((indexes, 0),fixdefs) in (try check_fix env fix with - | e -> Loc.raise loc e); + | e -> let e = Errors.push e in Loc.raise loc e); indexes else (* we now search recursively amoungst all combinations *) @@ -114,7 +114,7 @@ let resolve_evars env evdref fail_evar resolve_classes = (* Resolve eagerly, potentially making wrong choices *) evdref := (try consider_remaining_unif_problems ~ts:(Typeclasses.classes_transparent_state ()) env !evdref - with e -> if fail_evar then raise e else !evdref) + with e -> let e = Errors.push e in if fail_evar then raise e else !evdref) let solve_remaining_evars fail_evar use_classes hook env initial_sigma (evd,c) = let evdref = ref evd in @@ -362,7 +362,7 @@ let rec pretype (tycon : type_constraint) env evdref lvar = function make_judge (mkFix ((indexes,i),fixdecls)) ftys.(i) | GCoFix i -> let cofix = (i,(names,ftys,fdefs)) in - (try check_cofix env cofix with e -> Loc.raise loc e); + (try check_cofix env cofix with e -> let e = Errors.push e in Loc.raise loc e); make_judge (mkCoFix cofix) ftys.(i) in inh_conv_coerce_to_tycon loc env evdref fixj tycon @@ -473,7 +473,7 @@ let rec pretype (tycon : type_constraint) env evdref lvar = function in let resj = try judge_of_product env name j j' - with TypeError _ as e -> Loc.raise loc e in + with TypeError _ as e -> let e = Errors.push e in Loc.raise loc e in inh_conv_coerce_to_tycon loc env evdref resj tycon | GLetIn(loc,name,c1,c2) -> |