aboutsummaryrefslogtreecommitdiff
path: root/tactics
diff options
context:
space:
mode:
Diffstat (limited to 'tactics')
-rw-r--r--tactics/class_tactics.ml6
-rw-r--r--tactics/contradiction.ml6
-rw-r--r--tactics/equality.ml6
-rw-r--r--tactics/hints.ml8
-rw-r--r--tactics/tacticals.ml6
-rw-r--r--tactics/tacticals.mli1
-rw-r--r--tactics/tactics.ml33
-rw-r--r--tactics/tactics.mli3
8 files changed, 19 insertions, 50 deletions
diff --git a/tactics/class_tactics.ml b/tactics/class_tactics.ml
index a95e6b941e..b8860d3a56 100644
--- a/tactics/class_tactics.ml
+++ b/tactics/class_tactics.ml
@@ -581,7 +581,7 @@ let make_resolve_hyp env sigma st flags only_classes pri decl =
(fun (path,info,c) ->
let info =
{ info with Vernacexpr.hint_pattern =
- Option.map (Constrintern.intern_constr_pattern env)
+ Option.map (Constrintern.intern_constr_pattern env sigma)
info.Vernacexpr.hint_pattern }
in
make_resolves env sigma ~name:(PathHints path)
@@ -1131,6 +1131,7 @@ module Search = struct
let rec result (shelf, ()) i k =
foundone := true;
Proofview.Unsafe.tclGETGOALS >>= fun gls ->
+ let gls = CList.map Proofview.drop_state gls in
let j = List.length gls in
(if !typeclasses_debug > 0 then
Feedback.msg_debug
@@ -1179,7 +1180,7 @@ module Search = struct
(if List.is_empty goals then tclUNIT ()
else
let sigma' = mark_unresolvables sigma goals in
- with_shelf (Unsafe.tclEVARS sigma' <*> Unsafe.tclNEWGOALS goals) >>=
+ with_shelf (Unsafe.tclEVARS sigma' <*> Unsafe.tclNEWGOALS (CList.map Proofview.with_empty_state goals)) >>=
fun s -> result s i (Some (Option.default 0 k + j)))
end
in with_shelf res >>= fun (sh, ()) ->
@@ -1272,6 +1273,7 @@ module Search = struct
search_tac_gl ~st only_classes dep hints depth (succ i) sigma gls gl end
in
Proofview.Unsafe.tclGETGOALS >>= fun gls ->
+ let gls = CList.map Proofview.drop_state gls in
Proofview.tclEVARMAP >>= fun sigma ->
let j = List.length gls in
(tclDISPATCH (List.init j (fun i -> tac sigma gls i)))
diff --git a/tactics/contradiction.ml b/tactics/contradiction.ml
index 467754a848..3386f972e7 100644
--- a/tactics/contradiction.ml
+++ b/tactics/contradiction.ml
@@ -44,8 +44,6 @@ let absurd c = absurd c
(* Contradiction *)
-let use_negated_unit_or_eq_type () = Flags.version_strictly_greater Flags.V8_5
-
(** [f] does not assume its argument to be [nf_evar]-ed. *)
let filter_hyp f tac =
let rec seek = function
@@ -71,9 +69,7 @@ let contradiction_context =
simplest_elim (mkVar id)
else match EConstr.kind sigma typ with
| Prod (na,t,u) when is_empty_type sigma u ->
- let is_unit_or_eq =
- if use_negated_unit_or_eq_type () then match_with_unit_or_eq_type sigma t
- else None in
+ let is_unit_or_eq = match_with_unit_or_eq_type sigma t in
Tacticals.New.tclORELSE
(match is_unit_or_eq with
| Some _ ->
diff --git a/tactics/equality.ml b/tactics/equality.ml
index 9a1ac768c7..96a53a8b1e 100644
--- a/tactics/equality.ml
+++ b/tactics/equality.ml
@@ -84,7 +84,7 @@ let _ =
let injection_in_context = ref false
let use_injection_in_context = function
- | None -> !injection_in_context && Flags.version_strictly_greater Flags.V8_5
+ | None -> !injection_in_context
| Some flags -> flags.injection_in_context
let _ =
@@ -533,7 +533,7 @@ let general_rewrite_clause l2r with_evars ?tac c cl =
let rec do_hyps_atleastonce = function
| [] -> tclZEROMSG (Pp.str"Nothing to rewrite.")
| id :: l ->
- tclIFTHENTRYELSEMUST
+ tclIFTHENFIRSTTRYELSEMUST
(general_rewrite_ebindings_in l2r AllOccurrences false true ?tac id c with_evars)
(do_hyps_atleastonce l)
in
@@ -549,7 +549,7 @@ let general_rewrite_clause l2r with_evars ?tac c cl =
end
in
if cl.concl_occs == NoOccurrences then do_hyps else
- tclIFTHENTRYELSEMUST
+ tclIFTHENFIRSTTRYELSEMUST
(general_rewrite_ebindings l2r (occs_of cl.concl_occs) false true ?tac c with_evars)
do_hyps
diff --git a/tactics/hints.ml b/tactics/hints.ml
index 7f9b5ef34e..10cd7e1f64 100644
--- a/tactics/hints.ml
+++ b/tactics/hints.ml
@@ -1270,7 +1270,7 @@ let prepare_hint check (poly,local) env init (sigma,c) =
let interp_hints poly =
fun h ->
- let env = (Global.env()) in
+ let env = Global.env () in
let sigma = Evd.from_env env in
let f poly c =
let evd,c = Constrintern.interp_open_constr env sigma c in
@@ -1279,9 +1279,7 @@ let interp_hints poly =
let gr = global_with_alias r in
Dumpglob.add_glob ?loc:(loc_of_reference r) gr;
gr in
- let fr r =
- evaluable_of_global_reference (Global.env()) (fref r)
- in
+ let fr r = evaluable_of_global_reference env (fref r) in
let fi c =
match c with
| HintsReference c ->
@@ -1289,7 +1287,7 @@ let interp_hints poly =
(PathHints [gr], poly, IsGlobRef gr)
| HintsConstr c -> (PathAny, poly, f poly c)
in
- let fp = Constrintern.intern_constr_pattern (Global.env()) in
+ let fp = Constrintern.intern_constr_pattern env sigma in
let fres (info, b, r) =
let path, poly, gr = fi r in
let info = { info with hint_pattern = Option.map fp info.hint_pattern } in
diff --git a/tactics/tacticals.ml b/tactics/tacticals.ml
index e7da17cff1..0cc0001c1c 100644
--- a/tactics/tacticals.ml
+++ b/tactics/tacticals.ml
@@ -408,8 +408,14 @@ module New = struct
Proofview.tclIFCATCH t1
(fun () -> tclDISPATCH (Array.to_list a))
(fun _ -> t3)
+ let tclIFTHENFIRSTELSE t1 t2 t3 =
+ Proofview.tclIFCATCH t1
+ (fun () -> tclEXTEND [t2] (tclUNIT ()) [])
+ (fun _ -> t3)
let tclIFTHENTRYELSEMUST t1 t2 =
tclIFTHENELSE t1 (tclTRY t2) t2
+ let tclIFTHENFIRSTTRYELSEMUST t1 t2 =
+ tclIFTHENFIRSTELSE t1 (tclTRY t2) t2
(* Try the first tactic that does not fail in a list of tactics *)
let rec tclFIRST = function
diff --git a/tactics/tacticals.mli b/tactics/tacticals.mli
index c5d5c8c123..a3bc4707ea 100644
--- a/tactics/tacticals.mli
+++ b/tactics/tacticals.mli
@@ -210,6 +210,7 @@ module New : sig
val tclIFTHENELSE : unit tactic -> unit tactic -> unit tactic -> unit tactic
val tclIFTHENSVELSE : unit tactic -> unit tactic array -> unit tactic -> unit tactic
val tclIFTHENTRYELSEMUST : unit tactic -> unit tactic -> unit tactic
+ val tclIFTHENFIRSTTRYELSEMUST : unit tactic -> unit tactic -> unit tactic
val tclDO : int -> unit tactic -> unit tactic
val tclREPEAT : unit tactic -> unit tactic
diff --git a/tactics/tactics.ml b/tactics/tactics.ml
index 7e281e2fe0..61ca3e319c 100644
--- a/tactics/tactics.ml
+++ b/tactics/tactics.ml
@@ -1991,7 +1991,6 @@ let exact_proof c =
Proofview.Goal.enter begin fun gl ->
Refine.refine ~typecheck:false begin fun sigma ->
let (c, ctx) = Constrintern.interp_casted_constr (pf_env gl) sigma c (pf_concl gl) in
- let c = EConstr.of_constr c in
let sigma = Evd.merge_universe_context sigma ctx in
(sigma, c)
end
@@ -4662,30 +4661,6 @@ let destruct ev clr c l e =
induction_gen clr false ev e
((Evd.empty,(c,NoBindings)),(None,l)) None
-(* The registered tactic, which calls the default elimination
- * if no elimination constant is provided. *)
-
-(* Induction tactics *)
-
-(* This was Induction before 6.3 (induction only in quantified premisses) *)
-let simple_induct_id s = Tacticals.New.tclTHEN (intros_until_id s) (Tacticals.New.onLastHyp simplest_elim)
-let simple_induct_nodep n = Tacticals.New.tclTHEN (intros_until_n n) (Tacticals.New.onLastHyp simplest_elim)
-
-let simple_induct = function
- | NamedHyp id -> simple_induct_id id
- | AnonHyp n -> simple_induct_nodep n
-
-(* Destruction tactics *)
-
-let simple_destruct_id s =
- (Tacticals.New.tclTHEN (intros_until_id s) (Tacticals.New.onLastHyp simplest_case))
-let simple_destruct_nodep n =
- (Tacticals.New.tclTHEN (intros_until_n n) (Tacticals.New.onLastHyp simplest_case))
-
-let simple_destruct = function
- | NamedHyp id -> simple_destruct_id id
- | AnonHyp n -> simple_destruct_nodep n
-
(*
* Eliminations giving the type instead of the proof.
* These tactics use the default elimination constant and
@@ -5146,16 +5121,10 @@ module New = struct
open Locus
let reduce_after_refine =
- let onhyps =
- (** We reduced everywhere in the hyps before 8.6 *)
- if Flags.version_compare !Flags.compat_version Flags.V8_5 == 0
- then None
- else Some []
- in
reduce
(Lazy {rBeta=true;rMatch=true;rFix=true;rCofix=true;
rZeta=false;rDelta=false;rConst=[]})
- {onhyps; concl_occs=AllOccurrences }
+ {onhyps = Some []; concl_occs = AllOccurrences }
let refine ~typecheck c =
Refine.refine ~typecheck c <*>
diff --git a/tactics/tactics.mli b/tactics/tactics.mli
index 74415f8d03..100ddf17f2 100644
--- a/tactics/tactics.mli
+++ b/tactics/tactics.mli
@@ -280,8 +280,6 @@ val simplest_elim : constr -> unit Proofview.tactic
val elim :
evars_flag -> clear_flag -> constr with_bindings -> constr with_bindings option -> unit Proofview.tactic
-val simple_induct : quantified_hypothesis -> unit Proofview.tactic
-
val induction : evars_flag -> clear_flag -> constr -> or_and_intro_pattern option ->
constr with_bindings option -> unit Proofview.tactic
@@ -290,7 +288,6 @@ val induction : evars_flag -> clear_flag -> constr -> or_and_intro_pattern optio
val general_case_analysis : evars_flag -> clear_flag -> constr with_bindings -> unit Proofview.tactic
val simplest_case : constr -> unit Proofview.tactic
-val simple_destruct : quantified_hypothesis -> unit Proofview.tactic
val destruct : evars_flag -> clear_flag -> constr -> or_and_intro_pattern option ->
constr with_bindings option -> unit Proofview.tactic