aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJason Gross2020-04-19 18:04:14 -0400
committerJason Gross2020-05-09 13:03:04 -0400
commit33388d18f0165369a565cd5ca5b6eb153899271e (patch)
treec706101cca1c78cae71b017e2127ad2068eab547
parent2edbbfee7fdcfb2a4804524091930c5dab7b9db4 (diff)
Fix the `with_strategy` tactic to work with `abstract`
-rw-r--r--doc/sphinx/proof-engine/tactics.rst4
-rw-r--r--tactics/tactics.ml29
-rw-r--r--test-suite/success/with_strategy.v2
3 files changed, 29 insertions, 6 deletions
diff --git a/doc/sphinx/proof-engine/tactics.rst b/doc/sphinx/proof-engine/tactics.rst
index fd6b2b3846..b376d9177f 100644
--- a/doc/sphinx/proof-engine/tactics.rst
+++ b/doc/sphinx/proof-engine/tactics.rst
@@ -3370,7 +3370,9 @@ the conversion in hypotheses :n:`{+ @ident}`.
Use this tactic with care, as effects do not persist past the
end of the proof script. Notably, this fine-tuning of the
conversion strategy is not in effect during :cmd:`Qed` nor
- :cmd:`Defined`, so this tactic is most useful to guard
+ :cmd:`Defined`, so this tactic is most useful either in
+ combination with :tacn:`abstract`, which will check the proof
+ early while the fine-tuning is still in effect, or to guard
calls to conversion in tactic automation to ensure that, e.g.,
:tacn:`unfold` does not fail just because the user made a
constant :cmd:`Opaque`.
diff --git a/tactics/tactics.ml b/tactics/tactics.ml
index b17f02f224..350881f72d 100644
--- a/tactics/tactics.ml
+++ b/tactics/tactics.ml
@@ -5057,16 +5057,37 @@ let with_set_strategy lvl_ql k =
let orig_kl = List.map (fun (_lvl, k) ->
(Conv_oracle.get_strategy (Environ.oracle env) k, k))
kl in
+ (* Because the global env might be desynchronized from the proof-local
+ env, we need to update the global env to have this tactic play
+ nicely with abstract.
+ TODO: When abstract no longer depends on Global, delete this variable
+ let-in *)
+ let orig_kl_global = List.map (fun (_lvl, k) ->
+ (Conv_oracle.get_strategy (Environ.oracle (Global.env ())) k, k))
+ kl in
let env = List.fold_left (fun env (lvl, k) ->
Environ.set_oracle env
(Conv_oracle.set_strategy (Environ.oracle env) k lvl)) env kl in
- Proofview.Unsafe.tclSETENV env <*>
+ (* TODO: When abstract no longer depends on Global, replace this
+ [Proofview.Goal.enter] block with [Proofview.Unsafe.tclSETENV env] *)
+ Proofview.Goal.enter begin
+ fun _ ->
+ List.iter (fun (lvl, k) -> Global.set_strategy k lvl) kl;
+ Proofview.Unsafe.tclSETENV env
+ end <*>
k <*>
Proofview.tclENV >>= fun env ->
let env = List.fold_left (fun env (lvl, k) ->
- Environ.set_oracle env
- (Conv_oracle.set_strategy (Environ.oracle env) k lvl)) env orig_kl in
- Proofview.Unsafe.tclSETENV env
+ Environ.set_oracle env
+ (Conv_oracle.set_strategy (Environ.oracle env) k lvl)) env orig_kl in
+ Proofview.Unsafe.tclSETENV env <*>
+ (* TODO: When abstract no longer depends on Global, remove this
+ [Proofview.Goal.enter] block *)
+ Proofview.Goal.enter begin
+ fun _ ->
+ List.iter (fun (lvl, k) -> Global.set_strategy k lvl) orig_kl_global;
+ Proofview.tclUNIT ()
+ end
module Simple = struct
(** Simplified version of some of the above tactics *)
diff --git a/test-suite/success/with_strategy.v b/test-suite/success/with_strategy.v
index bf639ae6b9..bacea3549f 100644
--- a/test-suite/success/with_strategy.v
+++ b/test-suite/success/with_strategy.v
@@ -131,7 +131,7 @@ Qed.
(* test that the strategy tactic does persist through abstract *)
Opaque id.
Goal id 0 = 0.
- Fail Time Timeout 5
+ Time Timeout 5
with_strategy
expand [id]
assert (id (fact 100) = fact 100) by abstract reflexivity.