Commit 6cb76aaa authored by Ralf Jung's avatar Ralf Jung

Merge branch 'ralf/texan' into 'master'

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.

The overall tally in the proofs (i.e., excluding changes in proof mode and lifting lemmas) is: 14 removed `iModIntro` (and equivalent tactics), 7 insertions of `wp_fupd`. So it seems we actually more often do not need that final update than we do need it. Not to mention this also simplifies the lifting lemmas and the proof mode, doing less unnecessary work (adding updates and then removing them again).

On the minus side, *if* the update is missing, unexperienced users will have a hard time figuring out what to do. The change typically needs to be made at the beginning of the proof, the problem only surfaces at the end. This could be mitigated by providing a tactic for proving texan triples that does the `wp_fupd` (and the introducing the `\Phi`). While this would re-add most of the 14 removed `iModIntro`, we could still keep the simplified lifting lemmas and proof mode.

Cc @robbertkrebbers @jjourdan what do you think?

See merge request !20
parents 05a588df e354bede
...@@ -352,14 +352,8 @@ Lemma wand_elim_r P Q : P ★ (P -★ Q) ⊢ Q. ...@@ -352,14 +352,8 @@ Lemma wand_elim_r P Q : P ★ (P -★ Q) ⊢ Q.
Proof. rewrite (comm _ P); apply wand_elim_l. Qed. Proof. rewrite (comm _ P); apply wand_elim_l. Qed.
Lemma wand_elim_r' P Q R : (Q P - R) P Q R. Lemma wand_elim_r' P Q R : (Q P - R) P Q R.
Proof. intros ->; apply wand_elim_r. Qed. Proof. intros ->; apply wand_elim_r. Qed.
Lemma wand_apply_l P Q Q' R R' : (P Q' - R') (R' R) (Q Q') P Q R. Lemma wand_apply P Q R S : (P Q - R) (S P Q) S R.
Proof. intros -> -> <-; apply wand_elim_l. Qed. Proof. intros HR%wand_elim_l' HQ. by rewrite HQ. Qed.
Lemma wand_apply_r P Q Q' R R' : (P Q' - R') (R' R) (Q Q') Q P R.
Proof. intros -> -> <-; apply wand_elim_r. Qed.
Lemma wand_apply_l' P Q Q' R : (P Q' - R) (Q Q') P Q R.
Proof. intros -> <-; apply wand_elim_l. Qed.
Lemma wand_apply_r' P Q Q' R : (P Q' - R) (Q Q') Q P R.
Proof. intros -> <-; apply wand_elim_r. Qed.
Lemma wand_frame_l P Q R : (Q - R) P Q - P R. Lemma wand_frame_l P Q R : (Q - R) P Q - P R.
Proof. apply wand_intro_l. rewrite -assoc. apply sep_mono_r, wand_elim_r. Qed. Proof. apply wand_intro_l. rewrite -assoc. apply sep_mono_r, wand_elim_r. Qed.
Lemma wand_frame_r P Q R : (Q - R) Q P - R P. Lemma wand_frame_r P Q R : (Q - R) Q P - R P.
......
...@@ -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 //; [].
......
...@@ -122,12 +122,12 @@ Section heap. ...@@ -122,12 +122,12 @@ Section heap.
(** Weakest precondition *) (** Weakest precondition *)
Lemma wp_alloc E e v : Lemma wp_alloc E e v :
to_val e = Some v nclose heapN E to_val e = Some v nclose heapN E
{{{ heap_ctx }}} Alloc e @ E {{{ l; LitV (LitLoc l), l v }}}. {{{ heap_ctx }}} Alloc e @ E {{{ l, RET LitV (LitLoc l); l v }}}.
Proof. Proof.
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 with "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. }
...@@ -137,26 +137,26 @@ Section heap. ...@@ -137,26 +137,26 @@ Section heap.
Lemma wp_load E l q v : Lemma wp_load E l q v :
nclose heapN E nclose heapN E
{{{ heap_ctx l {q} v }}} Load (Lit (LitLoc l)) @ E {{{ heap_ctx l {q} v }}} Load (Lit (LitLoc l)) @ E
{{{; v, l {q} v }}}. {{{ RET v; l {q} v }}}.
Proof. Proof.
iIntros (? Φ) "[[#Hinv >Hl] HΦ]". iIntros (? Φ) "[#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_load_pst _ σ); first eauto using heap_singleton_included. iApply (wp_load_pst _ σ with "Hσ"); first eauto using heap_singleton_included.
iIntros "{$Hσ}"; iNext; 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.
Lemma wp_store E l v' e v : Lemma wp_store E l v' e v :
to_val e = Some v nclose heapN E to_val e = Some v nclose heapN E
{{{ heap_ctx l v' }}} Store (Lit (LitLoc l)) e @ E {{{ heap_ctx l v' }}} Store (Lit (LitLoc l)) e @ E
{{{; LitV LitUnit, l v }}}. {{{ RET LitV LitUnit; l v }}}.
Proof. Proof.
iIntros (<-%of_to_val ? Φ) "[[#Hinv >Hl] HΦ]". iIntros (<-%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_store_pst _ σ); first eauto using heap_singleton_included. iApply (wp_store_pst _ σ with "Hσ"); first eauto using heap_singleton_included.
iIntros "{$Hσ}"; iNext; iIntros "Hσ !>". iMod ("Hcl" with "* [Hσ]") as "Ha". 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'. }
...@@ -166,26 +166,26 @@ Section heap. ...@@ -166,26 +166,26 @@ Section heap.
Lemma wp_cas_fail E l q v' e1 v1 e2 v2 : Lemma wp_cas_fail E l q v' e1 v1 e2 v2 :
to_val e1 = Some v1 to_val e2 = Some v2 v' v1 nclose heapN E to_val e1 = Some v1 to_val e2 = Some v2 v' v1 nclose heapN E
{{{ heap_ctx l {q} v' }}} CAS (Lit (LitLoc l)) e1 e2 @ E {{{ heap_ctx l {q} v' }}} CAS (Lit (LitLoc l)) e1 e2 @ E
{{{; LitV (LitBool false), l {q} v' }}}. {{{ RET LitV (LitBool false); l {q} v' }}}.
Proof. Proof.
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_fail_pst _ σ); [eauto using heap_singleton_included|done|]. iApply (wp_cas_fail_pst _ σ with "Hσ"); [eauto using heap_singleton_included|done|].
iIntros "{$Hσ}"; iNext; 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.
Lemma wp_cas_suc E l e1 v1 e2 v2 : Lemma wp_cas_suc E l e1 v1 e2 v2 :
to_val e1 = Some v1 to_val e2 = Some v2 nclose heapN E to_val e1 = Some v1 to_val e2 = Some v2 nclose heapN E
{{{ heap_ctx l v1 }}} CAS (Lit (LitLoc l)) e1 e2 @ E {{{ heap_ctx l v1 }}} CAS (Lit (LitLoc l)) e1 e2 @ E
{{{; LitV (LitBool true), l v2 }}}. {{{ RET LitV (LitBool true); l v2 }}}.
Proof. Proof.
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 _ σ with "Hσ"); first by eauto using heap_singleton_included.
iIntros "{$Hσ}"; iNext; iIntros "Hσ !>". iMod ("Hcl" with "* [Hσ]") as "Ha". 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'. }
......
...@@ -92,10 +92,10 @@ Qed. ...@@ -92,10 +92,10 @@ Qed.
(** Actual proofs *) (** Actual proofs *)
Lemma newbarrier_spec (P : iProp Σ) : Lemma newbarrier_spec (P : iProp Σ) :
heapN N heapN N
{{{ heap_ctx }}} newbarrier #() {{{ l; #l, recv l P send l P }}}. {{{ heap_ctx }}} newbarrier #() {{{ l, RET #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 "[-]")
...@@ -117,10 +117,10 @@ Proof. ...@@ -117,10 +117,10 @@ Proof.
Qed. Qed.
Lemma signal_spec l P : Lemma signal_spec l P :
{{{ send l P P }}} signal #l {{{; #(), True }}}. {{{ send l P P }}} signal #l {{{ RET #(); True }}}.
Proof. Proof.
rewrite /signal /send /barrier_ctx /=. rewrite /signal /send /barrier_ctx /=.
iIntros (Φ) "((Hs&HP)&)"; iDestruct "Hs" as (γ) "[#(%&Hh&Hsts) Hγ]". wp_let. iIntros (Φ) "(Hs&HP) HΦ"; iDestruct "Hs" as (γ) "[#(%&Hh&Hsts) Hγ]". wp_let.
iMod (sts_openS (barrier_inv l P) _ _ γ with "[Hγ]") iMod (sts_openS (barrier_inv l P) _ _ γ with "[Hγ]")
as ([p I]) "(% & [Hl Hr] & Hclose)"; eauto. as ([p I]) "(% & [Hl Hr] & Hclose)"; eauto.
destruct p; [|done]. wp_store. destruct p; [|done]. wp_store.
...@@ -133,10 +133,10 @@ Proof. ...@@ -133,10 +133,10 @@ Proof.
Qed. Qed.
Lemma wait_spec l P: Lemma wait_spec l P:
{{{ recv l P }}} wait #l {{{ ; #(), P }}}. {{{ recv l P }}} wait #l {{{ RET #(); P }}}.
Proof. Proof.
rename P into R; rewrite /recv /barrier_ctx. rename P into R; rewrite /recv /barrier_ctx.
iIntros (Φ) "[Hr HΦ]"; iDestruct "Hr" as (γ P Q i) "(#(%&Hh&Hsts)&Hγ&#HQ&HQR)". iIntros (Φ) "Hr HΦ"; iDestruct "Hr" as (γ P Q i) "(#(%&Hh&Hsts)&Hγ&#HQ&HQR)".
iLöb as "IH". wp_rec. wp_bind (! _)%E. iLöb as "IH". wp_rec. wp_bind (! _)%E.
iMod (sts_openS (barrier_inv l P) _ _ γ with "[Hγ]") iMod (sts_openS (barrier_inv l P) _ _ γ with "[Hγ]")
as ([p I]) "(% & [Hl Hr] & Hclose)"; eauto. as ([p I]) "(% & [Hl Hr] & Hclose)"; eauto.
...@@ -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 :
......
...@@ -20,10 +20,10 @@ Proof. ...@@ -20,10 +20,10 @@ Proof.
intros HN. intros HN.
exists (λ l, CofeMor (recv N l)), (λ l, CofeMor (send N l)). exists (λ l, CofeMor (recv N l)), (λ l, CofeMor (send N l)).
split_and?; simpl. split_and?; simpl.
- iIntros (P) "#? !# _". iApply (newbarrier_spec _ P); first done. - iIntros (P) "#? !# _". iApply (newbarrier_spec _ P with "[]"); [done..|].
iSplit; first done. iNext. eauto. iNext. eauto.
- iIntros (l P) "!# [Hl HP]". iApply signal_spec; iFrame "Hl HP"; by eauto. - iIntros (l P) "!# [Hl HP]". iApply (signal_spec with "[$Hl $HP]"). by eauto.
- iIntros (l P) "!# Hl". iApply wait_spec; iFrame "Hl"; eauto. - iIntros (l P) "!# Hl". iApply (wait_spec with "Hl"). eauto.
- iIntros (l P Q) "!#". by iApply recv_split. - iIntros (l P Q) "!#". by iApply recv_split.
- apply recv_weaken. - apply recv_weaken.
Qed. Qed.
......
...@@ -35,9 +35,9 @@ Section mono_proof. ...@@ -35,9 +35,9 @@ Section mono_proof.
Lemma newcounter_mono_spec (R : iProp Σ) : Lemma newcounter_mono_spec (R : iProp Σ) :
heapN N heapN N
{{{ heap_ctx }}} newcounter #() {{{ l; #l, mcounter l 0 }}}. {{{ heap_ctx }}} newcounter #() {{{ l, RET #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. }
...@@ -45,9 +45,9 @@ Section mono_proof. ...@@ -45,9 +45,9 @@ Section mono_proof.
Qed. Qed.
Lemma inc_mono_spec l n : Lemma inc_mono_spec l n :
{{{ mcounter l n }}} inc #l {{{; #(), mcounter l (S n) }}}. {{{ mcounter l n }}} inc #l {{{ RET #(); mcounter l (S n) }}}.
Proof. Proof.
iIntros (Φ) "[Hl HΦ]". iLöb as "IH". wp_rec. iIntros (Φ) "Hl HΦ". iLöb as "IH". wp_rec.
iDestruct "Hl" as (γ) "(% & #? & #Hinv & Hγf)". iDestruct "Hl" as (γ) "(% & #? & #Hinv & Hγf)".
wp_bind (! _)%E. iInv N as (c) ">[Hγ Hl]" "Hclose". wp_bind (! _)%E. iInv N as (c) ">[Hγ Hl]" "Hclose".
wp_load. iMod ("Hclose" with "[Hl Hγ]") as "_"; [iNext; iExists c; by iFrame|]. wp_load. iMod ("Hclose" with "[Hl Hγ]") as "_"; [iNext; iExists c; by iFrame|].
...@@ -70,9 +70,9 @@ Section mono_proof. ...@@ -70,9 +70,9 @@ Section mono_proof.
Qed. Qed.
Lemma read_mono_spec l j : Lemma read_mono_spec l j :
{{{ mcounter l j }}} read #l {{{ i; #i, (j i)%nat mcounter l i }}}. {{{ mcounter l j }}} read #l {{{ i, RET #i; (j i)%nat mcounter l i }}}.
Proof. Proof.
iIntros (ϕ) "[Hc HΦ]". iDestruct "Hc" as (γ) "(% & #? & #Hinv & Hγf)". iIntros (ϕ) "Hc HΦ". iDestruct "Hc" as (γ) "(% & #? & #Hinv & Hγf)".
rewrite /read /=. wp_let. iInv N as (c) ">[Hγ Hl]" "Hclose". wp_load. rewrite /read /=. wp_let. iInv N as (c) ">[Hγ Hl]" "Hclose". wp_load.
iDestruct (own_valid_2 with "[$Hγ $Hγf]") iDestruct (own_valid_2 with "[$Hγ $Hγf]")
as %[?%mnat_included _]%auth_valid_discrete_2. as %[?%mnat_included _]%auth_valid_discrete_2.
...@@ -112,9 +112,9 @@ Section contrib_spec. ...@@ -112,9 +112,9 @@ Section contrib_spec.
Lemma newcounter_contrib_spec (R : iProp Σ) : Lemma newcounter_contrib_spec (R : iProp Σ) :
heapN N heapN N
{{{ heap_ctx }}} newcounter #() {{{ heap_ctx }}} newcounter #()
{{{ γ l; #l, ccounter_ctx γ l ccounter γ 1 0 }}}. {{{ γ l, RET #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γ]").
...@@ -124,9 +124,9 @@ Section contrib_spec. ...@@ -124,9 +124,9 @@ Section contrib_spec.
Lemma inc_contrib_spec γ l q n : Lemma inc_contrib_spec γ l q n :
{{{ ccounter_ctx γ l ccounter γ q n }}} inc #l {{{ ccounter_ctx γ l ccounter γ q n }}} inc #l
{{{; #(), ccounter γ q (S n) }}}. {{{ RET #(); ccounter γ q (S n) }}}.
Proof. Proof.
iIntros (Φ) "((#(%&?&?) & Hγf) & )". iLöb as "IH". wp_rec. iIntros (Φ) "(#(%&?&?) & Hγf) HΦ". iLöb as "IH". wp_rec.
wp_bind (! _)%E. iInv N as (c) ">[Hγ Hl]" "Hclose". wp_bind (! _)%E. iInv N as (c) ">[Hγ Hl]" "Hclose".
wp_load. iMod ("Hclose" with "[Hl Hγ]") as "_"; [iNext; iExists c; by iFrame|]. wp_load. iMod ("Hclose" with "[Hl Hγ]") as "_"; [iNext; iExists c; by iFrame|].
iModIntro. wp_let. wp_op. iModIntro. wp_let. wp_op.
...@@ -145,9 +145,9 @@ Section contrib_spec. ...@@ -145,9 +145,9 @@ Section contrib_spec.
Lemma read_contrib_spec γ l q n : Lemma read_contrib_spec γ l q n :
{{{ ccounter_ctx γ l ccounter γ q n }}} read #l {{{ ccounter_ctx γ l ccounter γ q n }}} read #l
{{{ c; #c, (n c)%nat ccounter γ q n }}}. {{{ c, RET #c; (n c)%nat ccounter γ q n }}}.
Proof. Proof.
iIntros (Φ) "((#(%&?&?) & Hγf) & )". iIntros (Φ) "(#(%&?&?) & Hγf) HΦ".
rewrite /read /=. wp_let. iInv N as (c) ">[Hγ Hl]" "Hclose". wp_load. rewrite /read /=. wp_let. iInv N as (c) ">[Hγ Hl]" "Hclose". wp_load.
iDestruct (own_valid_2 with "[$Hγ $Hγf]") iDestruct (own_valid_2 with "[$Hγ $Hγf]")
as %[[? ?%nat_included]%Some_pair_included_total_2 _]%auth_valid_discrete_2. as %[[? ?%nat_included]%Some_pair_included_total_2 _]%auth_valid_discrete_2.
...@@ -157,9 +157,9 @@ Section contrib_spec. ...@@ -157,9 +157,9 @@ Section contrib_spec.
Lemma read_contrib_spec_1 γ l n : Lemma read_contrib_spec_1 γ l n :
{{{ ccounter_ctx γ l ccounter γ 1 n }}} read #l {{{ ccounter_ctx γ l ccounter γ 1 n }}} read #l
{{{ n; #n, ccounter γ 1 n }}}. {{{ n, RET #n; ccounter γ 1 n }}}.
Proof. Proof.
iIntros (Φ) "((#(%&?&?) & Hγf) & )". iIntros (Φ) "(#(%&?&?) & Hγf) HΦ".
rewrite /read /=. wp_let. iInv N as (c) ">[Hγ Hl]" "Hclose". wp_load. rewrite /read /=. wp_let. iInv N as (c) ">[Hγ Hl]" "Hclose". wp_load.
iDestruct (own_valid_2 with "[$Hγ $Hγf]") as %[Hn _]%auth_valid_discrete_2. iDestruct (own_valid_2 with "[$Hγ $Hγf]") as %[Hn _]%auth_valid_discrete_2.
apply (Some_included_exclusive _) in Hn as [= ->]%leibniz_equiv; last done. apply (Some_included_exclusive _) in Hn as [= ->]%leibniz_equiv; last done.
......
...@@ -18,11 +18,11 @@ Structure lock Σ `{!heapG Σ} := Lock { ...@@ -18,11 +18,11 @@ Structure lock Σ `{!heapG Σ} := Lock {
(* -- operation specs -- *) (* -- operation specs -- *)
newlock_spec N (R : iProp Σ) : newlock_spec N (R : iProp Σ) :
heapN N heapN N
{{{ heap_ctx R }}} newlock #() {{{ lk γ; lk, is_lock N γ lk R }}}; {{{ heap_ctx R }}} newlock #() {{{ lk γ, RET lk; is_lock N γ lk R }}};
acquire_spec N γ lk R : acquire_spec N γ lk R :
{{{ is_lock N γ lk R }}} acquire lk {{{; #(), locked γ R }}}; {{{ is_lock N γ lk R }}} acquire lk {{{ RET #(); locked γ R }}};
release_spec N γ lk R : release_spec N γ lk R :
{{{ is_lock N γ lk R locked γ R }}} release lk {{{; #(), True }}} {{{ is_lock N γ lk R locked γ R }}} release lk {{{ RET #(); True }}}
}. }.
Arguments newlock {_ _} _. Arguments newlock {_ _} _.
......
...@@ -16,6 +16,10 @@ Global Opaque par. ...@@ -16,6 +16,10 @@ Global Opaque par.
Section proof. Section proof.
Context `{!heapG Σ, !spawnG Σ}. Context `{!heapG Σ, !spawnG Σ}.
(* Notice that this allows us to strip a later *after* the two Ψ have been
brought together. That is strictly stronger than first stripping a later
and then merging them, as demonstrated by [tests/joining_existentials.v].
This is why these are not Texan triples. *)
Lemma par_spec (Ψ1 Ψ2 : val iProp Σ) e (f1 f2 : val) (Φ : val iProp Σ) : Lemma par_spec (Ψ1 Ψ2 : val iProp Σ) e (f1 f2 : val) (Φ : val iProp Σ) :
to_val e = Some (f1,f2)%V to_val e = Some (f1,f2)%V
(heap_ctx WP f1 #() {{ Ψ1 }} WP f2 #() {{ Ψ2 }} (heap_ctx WP f1 #() {{ Ψ1 }} WP f2 #() {{ Ψ2 }}
...@@ -23,11 +27,11 @@ Lemma par_spec (Ψ1 Ψ2 : val → iProp Σ) e (f1 f2 : val) (Φ : val → iProp ...@@ -23,11 +27,11 @@ 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.
wp_apply (join_spec with "[- $Hl]"). iIntros (w) "H1". wp_apply (join_spec with "[$Hl]"). iIntros (w) "H1".
iSpecialize ("HΦ" with "* [-]"); first by iSplitL "H1". by wp_let. iSpecialize ("HΦ" with "* [-]"); first by iSplitL "H1". by wp_let.
Qed. Qed.
......
...@@ -49,31 +49,31 @@ Proof. solve_proper. Qed. ...@@ -49,31 +49,31 @@ Proof. solve_proper. Qed.
Lemma spawn_spec (Ψ : val iProp Σ) e (f : val) : Lemma spawn_spec (Ψ : val iProp Σ) e (f : val) :
to_val e = Some f to_val e = Some f
heapN N heapN N
{{{ heap_ctx WP f #() {{ Ψ }} }}} spawn e {{{ l; #l, join_handle l Ψ }}}. {{{ heap_ctx WP f #() {{ Ψ }} }}} spawn e {{{ l, RET #l; join_handle l Ψ }}}.
Proof. Proof.
iIntros (<-%of_to_val ? Φ) "((#Hh & Hf) & )". rewrite /spawn /=. iIntros (<-%of_to_val ? Φ) "(#Hh & Hf) HΦ". rewrite /spawn /=.
wp_let. wp_alloc l as "Hl". wp_let. wp_let. wp_alloc l as "Hl". wp_let.
iMod (own_alloc (Excl ())) as (γ) "Hγ"; first done. iMod (own_alloc (Excl ())) as (γ) "Hγ"; first done.
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.
Qed. Qed.
Lemma join_spec (Ψ : val iProp Σ) l : Lemma join_spec (Ψ : val iProp Σ) l :
{{{ join_handle l Ψ }}} join #l {{{ v; v, Ψ v }}}. {{{ join_handle l Ψ }}} join #l {{{ v, RET v; Ψ v }}}.
Proof. Proof.
rewrite /join_handle; iIntros (Φ) "[[% H] Hv]". iDestruct "H" as (γ) "(#?&Hγ&#?)". rewrite /join_handle; iIntros (Φ) "[% H] HΦ". iDestruct "H" as (γ) "(#?&Hγ&#?)".
iLöb as "IH". wp_rec. wp_bind (! _)%E. iInv N as (v) "[Hl Hinv]" "Hclose". iLöb as "IH". wp_rec. wp_bind (! _)%E. iInv N as (v) "[Hl Hinv]" "Hclose".
wp_load. iDestruct "Hinv" as "[%|Hinv]"; subst. wp_load. iDestruct "Hinv" as "[%|Hinv]"; subst.
- iMod ("Hclose" with "[Hl]"); [iNext; iExists _; iFrame; eauto|]. - iMod ("Hclose" with "[Hl]"); [iNext; iExists _; iFrame; eauto|].
iModIntro. wp_match. iApply ("IH" with "Hγ [H