aboutsummaryrefslogtreecommitdiff
path: root/tactics/auto.ml
diff options
context:
space:
mode:
authorEmilio Jesus Gallego Arias2020-03-04 21:39:42 -0500
committerEmilio Jesus Gallego Arias2020-05-14 21:31:56 +0200
commite8bde450d05908f70ab2c82d9d24f0807c56a94a (patch)
tree4db3de0ae89817423a7e2f664beb62240a81d9cd /tactics/auto.ml
parentcc54af3842cbf99f169f7937b0e31f737652bd3a (diff)
[exn] [tactics] improve backtraces on monadic errors
Current backtraces for tactics leave a bit to desire, for example given the program: ```coq Lemma u n : n + 0 = n. rewrite plus_O_n. ``` the backtrace stops at: ``` Found no subterm matching "0 + ?M160" in the current goal. Called from file "proofs/proof.ml", line 381, characters 4-42 Called from file "tactics/pfedit.ml", line 102, characters 31-58 Called from file "plugins/ltac/g_ltac.mlg", line 378, characters 8-84 ``` Backtrace information `?info` is as of today optional in some tactics, such as `tclZERO`, it doesn't cost a lot however to reify backtrace information indeed in `tclZERO` and provide backtraces for all tactic errors. The cost should be small if we are not in debug mode. The backtrace for the failed rewrite is now: ``` Found no subterm matching "0 + ?M160" in the current goal. Raised at file "pretyping/unification.ml", line 1827, characters 14-73 Called from file "pretyping/unification.ml", line 1929, characters 17-53 Called from file "pretyping/unification.ml", line 1948, characters 22-72 Called from file "pretyping/unification.ml", line 2020, characters 14-56 Re-raised at file "pretyping/unification.ml", line 2021, characters 66-73 Called from file "proofs/clenv.ml", line 254, characters 12-58 Called from file "proofs/clenvtac.ml", line 95, characters 16-53 Called from file "engine/proofview.ml", line 1110, characters 40-46 Called from file "engine/proofview.ml", line 1115, characters 10-34 Re-raised at file "clib/exninfo.ml", line 82, characters 4-38 Called from file "proofs/proof.ml", line 381, characters 4-42 Called from file "tactics/pfedit.ml", line 102, characters 31-58 Called from file "plugins/ltac/g_ltac.mlg", line 378, characters 8-84 ``` which IMO is much better.
Diffstat (limited to 'tactics/auto.ml')
-rw-r--r--tactics/auto.ml18
1 files changed, 13 insertions, 5 deletions
diff --git a/tactics/auto.ml b/tactics/auto.ml
index 5b06088518..681c4e910f 100644
--- a/tactics/auto.ml
+++ b/tactics/auto.ml
@@ -137,8 +137,9 @@ let conclPattern concl pat tac =
| Some pat ->
try
Proofview.tclUNIT (Constr_matching.matches env sigma pat concl)
- with Constr_matching.PatternMatchingFailure ->
- Tacticals.New.tclZEROMSG (str "pattern-matching failed")
+ with Constr_matching.PatternMatchingFailure as exn ->
+ let _, info = Exninfo.capture exn in
+ Tacticals.New.tclZEROMSG ~info (str "pattern-matching failed")
in
Proofview.Goal.enter begin fun gl ->
let env = Proofview.Goal.env gl in
@@ -383,7 +384,9 @@ and my_find_search_delta sigma db_list local_db secvars hdc concl =
and tac_of_hint dbg db_list local_db concl (flags, ({pat=p; code=t;poly=poly;db=dbname})) =
let tactic = function
| Res_pf (c,cl) -> unify_resolve_gen ~poly flags (c,cl)
- | ERes_pf _ -> Proofview.Goal.enter (fun gl -> Tacticals.New.tclZEROMSG (str "eres_pf"))
+ | ERes_pf _ -> Proofview.Goal.enter (fun gl ->
+ let info = Exninfo.reify () in
+ Tacticals.New.tclZEROMSG ~info (str "eres_pf"))
| Give_exact (c, cl) -> exact poly (c, cl)
| Res_pf_THEN_trivial_fail (c,cl) ->
Tacticals.New.tclTHEN
@@ -395,7 +398,9 @@ and tac_of_hint dbg db_list local_db concl (flags, ({pat=p; code=t;poly=poly;db=
Proofview.Goal.enter begin fun gl ->
if exists_evaluable_reference (Tacmach.New.pf_env gl) c then
Tacticals.New.tclPROGRESS (reduce (Unfold [AllOccurrences,c]) Locusops.onConcl)
- else Tacticals.New.tclFAIL 0 (str"Unbound reference")
+ else
+ let info = Exninfo.reify () in
+ Tacticals.New.tclFAIL ~info 0 (str"Unbound reference")
end
| Extern tacast ->
conclPattern concl p tacast
@@ -492,7 +497,10 @@ let search d n mod_delta db_list local_db =
(* spiwack: the test of [n] to 0 must be done independently in
each goal. Hence the [tclEXTEND] *)
Proofview.tclEXTEND [] begin
- if Int.equal n 0 then Tacticals.New.tclZEROMSG (str"BOUND 2") else
+ if Int.equal n 0 then
+ let info = Exninfo.reify () in
+ Tacticals.New.tclZEROMSG ~info (str"BOUND 2")
+ else
Tacticals.New.tclORELSE0 (dbg_assumption d)
(Tacticals.New.tclORELSE0 (intro_register d (search d n) local_db)
( Proofview.Goal.enter begin fun gl ->