From 499a11a45b5711d4eaabe84a80f0ad3ae539d500 Mon Sep 17 00:00:00 2001 From: Stephane Glondu Date: Wed, 8 May 2013 17:47:10 +0200 Subject: Imported Upstream version 8.4pl2dfsg --- tactics/tactics.ml | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) (limited to 'tactics/tactics.ml') diff --git a/tactics/tactics.ml b/tactics/tactics.ml index 12292196..ac00a73d 100644 --- a/tactics/tactics.ml +++ b/tactics/tactics.ml @@ -1018,7 +1018,7 @@ let apply_in_once_main flags innerclause (d,lbind) gl = let thm = nf_betaiota gl.sigma (pf_type_of gl d) in let rec aux clause = try progress_with_clause flags innerclause clause - with err -> + with err when Errors.noncritical err -> try aux (clenv_push_prod clause) with NotExtensibleClause -> raise err in aux (make_clenv_binding gl (d,thm) lbind) @@ -1708,7 +1708,7 @@ let make_pattern_test env sigma0 (sigma,c) = let flags = default_matching_flags sigma0 in let matching_fun t = try let sigma = w_unify env sigma Reduction.CONV ~flags c t in Some(sigma,t) - with _ -> raise NotUnifiable in + with e when Errors.noncritical e -> raise NotUnifiable in let merge_fun c1 c2 = match c1, c2 with | Some (_,c1), Some (_,c2) when not (is_fconv Reduction.CONV env sigma0 c1 c2) -> @@ -2554,7 +2554,10 @@ let specialize_eqs id gl = let specialize_eqs id gl = - if try ignore(clear [id] gl); false with _ -> true then + if + (try ignore(clear [id] gl); false + with e when Errors.noncritical e -> true) + then tclFAIL 0 (str "Specialization not allowed on dependent hypotheses") gl else specialize_eqs id gl @@ -2716,7 +2719,8 @@ let compute_elim_sig ?elimc elimt = | Some ( _,None,ind) -> let indhd,indargs = decompose_app ind in try {!res with indref = Some (global_of_constr indhd) } - with _ -> error "Cannot find the inductive type of the inductive scheme.";; + with e when Errors.noncritical e -> + error "Cannot find the inductive type of the inductive scheme.";; let compute_scheme_signature scheme names_info ind_type_guess = let f,l = decompose_app scheme.concl in @@ -3551,4 +3555,5 @@ let unify ?(state=full_transparent_state) x y gl = in let evd = w_unify (pf_env gl) (project gl) Reduction.CONV ~flags x y in tclEVARS evd gl - with _ -> tclFAIL 0 (str"Not unifiable") gl + with e when Errors.noncritical e -> + tclFAIL 0 (str"Not unifiable") gl -- cgit v1.2.3