From 15effb7dedbaa407bbe25055da6efded366dd3b1 Mon Sep 17 00:00:00 2001 From: aspiwack Date: Sat, 2 Nov 2013 15:35:31 +0000 Subject: Removed spurious try/with in Proofview.Notation.(>>=) and (>>==). They were a hack to avoid looking where exceptions were raised and not caught. Hopefully I produce a cleaner stack now, catching errors when it is needed. git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@16980 85f007b7-540e-0410-9357-904b9bb8a0f7 --- plugins/setoid_ring/newring.ml4 | 28 ++++++++++++++++------------ 1 file changed, 16 insertions(+), 12 deletions(-) (limited to 'plugins/setoid_ring') diff --git a/plugins/setoid_ring/newring.ml4 b/plugins/setoid_ring/newring.ml4 index 010a550f0c..7bd0c7e43d 100644 --- a/plugins/setoid_ring/newring.ml4 +++ b/plugins/setoid_ring/newring.ml4 @@ -800,12 +800,14 @@ open Proofview.Notations let ring_lookup (f:glob_tactic_expr) lH rl t = Proofview.tclEVARMAP >= fun sigma -> Proofview.Goal.env >>= fun env -> - let rl = make_args_list rl t in - let e = find_ring_structure env sigma rl in - let rl = carg (make_term_list e.ring_carrier rl) in - let lH = carg (make_hyp_list env lH) in - let ring = ltac_ring_structure e in - ltac_apply f (ring@[lH;rl]) + try (* find_ring_strucure can raise an exception *) + let rl = make_args_list rl t in + let e = find_ring_structure env sigma rl in + let rl = carg (make_term_list e.ring_carrier rl) in + let lH = carg (make_hyp_list env lH) in + let ring = ltac_ring_structure e in + ltac_apply f (ring@[lH;rl]) + with e when Proofview.V82.catchable_exception e -> Proofview.tclZERO e TACTIC EXTEND ring_lookup | [ "ring_lookup" tactic0(f) "[" constr_list(lH) "]" ne_constr_list(lrt) ] -> @@ -1121,12 +1123,14 @@ let ltac_field_structure e = let field_lookup (f:glob_tactic_expr) lH rl t = Proofview.tclEVARMAP >= fun sigma -> Proofview.Goal.env >>= fun env -> - let rl = make_args_list rl t in - let e = find_field_structure env sigma rl in - let rl = carg (make_term_list e.field_carrier rl) in - let lH = carg (make_hyp_list env lH) in - let field = ltac_field_structure e in - ltac_apply f (field@[lH;rl]) + try + let rl = make_args_list rl t in + let e = find_field_structure env sigma rl in + let rl = carg (make_term_list e.field_carrier rl) in + let lH = carg (make_hyp_list env lH) in + let field = ltac_field_structure e in + ltac_apply f (field@[lH;rl]) + with e when Proofview.V82.catchable_exception e -> Proofview.tclZERO e TACTIC EXTEND field_lookup -- cgit v1.2.3