Commit 86315b42 authored by Robbert Krebbers's avatar Robbert Krebbers

Generalize iNext to support multiple and iterated laters.

parent 4daa00cb
......@@ -127,7 +127,7 @@ Proof.
iSpecialize ("HΦ" with "[#]") => //. iFrame "HΦ".
iMod ("Hclose" $! (State High I) ( : set token) with "[-]"); last done.
iSplit; [iPureIntro; by eauto using signal_step|].
iNext. rewrite {2}/barrier_inv /ress /=; iFrame "Hl".
rewrite {2}/barrier_inv /ress /=. iNext. iFrame "Hl".
iDestruct "Hr" as (Ψ) "[Hr Hsp]"; iExists Ψ; iFrame "Hsp".
iNext. iIntros "_"; by iApply "Hr".
Qed.
......@@ -142,7 +142,7 @@ Proof.
as ([p I]) "(% & [Hl Hr] & Hclose)"; eauto.
wp_load. destruct p.
- iMod ("Hclose" $! (State Low I) {[ Change i ]} with "[Hl Hr]") as "Hγ".
{ iSplit; first done. iNext. rewrite {2}/barrier_inv /=. by iFrame. }
{ iSplit; first done. rewrite {2}/barrier_inv /=. by iFrame. }
iAssert (sts_ownS γ (i_states i) {[Change i]})%I with ">[Hγ]" as "Hγ".
{ iApply (sts_own_weaken with "Hγ"); eauto using i_states_closed. }
iModIntro. wp_if.
......@@ -155,7 +155,7 @@ Proof.
{ iNext. iApply (big_sepS_delete _ _ i); first done. by iApply "HΨ". }
iMod ("Hclose" $! (State High (I {[ i ]})) ( : set token) with "[HΨ' Hl Hsp]").
{ iSplit; [iPureIntro; by eauto using wait_step|].
iNext. rewrite {2}/barrier_inv /=; iFrame "Hl". iExists Ψ; iFrame. auto. }
rewrite {2}/barrier_inv /=. iNext. iFrame "Hl". iExists Ψ; iFrame. auto. }
iPoseProof (saved_prop_agree i Q (Ψ i) with "[#]") as "Heq"; first by auto.
iModIntro. wp_if.
iApply "HΦ". iApply "HQR". by iRewrite "Heq".
......@@ -175,7 +175,7 @@ Proof.
iMod ("Hclose" $! (State p ({[i1; i2]} I {[i]}))
{[Change i1; Change i2 ]} with "[-]") as "Hγ".
{ iSplit; first by eauto using split_step.
iNext. rewrite {2}/barrier_inv /=. iFrame "Hl".
rewrite {2}/barrier_inv /=. iNext. iFrame "Hl".
iApply (ress_split _ _ _ Q R1 R2); eauto. iFrame; auto. }
iAssert (sts_ownS γ (i_states i1) {[Change i1]}
sts_ownS γ (i_states i2) {[Change i2]})%I with ">[-]" as "[Hγ1 Hγ2]".
......
......@@ -15,7 +15,7 @@ Implicit Types Δ : envs (iResUR Σ).
Lemma tac_wp_alloc Δ Δ' E j e v Φ :
to_val e = Some v
(Δ heap_ctx) heapN E
IntoLaterEnvs Δ Δ'
IntoLaterNEnvs 1 Δ Δ'
( l, Δ'',
envs_app false (Esnoc Enil j (l v)) Δ' = Some Δ''
(Δ'' Φ (LitV (LitLoc l))))
......@@ -23,28 +23,28 @@ Lemma tac_wp_alloc Δ Δ' E j e v Φ :
Proof.
intros ???? HΔ. eapply wand_apply; first exact:wp_alloc. rewrite -always_and_sep_l.
apply and_intro; first done.
rewrite into_later_env_sound; apply later_mono, forall_intro=> l.
rewrite into_laterN_env_sound; apply later_mono, forall_intro=> l.
destruct (HΔ l) as (Δ''&?&HΔ'). rewrite envs_app_sound //; simpl.
by rewrite right_id HΔ'.
Qed.
Lemma tac_wp_load Δ Δ' E i l q v Φ :
(Δ heap_ctx) heapN E
IntoLaterEnvs Δ Δ'
IntoLaterNEnvs 1 Δ Δ'
envs_lookup i Δ' = Some (false, l {q} v)%I
(Δ' Φ v)
Δ WP Load (Lit (LitLoc l)) @ E {{ Φ }}.
Proof.
intros. eapply wand_apply; first exact:wp_load. rewrite -assoc -always_and_sep_l.
apply and_intro; first done.
rewrite into_later_env_sound -later_sep envs_lookup_split //; simpl.
rewrite into_laterN_env_sound -later_sep envs_lookup_split //; simpl.
by apply later_mono, sep_mono_r, wand_mono.
Qed.
Lemma tac_wp_store Δ Δ' Δ'' E i l v e v' Φ :
to_val e = Some v'
(Δ heap_ctx) heapN E
IntoLaterEnvs Δ Δ'
IntoLaterNEnvs 1 Δ Δ'
envs_lookup i Δ' = Some (false, l v)%I
envs_simple_replace i false (Esnoc Enil i (l v')) Δ' = Some Δ''
(Δ'' Φ (LitV LitUnit))
......@@ -52,28 +52,28 @@ Lemma tac_wp_store Δ Δ' Δ'' E i l v e v' Φ :
Proof.
intros. eapply wand_apply; first by eapply wp_store. rewrite -assoc -always_and_sep_l.
apply and_intro; first done.
rewrite into_later_env_sound -later_sep envs_simple_replace_sound //; simpl.
rewrite into_laterN_env_sound -later_sep envs_simple_replace_sound //; simpl.
rewrite right_id. by apply later_mono, sep_mono_r, wand_mono.
Qed.
Lemma tac_wp_cas_fail Δ Δ' E i l q v e1 v1 e2 v2 Φ :
to_val e1 = Some v1 to_val e2 = Some v2
(Δ heap_ctx) heapN E
IntoLaterEnvs Δ Δ'
IntoLaterNEnvs 1 Δ Δ'
envs_lookup i Δ' = Some (false, l {q} v)%I v v1
(Δ' Φ (LitV (LitBool false)))
Δ WP CAS (Lit (LitLoc l)) e1 e2 @ E {{ Φ }}.
Proof.
intros. eapply wand_apply; first exact:wp_cas_fail. rewrite -assoc -always_and_sep_l.
apply and_intro; first done.
rewrite into_later_env_sound -later_sep envs_lookup_split //; simpl.
rewrite into_laterN_env_sound -later_sep envs_lookup_split //; simpl.
by apply later_mono, sep_mono_r, wand_mono.
Qed.
Lemma tac_wp_cas_suc Δ Δ' Δ'' E i l v e1 v1 e2 v2 Φ :
to_val e1 = Some v1 to_val e2 = Some v2
(Δ heap_ctx) heapN E
IntoLaterEnvs Δ Δ'
IntoLaterNEnvs 1 Δ Δ'
envs_lookup i Δ' = Some (false, l v)%I v = v1
envs_simple_replace i false (Esnoc Enil i (l v2)) Δ' = Some Δ''
(Δ'' Φ (LitV (LitBool true)))
......@@ -81,7 +81,7 @@ Lemma tac_wp_cas_suc Δ Δ' Δ'' E i l v e1 v1 e2 v2 Φ :
Proof.
intros; subst. eapply wand_apply; first exact:wp_cas_suc. rewrite -assoc -always_and_sep_l.
apply and_intro; first done.
rewrite into_later_env_sound -later_sep envs_simple_replace_sound //; simpl.
rewrite into_laterN_env_sound -later_sep envs_simple_replace_sound //; simpl.
rewrite right_id. by apply later_mono, sep_mono_r, wand_mono.
Qed.
End heap.
......
This diff is collapsed.
......@@ -17,11 +17,11 @@ Global Arguments from_pure : clear implicits.
Class IntoPersistentP (P Q : uPred M) := into_persistentP : P Q.
Global Arguments into_persistentP : clear implicits.
Class IntoLater (P Q : uPred M) := into_later : P Q.
Global Arguments into_later _ _ {_}.
Class IntoLaterN (n : nat) (P Q : uPred M) := into_laterN : P ^n Q.
Global Arguments into_laterN _ _ _ {_}.
Class FromLater (P Q : uPred M) := from_later : Q P.
Global Arguments from_later _ _ {_}.
Class FromLaterN (n : nat) (P Q : uPred M) := from_laterN : ^n Q P.
Global Arguments from_laterN _ _ _ {_}.
Class IntoWand (R P Q : uPred M) := into_wand : R P - Q.
Global Arguments into_wand : clear implicits.
......
......@@ -401,38 +401,38 @@ Lemma tac_pure_revert Δ φ Q : (Δ ⊢ ⌜φ⌝ → Q) → (φ → Δ ⊢ Q).
Proof. intros HΔ ?. by rewrite HΔ pure_True // left_id. Qed.
(** * Later *)
Class IntoLaterEnv (Γ1 Γ2 : env (uPred M)) :=
into_later_env : env_Forall2 IntoLater Γ1 Γ2.
Class IntoLaterEnvs (Δ1 Δ2 : envs M) := {
into_later_persistent: IntoLaterEnv (env_persistent Δ1) (env_persistent Δ2);
into_later_spatial: IntoLaterEnv (env_spatial Δ1) (env_spatial Δ2)
Class IntoLaterNEnv (n : nat) (Γ1 Γ2 : env (uPred M)) :=
into_laterN_env : env_Forall2 (IntoLaterN n) Γ1 Γ2.
Class IntoLaterNEnvs (n : nat) (Δ1 Δ2 : envs M) := {
into_later_persistent: IntoLaterNEnv n (env_persistent Δ1) (env_persistent Δ2);
into_later_spatial: IntoLaterNEnv n (env_spatial Δ1) (env_spatial Δ2)
}.
Global Instance into_later_env_nil : IntoLaterEnv Enil Enil.
Global Instance into_laterN_env_nil n : IntoLaterNEnv n Enil Enil.
Proof. constructor. Qed.
Global Instance into_later_env_snoc Γ1 Γ2 i P Q :
IntoLaterEnv Γ1 Γ2 IntoLater P Q
IntoLaterEnv (Esnoc Γ1 i P) (Esnoc Γ2 i Q).
Global Instance into_laterN_env_snoc n Γ1 Γ2 i P Q :
IntoLaterNEnv n Γ1 Γ2 IntoLaterN n P Q
IntoLaterNEnv n (Esnoc Γ1 i P) (Esnoc Γ2 i Q).
Proof. by constructor. Qed.
Global Instance into_later_envs Γp1 Γp2 Γs1 Γs2 :
IntoLaterEnv Γp1 Γp2 IntoLaterEnv Γs1 Γs2
IntoLaterEnvs (Envs Γp1 Γs1) (Envs Γp2 Γs2).
Global Instance into_laterN_envs n Γp1 Γp2 Γs1 Γs2 :
IntoLaterNEnv n Γp1 Γp2 IntoLaterNEnv n Γs1 Γs2
IntoLaterNEnvs n (Envs Γp1 Γs1) (Envs Γp2 Γs2).
Proof. by split. Qed.
Lemma into_later_env_sound Δ1 Δ2 : IntoLaterEnvs Δ1 Δ2 Δ1 Δ2.
Lemma into_laterN_env_sound n Δ1 Δ2 : IntoLaterNEnvs n Δ1 Δ2 Δ1 ^n Δ2.
Proof.
intros [Hp Hs]; rewrite /of_envs /= !later_sep -always_later.
intros [Hp Hs]; rewrite /of_envs /= !laterN_sep -always_laterN.
repeat apply sep_mono; try apply always_mono.
- rewrite -later_intro; apply pure_mono; destruct 1; constructor;
- rewrite -laterN_intro; apply pure_mono; destruct 1; constructor;
naive_solver eauto using env_Forall2_wf, env_Forall2_fresh.
- induction Hp; rewrite /= ?later_sep. apply later_intro. by apply sep_mono.
- induction Hs; rewrite /= ?later_sep. apply later_intro. by apply sep_mono.
- induction Hp; rewrite /= ?laterN_sep. apply laterN_intro. by apply sep_mono.
- induction Hs; rewrite /= ?laterN_sep. apply laterN_intro. by apply sep_mono.
Qed.
Lemma tac_next Δ Δ' Q Q' :
IntoLaterEnvs Δ Δ' FromLater Q Q' (Δ' Q') Δ Q.
Proof. intros ?? HQ. by rewrite -(from_later Q) into_later_env_sound HQ. Qed.
Lemma tac_next Δ Δ' n Q Q' :
FromLaterN n Q Q' IntoLaterNEnvs n Δ Δ' (Δ' Q') Δ Q.
Proof. intros ?? HQ. by rewrite -(from_laterN n Q) into_laterN_env_sound HQ. Qed.
Lemma tac_löb Δ Δ' i Q :
env_spatial_is_nil Δ = true
......
......@@ -608,11 +608,17 @@ Tactic Notation "iAlways":=
[reflexivity || fail "iAlways: spatial context non-empty"|].
(** * Later *)
Tactic Notation "iNext":=
eapply tac_next;
[apply _
|let P := match goal with |- FromLater ?P _ => P end in
apply _ || fail "iNext:" P "does not contain laters"|].
Tactic Notation "iNext" open_constr(n) :=
let P := match goal with |- _ ?P => P end in
try lazymatch n with 0 => fail 1 "iNext: cannot strip 0 laters" end;
eapply (tac_next _ _ n);
[apply _ || fail "iNext:" P "does not contain" n "laters"
|lazymatch goal with
| |- IntoLaterNEnvs 0 _ _ => fail "iNext:" P "does not contain laters"
| _ => apply _
end|].
Tactic Notation "iNext":= iNext _.
(** * Update modality *)
Tactic Notation "iModIntro" :=
......
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