Commit 68c54ed9 authored by Ralf Jung's avatar Ralf Jung

Change the way we handle view shifts in post-conditions

Now we try to avoid adding them unnecessarily, so we don't have to remove them automatically any more.
parent 05a588df
...@@ -46,8 +46,8 @@ Lemma wp_match_inr E e0 x1 e1 x2 e2 Φ : ...@@ -46,8 +46,8 @@ Lemma wp_match_inr E e0 x1 e1 x2 e2 Φ :
Proof. intros. by rewrite -wp_case_inr // -[X in _ X]later_intro -wp_let. Qed. Proof. intros. by rewrite -wp_case_inr // -[X in _ X]later_intro -wp_let. Qed.
Lemma wp_le E (n1 n2 : Z) P Φ : Lemma wp_le E (n1 n2 : Z) P Φ :
(n1 n2 P |={E}=> Φ (LitV (LitBool true))) (n1 n2 P Φ (LitV (LitBool true)))
(n2 < n1 P |={E}=> Φ (LitV (LitBool false))) (n2 < n1 P Φ (LitV (LitBool false)))
P WP BinOp LeOp (Lit (LitInt n1)) (Lit (LitInt n2)) @ E {{ Φ }}. P WP BinOp LeOp (Lit (LitInt n1)) (Lit (LitInt n2)) @ E {{ Φ }}.
Proof. Proof.
intros. rewrite -wp_bin_op //; []. intros. rewrite -wp_bin_op //; [].
...@@ -55,8 +55,8 @@ Proof. ...@@ -55,8 +55,8 @@ Proof.
Qed. Qed.
Lemma wp_lt E (n1 n2 : Z) P Φ : Lemma wp_lt E (n1 n2 : Z) P Φ :
(n1 < n2 P |={E}=> Φ (LitV (LitBool true))) (n1 < n2 P Φ (LitV (LitBool true)))
(n2 n1 P |={E}=> Φ (LitV (LitBool false))) (n2 n1 P Φ (LitV (LitBool false)))
P WP BinOp LtOp (Lit (LitInt n1)) (Lit (LitInt n2)) @ E {{ Φ }}. P WP BinOp LtOp (Lit (LitInt n1)) (Lit (LitInt n2)) @ E {{ Φ }}.
Proof. Proof.
intros. rewrite -wp_bin_op //; []. intros. rewrite -wp_bin_op //; [].
...@@ -65,8 +65,8 @@ Qed. ...@@ -65,8 +65,8 @@ Qed.
Lemma wp_eq E e1 e2 v1 v2 P Φ : Lemma wp_eq E e1 e2 v1 v2 P Φ :
to_val e1 = Some v1 to_val e2 = Some v2 to_val e1 = Some v1 to_val e2 = Some v2
(v1 = v2 P |={E}=> Φ (LitV (LitBool true))) (v1 = v2 P Φ (LitV (LitBool true)))
(v1 v2 P |={E}=> Φ (LitV (LitBool false))) (v1 v2 P Φ (LitV (LitBool false)))
P WP BinOp EqOp e1 e2 @ E {{ Φ }}. P WP BinOp EqOp e1 e2 @ E {{ Φ }}.
Proof. Proof.
intros. rewrite -wp_bin_op //; []. intros. rewrite -wp_bin_op //; [].
......
...@@ -127,7 +127,7 @@ Section heap. ...@@ -127,7 +127,7 @@ Section heap.
iIntros (<-%of_to_val ? Φ) "[#Hinv HΦ]". rewrite /heap_ctx. iIntros (<-%of_to_val ? Φ) "[#Hinv HΦ]". rewrite /heap_ctx.
iMod (auth_empty heap_name) as "Ha". iMod (auth_empty heap_name) as "Ha".
iMod (auth_open with "[$Hinv $Ha]") as (σ) "(%&Hσ&Hcl)"; first done. iMod (auth_open with "[$Hinv $Ha]") as (σ) "(%&Hσ&Hcl)"; first done.
iApply wp_alloc_pst. iFrame "Hσ". iNext. iIntros (l) "[% Hσ] !>". iApply wp_alloc_pst. iFrame "Hσ". iNext. iIntros (l) "[% Hσ]".
iMod ("Hcl" with "* [Hσ]") as "Ha". iMod ("Hcl" with "* [Hσ]") as "Ha".
{ iFrame. iPureIntro. rewrite to_heap_insert. { iFrame. iPureIntro. rewrite to_heap_insert.
eapply alloc_singleton_local_update; by auto using lookup_to_heap_None. } eapply alloc_singleton_local_update; by auto using lookup_to_heap_None. }
...@@ -143,7 +143,7 @@ Section heap. ...@@ -143,7 +143,7 @@ Section heap.
rewrite /heap_ctx heap_mapsto_eq /heap_mapsto_def. rewrite /heap_ctx heap_mapsto_eq /heap_mapsto_def.
iMod (auth_open with "[$Hinv $Hl]") as (σ) "(%&Hσ&Hcl)"; first done. iMod (auth_open with "[$Hinv $Hl]") as (σ) "(%&Hσ&Hcl)"; first done.
iApply (wp_load_pst _ σ); first eauto using heap_singleton_included. iApply (wp_load_pst _ σ); first eauto using heap_singleton_included.
iIntros "{$Hσ}"; iNext; iIntros "Hσ !>". iIntros "{$Hσ}"; iNext; iIntros "Hσ".
iMod ("Hcl" with "* [Hσ]") as "Ha"; first eauto. by iApply "HΦ". iMod ("Hcl" with "* [Hσ]") as "Ha"; first eauto. by iApply "HΦ".
Qed. Qed.
...@@ -156,7 +156,7 @@ Section heap. ...@@ -156,7 +156,7 @@ Section heap.
rewrite /heap_ctx heap_mapsto_eq /heap_mapsto_def. rewrite /heap_ctx heap_mapsto_eq /heap_mapsto_def.
iMod (auth_open with "[$Hinv $Hl]") as (σ) "(%&Hσ&Hcl)"; first done. iMod (auth_open with "[$Hinv $Hl]") as (σ) "(%&Hσ&Hcl)"; first done.
iApply (wp_store_pst _ σ); first eauto using heap_singleton_included. iApply (wp_store_pst _ σ); first eauto using heap_singleton_included.
iIntros "{$Hσ}"; iNext; iIntros "Hσ !>". iMod ("Hcl" with "* [Hσ]") as "Ha". iIntros "{$Hσ}"; iNext; iIntros "Hσ". iMod ("Hcl" with "* [Hσ]") as "Ha".
{ iFrame. iPureIntro. rewrite to_heap_insert. { iFrame. iPureIntro. rewrite to_heap_insert.
eapply singleton_local_update, exclusive_local_update; last done. eapply singleton_local_update, exclusive_local_update; last done.
by eapply heap_singleton_included'. } by eapply heap_singleton_included'. }
...@@ -172,7 +172,7 @@ Section heap. ...@@ -172,7 +172,7 @@ Section heap.
rewrite /heap_ctx heap_mapsto_eq /heap_mapsto_def. rewrite /heap_ctx heap_mapsto_eq /heap_mapsto_def.
iMod (auth_open with "[$Hinv $Hl]") as (σ) "(%&Hσ&Hcl)"; first done. iMod (auth_open with "[$Hinv $Hl]") as (σ) "(%&Hσ&Hcl)"; first done.
iApply (wp_cas_fail_pst _ σ); [eauto using heap_singleton_included|done|]. iApply (wp_cas_fail_pst _ σ); [eauto using heap_singleton_included|done|].
iIntros "{$Hσ}"; iNext; iIntros "Hσ !>". iIntros "{$Hσ}"; iNext; iIntros "Hσ".
iMod ("Hcl" with "* [Hσ]") as "Ha"; first eauto. by iApply "HΦ". iMod ("Hcl" with "* [Hσ]") as "Ha"; first eauto. by iApply "HΦ".
Qed. Qed.
...@@ -184,8 +184,8 @@ Section heap. ...@@ -184,8 +184,8 @@ Section heap.
iIntros (<-%of_to_val <-%of_to_val ? Φ) "[[#Hinv >Hl] HΦ]". iIntros (<-%of_to_val <-%of_to_val ? Φ) "[[#Hinv >Hl] HΦ]".
rewrite /heap_ctx heap_mapsto_eq /heap_mapsto_def. rewrite /heap_ctx heap_mapsto_eq /heap_mapsto_def.
iMod (auth_open with "[$Hinv $Hl]") as (σ) "(%&Hσ&Hcl)"; first done. iMod (auth_open with "[$Hinv $Hl]") as (σ) "(%&Hσ&Hcl)"; first done.
iApply (wp_cas_suc_pst _ σ); first eauto using heap_singleton_included. iApply (wp_cas_suc_pst _ σ); first by eauto using heap_singleton_included.
iIntros "{$Hσ}"; iNext; iIntros "Hσ !>". iMod ("Hcl" with "* [Hσ]") as "Ha". iIntros "{$Hσ}". iNext. iIntros "Hσ". iMod ("Hcl" with "* [Hσ]") as "Ha".
{ iFrame. iPureIntro. rewrite to_heap_insert. { iFrame. iPureIntro. rewrite to_heap_insert.
eapply singleton_local_update, exclusive_local_update; last done. eapply singleton_local_update, exclusive_local_update; last done.
by eapply heap_singleton_included'. } by eapply heap_singleton_included'. }
......
...@@ -95,7 +95,7 @@ Lemma newbarrier_spec (P : iProp Σ) : ...@@ -95,7 +95,7 @@ Lemma newbarrier_spec (P : iProp Σ) :
{{{ heap_ctx }}} newbarrier #() {{{ l; #l, recv l P send l P }}}. {{{ heap_ctx }}} newbarrier #() {{{ l; #l, recv l P send l P }}}.
Proof. Proof.
iIntros (HN Φ) "[#? HΦ]". iIntros (HN Φ) "[#? HΦ]".
rewrite /newbarrier /=. wp_seq. wp_alloc l as "Hl". rewrite -wp_fupd /newbarrier /=. wp_seq. wp_alloc l as "Hl".
iApply ("HΦ" with ">[-]"). iApply ("HΦ" with ">[-]").
iMod (saved_prop_alloc (F:=idCF) P) as (γ) "#?". iMod (saved_prop_alloc (F:=idCF) P) as (γ) "#?".
iMod (sts_alloc (barrier_inv l P) _ N (State Low {[ γ ]}) with "[-]") iMod (sts_alloc (barrier_inv l P) _ N (State Low {[ γ ]}) with "[-]")
...@@ -158,7 +158,7 @@ Proof. ...@@ -158,7 +158,7 @@ Proof.
iNext. rewrite {2}/barrier_inv /=; iFrame "Hl". iExists Ψ; iFrame. auto. } iNext. rewrite {2}/barrier_inv /=; iFrame "Hl". iExists Ψ; iFrame. auto. }
iPoseProof (saved_prop_agree i Q (Ψ i) with "[#]") as "Heq"; first by auto. iPoseProof (saved_prop_agree i Q (Ψ i) with "[#]") as "Heq"; first by auto.
iModIntro. wp_if. iModIntro. wp_if.
iModIntro. iApply "HΦ". iApply "HQR". by iRewrite "Heq". iApply "HΦ". iApply "HQR". by iRewrite "Heq".
Qed. Qed.
Lemma recv_split E l P1 P2 : Lemma recv_split E l P1 P2 :
......
...@@ -37,7 +37,7 @@ Section mono_proof. ...@@ -37,7 +37,7 @@ Section mono_proof.
heapN N heapN N
{{{ heap_ctx }}} newcounter #() {{{ l; #l, mcounter l 0 }}}. {{{ heap_ctx }}} newcounter #() {{{ l; #l, mcounter l 0 }}}.
Proof. Proof.
iIntros (? Φ) "[#Hh HΦ]". rewrite /newcounter /=. wp_seq. wp_alloc l as "Hl". iIntros (? Φ) "[#Hh HΦ]". rewrite -wp_fupd /newcounter /=. wp_seq. wp_alloc l as "Hl".
iMod (own_alloc ( (O:mnat) (O:mnat))) as (γ) "[Hγ Hγ']"; first done. iMod (own_alloc ( (O:mnat) (O:mnat))) as (γ) "[Hγ Hγ']"; first done.
iMod (inv_alloc N _ (mcounter_inv γ l) with "[Hl Hγ]"). iMod (inv_alloc N _ (mcounter_inv γ l) with "[Hl Hγ]").
{ iNext. iExists 0%nat. by iFrame. } { iNext. iExists 0%nat. by iFrame. }
...@@ -114,7 +114,7 @@ Section contrib_spec. ...@@ -114,7 +114,7 @@ Section contrib_spec.
{{{ heap_ctx }}} newcounter #() {{{ heap_ctx }}} newcounter #()
{{{ γ l; #l, ccounter_ctx γ l ccounter γ 1 0 }}}. {{{ γ l; #l, ccounter_ctx γ l ccounter γ 1 0 }}}.
Proof. Proof.
iIntros (? Φ) "[#Hh HΦ]". rewrite /newcounter /=. wp_seq. wp_alloc l as "Hl". iIntros (? Φ) "[#Hh HΦ]". rewrite -wp_fupd /newcounter /=. wp_seq. wp_alloc l as "Hl".
iMod (own_alloc ( (Some (1%Qp, O%nat)) (Some (1%Qp, 0%nat)))) iMod (own_alloc ( (Some (1%Qp, O%nat)) (Some (1%Qp, 0%nat))))
as (γ) "[Hγ Hγ']"; first done. as (γ) "[Hγ Hγ']"; first done.
iMod (inv_alloc N _ (ccounter_inv γ l) with "[Hl Hγ]"). iMod (inv_alloc N _ (ccounter_inv γ l) with "[Hl Hγ]").
......
...@@ -23,7 +23,7 @@ Lemma par_spec (Ψ1 Ψ2 : val → iProp Σ) e (f1 f2 : val) (Φ : val → iProp ...@@ -23,7 +23,7 @@ Lemma par_spec (Ψ1 Ψ2 : val → iProp Σ) e (f1 f2 : val) (Φ : val → iProp
WP par e {{ Φ }}. WP par e {{ Φ }}.
Proof. Proof.
iIntros (?) "(#Hh&Hf1&Hf2&HΦ)". iIntros (?) "(#Hh&Hf1&Hf2&HΦ)".
rewrite /par. wp_value. iModIntro. wp_let. wp_proj. rewrite /par. wp_value. wp_let. wp_proj.
wp_apply (spawn_spec parN with "[- $Hh $Hf1]"); try wp_done; try solve_ndisj. wp_apply (spawn_spec parN with "[- $Hh $Hf1]"); try wp_done; try solve_ndisj.
iIntros (l) "Hl". wp_let. wp_proj. wp_bind (f2 _). iIntros (l) "Hl". wp_let. wp_proj. wp_bind (f2 _).
iApply (wp_wand_r with "[- $Hf2]"); iIntros (v) "H2". wp_let. iApply (wp_wand_r with "[- $Hf2]"); iIntros (v) "H2". wp_let.
......
...@@ -57,7 +57,7 @@ Proof. ...@@ -57,7 +57,7 @@ Proof.
iMod (inv_alloc N _ (spawn_inv γ l Ψ) with "[Hl]") as "#?". iMod (inv_alloc N _ (spawn_inv γ l Ψ) with "[Hl]") as "#?".
{ iNext. iExists NONEV. iFrame; eauto. } { iNext. iExists NONEV. iFrame; eauto. }
wp_apply wp_fork; simpl. iSplitR "Hf". wp_apply wp_fork; simpl. iSplitR "Hf".
- iModIntro. wp_seq. iModIntro. iApply "HΦ". rewrite /join_handle. eauto. - wp_seq. iApply "HΦ". rewrite /join_handle. eauto.
- wp_bind (f _). iApply (wp_wand_r with "[ $Hf]"); iIntros (v) "Hv". - wp_bind (f _). iApply (wp_wand_r with "[ $Hf]"); iIntros (v) "Hv".
iInv N as (v') "[Hl _]" "Hclose". iInv N as (v') "[Hl _]" "Hclose".
wp_store. iApply "Hclose". iNext. iExists (SOMEV v). iFrame. eauto. wp_store. iApply "Hclose". iNext. iExists (SOMEV v). iFrame. eauto.
......
...@@ -49,7 +49,7 @@ Section proof. ...@@ -49,7 +49,7 @@ Section proof.
heapN N heapN N
{{{ heap_ctx R }}} newlock #() {{{ lk γ; lk, is_lock γ lk R }}}. {{{ heap_ctx R }}} newlock #() {{{ lk γ; lk, is_lock γ lk R }}}.
Proof. Proof.
iIntros (? Φ) "[[#Hh HR] HΦ]". rewrite /newlock /=. iIntros (? Φ) "[[#Hh HR] HΦ]". rewrite -wp_fupd /newlock /=.
wp_seq. wp_alloc l as "Hl". wp_seq. wp_alloc l as "Hl".
iMod (own_alloc (Excl ())) as (γ) "Hγ"; first done. iMod (own_alloc (Excl ())) as (γ) "Hγ"; first done.
iMod (inv_alloc N _ (lock_inv γ l R) with "[-HΦ]") as "#?". iMod (inv_alloc N _ (lock_inv γ l R) with "[-HΦ]") as "#?".
...@@ -75,7 +75,7 @@ Section proof. ...@@ -75,7 +75,7 @@ Section proof.
Proof. Proof.
iIntros (Φ) "[#Hl HΦ]". iLöb as "IH". wp_rec. iIntros (Φ) "[#Hl HΦ]". iLöb as "IH". wp_rec.
wp_apply (try_acquire_spec with "[- $Hl]"). iIntros ([]). wp_apply (try_acquire_spec with "[- $Hl]"). iIntros ([]).
- iIntros "[Hlked HR]". wp_if. iModIntro. iApply "HΦ"; iFrame. - iIntros "[Hlked HR]". wp_if. iApply "HΦ"; iFrame.
- iIntros "_". wp_if. iApply ("IH" with "[HΦ]"). auto. - iIntros "_". wp_if. iApply ("IH" with "[HΦ]"). auto.
Qed. Qed.
......
...@@ -78,7 +78,7 @@ Section proof. ...@@ -78,7 +78,7 @@ Section proof.
heapN N heapN N
{{{ heap_ctx R }}} newlock #() {{{ lk γ; lk, is_lock γ lk R }}}. {{{ heap_ctx R }}} newlock #() {{{ lk γ; lk, is_lock γ lk R }}}.
Proof. Proof.
iIntros (HN Φ) "((#Hh & HR) & HΦ)". rewrite /newlock /=. iIntros (HN Φ) "((#Hh & HR) & HΦ)". rewrite -wp_fupd /newlock /=.
wp_seq. wp_alloc lo as "Hlo". wp_alloc ln as "Hln". wp_seq. wp_alloc lo as "Hlo". wp_alloc ln as "Hln".
iMod (own_alloc ( (Excl' 0%nat, ) (Excl' 0%nat, ))) as (γ) "[Hγ Hγ']". iMod (own_alloc ( (Excl' 0%nat, ) (Excl' 0%nat, ))) as (γ) "[Hγ Hγ']".
{ by rewrite -auth_both_op. } { by rewrite -auth_both_op. }
...@@ -99,7 +99,7 @@ Section proof. ...@@ -99,7 +99,7 @@ Section proof.
+ iMod ("Hclose" with "[Hlo Hln Hainv Ht]") as "_". + iMod ("Hclose" with "[Hlo Hln Hainv Ht]") as "_".
{ iNext. iExists o, n. iFrame. eauto. } { iNext. iExists o, n. iFrame. eauto. }
iModIntro. wp_let. wp_op=>[_|[]] //. iModIntro. wp_let. wp_op=>[_|[]] //.
wp_if. iModIntro. wp_if.
iApply ("HΦ" with "[-]"). rewrite /locked. iFrame. eauto. iApply ("HΦ" with "[-]"). rewrite /locked. iFrame. eauto.
+ iDestruct (own_valid_2 with "[$Ht $Haown]") as % [_ ?%gset_disj_valid_op]. + iDestruct (own_valid_2 with "[$Ht $Haown]") as % [_ ?%gset_disj_valid_op].
set_solver. set_solver.
......
...@@ -46,47 +46,47 @@ Lemma wp_bind_ctxi {E e} Ki Φ : ...@@ -46,47 +46,47 @@ Lemma wp_bind_ctxi {E e} Ki Φ :
Proof. exact: weakestpre.wp_bind. Qed. Proof. exact: weakestpre.wp_bind. Qed.
(** Base axioms for core primitives of the language: Stateful reductions. *) (** Base axioms for core primitives of the language: Stateful reductions. *)
Lemma wp_alloc_pst E σ v Φ : Lemma wp_alloc_pst E σ v :
ownP σ ( l, σ !! l = None ownP (<[l:=v]>σ) ={E}= Φ (LitV (LitLoc l))) {{{ ownP σ }}} Alloc (of_val v) @ E
WP Alloc (of_val v) @ E {{ Φ }}. {{{ l; LitV (LitLoc l), σ !! l = None ownP (<[l:=v]>σ) }}}.
Proof. Proof.
iIntros "[HP HΦ]". iIntros (Φ) "[HP HΦ]".
iApply (wp_lift_atomic_head_step (Alloc (of_val v)) σ); eauto. iApply (wp_lift_atomic_head_step (Alloc (of_val v)) σ); eauto.
iFrame "HP". iNext. iIntros (v2 σ2 ef) "[% HP]". inv_head_step. iFrame "HP". iNext. iIntros (v2 σ2 ef) "[% HP]". inv_head_step.
match goal with H: _ = of_val v2 |- _ => apply (inj of_val (LitV _)) in H end. match goal with H: _ = of_val v2 |- _ => apply (inj of_val (LitV _)) in H end.
subst v2. iSplit. iApply "HΦ"; by iSplit. by iApply big_sepL_nil. subst v2. iSplit. iApply "HΦ"; by iSplit. by iApply big_sepL_nil.
Qed. Qed.
Lemma wp_load_pst E σ l v Φ : Lemma wp_load_pst E σ l v :
σ !! l = Some v σ !! l = Some v
ownP σ (ownP σ ={E}= Φ v) WP Load (Lit (LitLoc l)) @ E {{ Φ }}. {{{ ownP σ }}} Load (Lit (LitLoc l)) @ E {{{; v, ownP σ }}}.
Proof. Proof.
intros. rewrite -(wp_lift_atomic_det_head_step' σ v σ); eauto. intros ? Φ. rewrite -(wp_lift_atomic_det_head_step' σ v σ); eauto.
intros; inv_head_step; eauto. intros; inv_head_step; eauto.
Qed. Qed.
Lemma wp_store_pst E σ l v v' Φ : Lemma wp_store_pst E σ l v v' :
σ !! l = Some v' σ !! l = Some v'
ownP σ (ownP (<[l:=v]>σ) ={E}= Φ (LitV LitUnit)) {{{ ownP σ }}} Store (Lit (LitLoc l)) (of_val v) @ E
WP Store (Lit (LitLoc l)) (of_val v) @ E {{ Φ }}. {{{; LitV LitUnit, ownP (<[l:=v]>σ) }}}.
Proof. Proof.
intros. rewrite-(wp_lift_atomic_det_head_step' σ (LitV LitUnit) (<[l:=v]>σ)); eauto. intros. rewrite-(wp_lift_atomic_det_head_step' σ (LitV LitUnit) (<[l:=v]>σ)); eauto.
intros; inv_head_step; eauto. intros; inv_head_step; eauto.
Qed. Qed.
Lemma wp_cas_fail_pst E σ l v1 v2 v' Φ : Lemma wp_cas_fail_pst E σ l v1 v2 v' :
σ !! l = Some v' v' v1 σ !! l = Some v' v' v1
ownP σ (ownP σ ={E}= Φ (LitV $ LitBool false)) {{{ ownP σ }}} CAS (Lit (LitLoc l)) (of_val v1) (of_val v2) @ E
WP CAS (Lit (LitLoc l)) (of_val v1) (of_val v2) @ E {{ Φ }}. {{{; LitV $ LitBool false, ownP σ }}}.
Proof. Proof.
intros. rewrite -(wp_lift_atomic_det_head_step' σ (LitV $ LitBool false) σ); eauto. intros. rewrite -(wp_lift_atomic_det_head_step' σ (LitV $ LitBool false) σ); eauto.
intros; inv_head_step; eauto. intros; inv_head_step; eauto.
Qed. Qed.
Lemma wp_cas_suc_pst E σ l v1 v2 Φ : Lemma wp_cas_suc_pst E σ l v1 v2 :
σ !! l = Some v1 σ !! l = Some v1
ownP σ (ownP (<[l:=v2]>σ) ={E}= Φ (LitV $ LitBool true)) {{{ ownP σ }}} CAS (Lit (LitLoc l)) (of_val v1) (of_val v2) @ E
WP CAS (Lit (LitLoc l)) (of_val v1) (of_val v2) @ E {{ Φ }}. {{{; LitV $ LitBool true, ownP (<[l:=v2]>σ) }}}.
Proof. Proof.
intros. rewrite -(wp_lift_atomic_det_head_step' σ (LitV $ LitBool true) intros. rewrite -(wp_lift_atomic_det_head_step' σ (LitV $ LitBool true)
(<[l:=v2]>σ)); eauto. (<[l:=v2]>σ)); eauto.
...@@ -95,10 +95,10 @@ Qed. ...@@ -95,10 +95,10 @@ Qed.
(** Base axioms for core primitives of the language: Stateless reductions *) (** Base axioms for core primitives of the language: Stateless reductions *)
Lemma wp_fork E e Φ : Lemma wp_fork E e Φ :
(|={E}=> Φ (LitV LitUnit)) WP e {{ _, True }} WP Fork e @ E {{ Φ }}. Φ (LitV LitUnit) WP e {{ _, True }} WP Fork e @ E {{ Φ }}.
Proof. Proof.
rewrite -(wp_lift_pure_det_head_step (Fork e) (Lit LitUnit) [e]) //=; eauto. rewrite -(wp_lift_pure_det_head_step (Fork e) (Lit LitUnit) [e]) //=; eauto.
- by rewrite later_sep -(wp_value_fupd _ _ (Lit _)) // big_sepL_singleton. - by rewrite later_sep -(wp_value _ _ (Lit _)) // big_sepL_singleton.
- intros; inv_head_step; eauto. - intros; inv_head_step; eauto.
Qed. Qed.
...@@ -116,20 +116,20 @@ Qed. ...@@ -116,20 +116,20 @@ Qed.
Lemma wp_un_op E op e v v' Φ : Lemma wp_un_op E op e v v' Φ :
to_val e = Some v to_val e = Some v
un_op_eval op v = Some v' un_op_eval op v = Some v'
(|={E}=> Φ v') WP UnOp op e @ E {{ Φ }}. Φ v' WP UnOp op e @ E {{ Φ }}.
Proof. Proof.
intros. rewrite -(wp_lift_pure_det_head_step' (UnOp op _) (of_val v')) intros. rewrite -(wp_lift_pure_det_head_step' (UnOp op _) (of_val v'))
-?wp_value_fupd'; eauto. -?wp_value'; eauto.
intros; inv_head_step; eauto. intros; inv_head_step; eauto.
Qed. Qed.
Lemma wp_bin_op E op e1 e2 v1 v2 v' Φ : Lemma wp_bin_op E op e1 e2 v1 v2 v' Φ :
to_val e1 = Some v1 to_val e2 = Some v2 to_val e1 = Some v1 to_val e2 = Some v2
bin_op_eval op v1 v2 = Some v' bin_op_eval op v1 v2 = Some v'
(|={E}=> Φ v') WP BinOp op e1 e2 @ E {{ Φ }}. (Φ v') WP BinOp op e1 e2 @ E {{ Φ }}.
Proof. Proof.
intros. rewrite -(wp_lift_pure_det_head_step' (BinOp op _ _) (of_val v')) intros. rewrite -(wp_lift_pure_det_head_step' (BinOp op _ _) (of_val v'))
-?wp_value_fupd'; eauto. -?wp_value'; eauto.
intros; inv_head_step; eauto. intros; inv_head_step; eauto.
Qed. Qed.
...@@ -149,19 +149,19 @@ Qed. ...@@ -149,19 +149,19 @@ Qed.
Lemma wp_fst E e1 v1 e2 Φ : Lemma wp_fst E e1 v1 e2 Φ :
to_val e1 = Some v1 is_Some (to_val e2) to_val e1 = Some v1 is_Some (to_val e2)
(|={E}=> Φ v1) WP Fst (Pair e1 e2) @ E {{ Φ }}. Φ v1 WP Fst (Pair e1 e2) @ E {{ Φ }}.
Proof. Proof.
intros ? [v2 ?]. intros ? [v2 ?].
rewrite -(wp_lift_pure_det_head_step' (Fst _) e1) -?wp_value_fupd; eauto. rewrite -(wp_lift_pure_det_head_step' (Fst _) e1) -?wp_value; eauto.
intros; inv_head_step; eauto. intros; inv_head_step; eauto.
Qed. Qed.
Lemma wp_snd E e1 e2 v2 Φ : Lemma wp_snd E e1 e2 v2 Φ :
is_Some (to_val e1) to_val e2 = Some v2 is_Some (to_val e1) to_val e2 = Some v2
(|={E}=> Φ v2) WP Snd (Pair e1 e2) @ E {{ Φ }}. Φ v2 WP Snd (Pair e1 e2) @ E {{ Φ }}.
Proof. Proof.
intros [v1 ?] ?. intros [v1 ?] ?.
rewrite -(wp_lift_pure_det_head_step' (Snd _) e2) -?wp_value_fupd; eauto. rewrite -(wp_lift_pure_det_head_step' (Snd _) e2) -?wp_value; eauto.
intros; inv_head_step; eauto. intros; inv_head_step; eauto.
Qed. Qed.
......
...@@ -22,10 +22,10 @@ Lemma tac_wp_alloc Δ Δ' E j e v Φ : ...@@ -22,10 +22,10 @@ Lemma tac_wp_alloc Δ Δ' E j e v Φ :
IntoLaterEnvs Δ Δ' IntoLaterEnvs Δ Δ'
( l, Δ'', ( l, Δ'',
envs_app false (Esnoc Enil j (l v)) Δ' = Some Δ'' envs_app false (Esnoc Enil j (l v)) Δ' = Some Δ''
(Δ'' |={E}=> Φ (LitV (LitLoc l)))) (Δ'' Φ (LitV (LitLoc l))))
Δ WP Alloc e @ E {{ Φ }}. Δ WP Alloc e @ E {{ Φ }}.
Proof. Proof.
intros ???? HΔ. rewrite -wp_fupd -wp_alloc // -always_and_sep_l. intros ???? HΔ. rewrite -wp_alloc // -always_and_sep_l.
apply and_intro; first done. apply and_intro; first done.
rewrite into_later_env_sound; apply later_mono, forall_intro=> l. rewrite into_later_env_sound; apply later_mono, forall_intro=> l.
destruct (HΔ l) as (Δ''&?&HΔ'). rewrite envs_app_sound //; simpl. destruct (HΔ l) as (Δ''&?&HΔ'). rewrite envs_app_sound //; simpl.
...@@ -36,10 +36,10 @@ Lemma tac_wp_load Δ Δ' E i l q v Φ : ...@@ -36,10 +36,10 @@ Lemma tac_wp_load Δ Δ' E i l q v Φ :
(Δ heap_ctx) nclose heapN E (Δ heap_ctx) nclose heapN E
IntoLaterEnvs Δ Δ' IntoLaterEnvs Δ Δ'
envs_lookup i Δ' = Some (false, l {q} v)%I envs_lookup i Δ' = Some (false, l {q} v)%I
(Δ' |={E}=> Φ v) (Δ' Φ v)
Δ WP Load (Lit (LitLoc l)) @ E {{ Φ }}. Δ WP Load (Lit (LitLoc l)) @ E {{ Φ }}.
Proof. Proof.
intros. rewrite -wp_fupd -wp_load // -assoc -always_and_sep_l. intros. rewrite -wp_load // -assoc -always_and_sep_l.
apply and_intro; first done. apply and_intro; first done.
rewrite into_later_env_sound -later_sep envs_lookup_split //; simpl. rewrite into_later_env_sound -later_sep envs_lookup_split //; simpl.
by apply later_mono, sep_mono_r, wand_mono. by apply later_mono, sep_mono_r, wand_mono.
...@@ -51,10 +51,10 @@ Lemma tac_wp_store Δ Δ' Δ'' E i l v e v' Φ : ...@@ -51,10 +51,10 @@ Lemma tac_wp_store Δ Δ' Δ'' E i l v e v' Φ :
IntoLaterEnvs Δ Δ' IntoLaterEnvs Δ Δ'
envs_lookup i Δ' = Some (false, l v)%I envs_lookup i Δ' = Some (false, l v)%I
envs_simple_replace i false (Esnoc Enil i (l v')) Δ' = Some Δ'' envs_simple_replace i false (Esnoc Enil i (l v')) Δ' = Some Δ''
(Δ'' |={E}=> Φ (LitV LitUnit)) (Δ'' Φ (LitV LitUnit))
Δ WP Store (Lit (LitLoc l)) e @ E {{ Φ }}. Δ WP Store (Lit (LitLoc l)) e @ E {{ Φ }}.
Proof. Proof.
intros. rewrite -wp_fupd -wp_store // -assoc -always_and_sep_l. intros. rewrite -wp_store // -assoc -always_and_sep_l.
apply and_intro; first done. apply and_intro; first done.
rewrite into_later_env_sound -later_sep envs_simple_replace_sound //; simpl. rewrite into_later_env_sound -later_sep envs_simple_replace_sound //; simpl.
rewrite right_id. by apply later_mono, sep_mono_r, wand_mono. rewrite right_id. by apply later_mono, sep_mono_r, wand_mono.
...@@ -65,10 +65,10 @@ Lemma tac_wp_cas_fail Δ Δ' E i l q v e1 v1 e2 v2 Φ : ...@@ -65,10 +65,10 @@ Lemma tac_wp_cas_fail Δ Δ' E i l q v e1 v1 e2 v2 Φ :
(Δ heap_ctx) nclose heapN E (Δ heap_ctx) nclose heapN E
IntoLaterEnvs Δ Δ' IntoLaterEnvs Δ Δ'
envs_lookup i Δ' = Some (false, l {q} v)%I v v1 envs_lookup i Δ' = Some (false, l {q} v)%I v v1
(Δ' |={E}=> Φ (LitV (LitBool false))) (Δ' Φ (LitV (LitBool false)))
Δ WP CAS (Lit (LitLoc l)) e1 e2 @ E {{ Φ }}. Δ WP CAS (Lit (LitLoc l)) e1 e2 @ E {{ Φ }}.
Proof. Proof.
intros. rewrite -wp_fupd -wp_cas_fail // -assoc -always_and_sep_l. intros. rewrite -wp_cas_fail // -assoc -always_and_sep_l.
apply and_intro; first done. apply and_intro; first done.
rewrite into_later_env_sound -later_sep envs_lookup_split //; simpl. rewrite into_later_env_sound -later_sep envs_lookup_split //; simpl.
by apply later_mono, sep_mono_r, wand_mono. by apply later_mono, sep_mono_r, wand_mono.
...@@ -80,10 +80,10 @@ Lemma tac_wp_cas_suc Δ Δ' Δ'' E i l v e1 v1 e2 v2 Φ : ...@@ -80,10 +80,10 @@ Lemma tac_wp_cas_suc Δ Δ' Δ'' E i l v e1 v1 e2 v2 Φ :
IntoLaterEnvs Δ Δ' IntoLaterEnvs Δ Δ'