Commit 8ff77bbd authored by Ralf Jung's avatar Ralf Jung

Merge branch 'ci/robbert/faster_iFresh' into 'master'

Make `iFresh` faster

See merge request !247
parents af309491 c6c5de47
......@@ -15,8 +15,8 @@ Implicit Types P Q : PROP.
(** * Adequacy *)
Lemma tac_adequate P : envs_entails (Envs Enil Enil 1) P P.
Proof.
rewrite envs_entails_eq /of_envs /= intuitionistically_True_emp
left_id=><-.
rewrite envs_entails_eq !of_envs_eq /=.
rewrite intuitionistically_True_emp left_id=><-.
apply and_intro=> //. apply pure_intro; repeat constructor.
Qed.
......@@ -589,15 +589,9 @@ Lemma tac_accu Δ P :
envs_entails Δ P.
Proof.
rewrite envs_entails_eq=><-.
rewrite env_to_prop_sound /of_envs and_elim_r sep_elim_r //.
rewrite env_to_prop_sound !of_envs_eq and_elim_r sep_elim_r //.
Qed.
(** * Fresh *)
Lemma tac_fresh Δ Δ' (Q : PROP) :
envs_incr_counter Δ = Δ'
envs_entails Δ' Q envs_entails Δ Q.
Proof. rewrite envs_entails_eq=> <- <-. by rewrite envs_incr_counter_sound. Qed.
(** * Invariants *)
Lemma tac_inv_elim {X : Type} Δ Δ' i j φ p Pinv Pin Pout (Pclose : option (X PROP))
Q (Q' : X PROP) :
......@@ -805,7 +799,7 @@ Section tac_modal_intro.
(if fi then Absorbing Q' else TCTrue)
envs_entails (Envs Γp' Γs' n) Q envs_entails (Envs Γp Γs n) Q'.
Proof.
rewrite envs_entails_eq /FromModal /of_envs /= => HQ' HΓp HΓs ? HQ.
rewrite envs_entails_eq /FromModal !of_envs_eq => HQ' HΓp HΓs ? HQ.
apply pure_elim_l=> -[???]. assert (envs_wf (Envs Γp' Γs' n)) as Hwf.
{ split; simpl in *.
- destruct HΓp as [| |????? []| |]; eauto using Enil_wf.
......@@ -910,7 +904,7 @@ Proof. by split. Qed.
Lemma into_laterN_env_sound n Δ1 Δ2 :
MaybeIntoLaterNEnvs n Δ1 Δ2 of_envs Δ1 ^n (of_envs Δ2).
Proof.
intros [[Hp ??] [Hs ??]]; rewrite /of_envs /= !laterN_and !laterN_sep.
intros [[Hp ??] [Hs ??]]; rewrite !of_envs_eq /= !laterN_and !laterN_sep.
rewrite -{1}laterN_intro. apply and_mono, sep_mono.
- apply pure_mono; destruct 1; constructor; naive_solver.
- apply Hp; rewrite /= /MaybeIntoLaterN.
......
This diff is collapsed.
......@@ -91,21 +91,31 @@ Tactic Notation "iStartProof" uconstr(PROP) :=
end.
(** * Generate a fresh identifier *)
(* Tactic Notation tactics cannot return terms *)
(** The tactic [iFresh] bumps the fresh name counter in the proof mode
environment and returns the old value.
Note that we use [Ltac] instead of [Tactic Notation] since [Tactic Notation]
tactics can only have side-effects, but cannot return terms. *)
Ltac iFresh :=
(* We need to increment the environment counter using [tac_fresh].
But because [iFresh] returns a value, we have to let bind
[tac_fresh] wrapped under a match to force evaluation of this
side-effect. See https://stackoverflow.com/a/46178884 *)
let do_incr :=
lazymatch goal with
| _ => iStartProof; eapply tac_fresh; first by (pm_reflexivity)
end in
lazymatch goal with
|- envs_entails ?Δ _ =>
let n := pm_eval (env_counter Δ) in
constr:(IAnon n)
end.
(* We make use of an Ltac hack to allow the [iFresh] tactic to both have a
side-effect (i.e. to bump the counter) and to return a value (the fresh name).
We do this by wrapped the side-effect under a [match] in a let-binding. See
https://stackoverflow.com/a/46178884 *)
let start :=
lazymatch goal with
| _ => iStartProof
end in
let c :=
lazymatch goal with
| |- envs_entails (Envs _ _ ?c) _ => c
end in
let inc :=
lazymatch goal with
| |- envs_entails (Envs ?Δp ?Δs _) ?Q =>
let c' := eval vm_compute in (Pos.succ c) in
convert_concl_no_check (envs_entails (Envs Δp Δs c') Q)
end in
constr:(IAnon c).
(** * Context manipulation *)
Tactic Notation "iRename" constr(H1) "into" constr(H2) :=
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment