Commit 39b9a3c5 authored by Ralf Jung's avatar Ralf Jung
Browse files

Merge branch 'janno/hoare-notation' into 'master'

Add triple notation for generalized post-condition

This changeset defines notation for the Iris style of writing Hoare triples:

`{{{ P }}} e {{{ v1 .. vn; T, Q }}} := P ★ (∀ v1 .. vn, Q → Φ T) ⊢ WP e {{ Φ }}`

For no good reason the notation is parsing only, although I do not declare it as such. We might want to do that though, since it might be too hard to understand a Hoare triple goal without unfolding it.

I have changed the barrier specifications to use the new notation in an attempt to demonstrate their usefulness (or, at a minimum, their applicability). The changes are rather minimal, as you can see.

## Changes

First and foremost, the specifications change. (Duh!)
Then, there are three kinds of changes to the proofs:
1. The first `iIntros` needs to take care of introducing `Φ`. No big deal, in my opinion.
2. Introducing the spatial assumptions needs one additional level of structure since we go from

    ```P1 ★ P2 ★ (∀ v, Q v -★ Φ v)```
to
   ```(P1 ★ P2) ★ (∀ v, Q v -★ Φ v)```

3. A post-condition of `True` leads to the rather annoying hypothesis `True -★ Φ v`, which (as far as I can tell) cannot be made to behave the same as just (Φ v) in the context of `iFrame`.

## Applicability

I have also looked at most other examples of specifications in heap_lang/lib.  The notation seems to be applicable to almost all of them. The only place where I spotted an obvious mismatch is par.v, where the current lemmas have a later before the generalized post-condition, as in `... ★ (∀ .., ... -★ ▷ Φ ..) ⊢ WP ..`. We could always add another pair of notations for this special case, I suppose.

## Nomenclature
I think "Texan triple" would be a good name, seeing how everything is bigger in Texas, including the number of curly braces.

See merge request !9
parents c476d109 90ba4346
...@@ -171,9 +171,11 @@ Notation "(★)" := uPred_sep (only parsing) : uPred_scope. ...@@ -171,9 +171,11 @@ Notation "(★)" := uPred_sep (only parsing) : uPred_scope.
Notation "P -★ Q" := (uPred_wand P Q) Notation "P -★ Q" := (uPred_wand P Q)
(at level 99, Q at level 200, right associativity) : uPred_scope. (at level 99, Q at level 200, right associativity) : uPred_scope.
Notation "∀ x .. y , P" := Notation "∀ x .. y , P" :=
(uPred_forall (λ x, .. (uPred_forall (λ y, P)) ..)%I) : uPred_scope. (uPred_forall (λ x, .. (uPred_forall (λ y, P)) ..)%I)
(at level 200, x binder, y binder, right associativity) : uPred_scope.
Notation "∃ x .. y , P" := Notation "∃ x .. y , P" :=
(uPred_exist (λ x, .. (uPred_exist (λ y, P)) ..)%I) : uPred_scope. (uPred_exist (λ x, .. (uPred_exist (λ y, P)) ..)%I)
(at level 200, x binder, y binder, right associativity) : uPred_scope.
Notation "□ P" := (uPred_always P) Notation "□ P" := (uPred_always P)
(at level 20, right associativity) : uPred_scope. (at level 20, right associativity) : uPred_scope.
Notation "▷ P" := (uPred_later P) Notation "▷ P" := (uPred_later P)
......
...@@ -104,11 +104,11 @@ Section heap. ...@@ -104,11 +104,11 @@ Section heap.
Proof. by rewrite heap_mapsto_op_half. Qed. Proof. by rewrite heap_mapsto_op_half. Qed.
(** 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 ( l, l v ={E}= Φ (LitV (LitLoc l))) WP Alloc e @ E {{ Φ }}. {{{ heap_ctx }}} Alloc e @ E {{{ l; 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. iFrame "Hσ". iNext. iIntros (l) "[% Hσ] !>".
...@@ -118,12 +118,12 @@ Section heap. ...@@ -118,12 +118,12 @@ Section heap.
iApply "HΦ". by rewrite heap_mapsto_eq /heap_mapsto_def. iApply "HΦ". by rewrite heap_mapsto_eq /heap_mapsto_def.
Qed. Qed.
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 (l {q} v ={E}= Φ v) {{{ heap_ctx l {q} v }}} Load (Lit (LitLoc l)) @ E
WP Load (Lit (LitLoc l)) @ E {{ Φ }}. {{{; 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 _ σ); first eauto using heap_singleton_included.
...@@ -131,12 +131,12 @@ Section heap. ...@@ -131,12 +131,12 @@ Section heap.
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' (l v ={E}= Φ (LitV LitUnit)) {{{ heap_ctx l v' }}} Store (Lit (LitLoc l)) e @ E
WP Store (Lit (LitLoc l)) e @ E {{ Φ }}. {{{; 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 _ σ); first eauto using heap_singleton_included.
...@@ -147,12 +147,12 @@ Section heap. ...@@ -147,12 +147,12 @@ Section heap.
by iApply "HΦ". by iApply "HΦ".
Qed. Qed.
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' (l {q} v' ={E}= Φ (LitV (LitBool false))) {{{ heap_ctx l {q} v' }}} CAS (Lit (LitLoc l)) e1 e2 @ E
WP CAS (Lit (LitLoc l)) e1 e2 @ E {{ Φ }}. {{{; 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 _ σ); [eauto using heap_singleton_included|done|].
...@@ -160,12 +160,12 @@ Section heap. ...@@ -160,12 +160,12 @@ Section heap.
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 (l v2 ={E}= Φ (LitV (LitBool true))) {{{ heap_ctx l v1 }}} CAS (Lit (LitLoc l)) e1 e2 @ E
WP CAS (Lit (LitLoc l)) e1 e2 @ E {{ Φ }}. {{{; 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 _ σ); first eauto using heap_singleton_included.
......
...@@ -91,11 +91,11 @@ Proof. ...@@ -91,11 +91,11 @@ Proof.
Qed. Qed.
(** Actual proofs *) (** Actual proofs *)
Lemma newbarrier_spec (P : iProp Σ) (Φ : val iProp Σ) : Lemma newbarrier_spec (P : iProp Σ) :
heapN N heapN N
heap_ctx ( l, recv l P send l P - Φ #l) WP newbarrier #() {{ Φ }}. {{{ 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 /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 (γ) "#?".
...@@ -117,14 +117,15 @@ Proof. ...@@ -117,14 +117,15 @@ Proof.
- auto. - auto.
Qed. Qed.
Lemma signal_spec l P (Φ : val iProp Σ) : Lemma signal_spec l P :
send l P P Φ #() WP signal #l {{ Φ }}. {{{ send l P P }}} signal #l {{{; #(), True }}}.
Proof. Proof.
rewrite /signal /send /barrier_ctx /=. rewrite /signal /send /barrier_ctx /=.
iIntros "(Hs&HP&HΦ)"; 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. iFrame "HΦ". destruct p; [|done]. wp_store.
iSpecialize ("HΦ" with "[#]") => //. iFrame "HΦ".
iMod ("Hclose" $! (State High I) ( : set token) with "[-]"); last done. iMod ("Hclose" $! (State High I) ( : set token) with "[-]"); last done.
iSplit; [iPureIntro; by eauto using signal_step|]. iSplit; [iPureIntro; by eauto using signal_step|].
iNext. rewrite {2}/barrier_inv /ress /=; iFrame "Hl". iNext. rewrite {2}/barrier_inv /ress /=; iFrame "Hl".
...@@ -132,11 +133,11 @@ Proof. ...@@ -132,11 +133,11 @@ Proof.
iNext. iIntros "_"; by iApply "Hr". iNext. iIntros "_"; by iApply "Hr".
Qed. Qed.
Lemma wait_spec l P (Φ : val iProp Σ) : Lemma wait_spec l P:
recv l P (P - Φ #()) WP wait #l {{ Φ }}. {{{ recv l P }}} wait #l {{{ ; #(), 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.
...@@ -146,7 +147,7 @@ Proof. ...@@ -146,7 +147,7 @@ Proof.
iAssert (sts_ownS γ (i_states i) {[Change i]})%I with ">[Hγ]" as "Hγ". iAssert (sts_ownS γ (i_states i) {[Change i]})%I with ">[Hγ]" as "Hγ".
{ iApply (sts_own_weaken with "Hγ"); eauto using i_states_closed. } { iApply (sts_own_weaken with "Hγ"); eauto using i_states_closed. }
iModIntro. wp_if. iModIntro. wp_if.
iApply ("IH" with "Hγ [HQR] HΦ"). auto. iApply ("IH" with "Hγ [HQR] []"); auto.
- (* a High state: the comparison succeeds, and we perform a transition and - (* a High state: the comparison succeeds, and we perform a transition and
return to the client *) return to the client *)
iDestruct "Hr" as (Ψ) "[HΨ Hsp]". iDestruct "Hr" as (Ψ) "[HΨ Hsp]".
......
...@@ -20,8 +20,9 @@ Proof. ...@@ -20,8 +20,9 @@ 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); eauto. - iIntros (P) "#? !# _". iApply (newbarrier_spec _ P); first done.
- iIntros (l P) "!# [Hl HP]". by iApply signal_spec; iFrame "Hl HP". iSplit; first done. iNext. eauto.
- iIntros (l P) "!# [Hl HP]". iApply signal_spec; iFrame "Hl HP"; by eauto.
- iIntros (l P) "!# Hl". iApply wait_spec; iFrame "Hl"; eauto. - iIntros (l P) "!# Hl". iApply wait_spec; iFrame "Hl"; eauto.
- iIntros (l P Q) "!#". by iApply recv_split. - iIntros (l P Q) "!#". by iApply recv_split.
- apply recv_weaken. - apply recv_weaken.
......
...@@ -33,21 +33,21 @@ Section mono_proof. ...@@ -33,21 +33,21 @@ Section mono_proof.
Global Instance mcounter_persistent l n : PersistentP (mcounter l n). Global Instance mcounter_persistent l n : PersistentP (mcounter l n).
Proof. apply _. Qed. Proof. apply _. Qed.
Lemma newcounter_mono_spec (R : iProp Σ) Φ : Lemma newcounter_mono_spec (R : iProp Σ) :
heapN N heapN N
heap_ctx ( l, mcounter l 0 - Φ #l) WP newcounter #() {{ Φ }}. {{{ 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 /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. }
iModIntro. iApply "HΦ". rewrite /mcounter; eauto 10. iModIntro. iApply "HΦ". rewrite /mcounter; eauto 10.
Qed. Qed.
Lemma inc_mono_spec l n (Φ : val iProp Σ) : Lemma inc_mono_spec l n :
mcounter l n (mcounter l (S n) - Φ #()) WP inc #l {{ Φ }}. {{{ mcounter l n }}} inc #l {{{; #(), 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|].
...@@ -65,22 +65,21 @@ Section mono_proof. ...@@ -65,22 +65,21 @@ Section mono_proof.
by apply mnat_included, le_n_S. by apply mnat_included, le_n_S.
- wp_cas_fail; first (by intros [= ?%Nat2Z.inj]). - wp_cas_fail; first (by intros [= ?%Nat2Z.inj]).
iMod ("Hclose" with "[Hl Hγ]") as "_"; [iNext; iExists c'; by iFrame|]. iMod ("Hclose" with "[Hl Hγ]") as "_"; [iNext; iExists c'; by iFrame|].
iModIntro. wp_if. iApply ("IH" with "[Hγf] HΦ"). iModIntro. wp_if. iApply ("IH" with "[Hγf] []"); last by auto.
rewrite {3}/mcounter; eauto 10. rewrite {3}/mcounter; eauto 10.
Qed. Qed.
Lemma read_mono_spec l j (Φ : val iProp Σ) : Lemma read_mono_spec l j :
mcounter l j ( i, (j i)%nat mcounter l i - Φ #i) {{{ mcounter l j }}} read #l {{{ i; #i, (j i)%nat mcounter l i }}}.
WP read #l {{ Φ }}.
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.
iMod (own_update_2 with "[$Hγ $Hγf]") as "[Hγ Hγf]". iMod (own_update_2 with "[$Hγ $Hγf]") as "[Hγ Hγf]".
{ apply auth_update, (mnat_local_update _ _ c); auto. } { apply auth_update, (mnat_local_update _ _ c); auto. }
iMod ("Hclose" with "[Hl Hγ]") as "_"; [iNext; iExists c; by iFrame|]. iMod ("Hclose" with "[Hl Hγ]") as "_"; [iNext; iExists c; by iFrame|].
iApply ("HΦ" with "[%]"); rewrite /mcounter; eauto 10. iApply ("HΦ" with "[-]"). rewrite /mcounter; eauto 10.
Qed. Qed.
End mono_proof. End mono_proof.
...@@ -110,12 +109,12 @@ Section contrib_spec. ...@@ -110,12 +109,12 @@ Section contrib_spec.
ccounter γ (q1 + q2) (n1 + n2) ccounter γ q1 n1 ccounter γ q2 n2. ccounter γ (q1 + q2) (n1 + n2) ccounter γ q1 n1 ccounter γ q2 n2.
Proof. by rewrite /ccounter -own_op -auth_frag_op. Qed. Proof. by rewrite /ccounter -own_op -auth_frag_op. Qed.
Lemma newcounter_contrib_spec (R : iProp Σ) Φ : Lemma newcounter_contrib_spec (R : iProp Σ) :
heapN N heapN N
heap_ctx ( γ l, ccounter_ctx γ l ccounter γ 1 0 - Φ #l) {{{ heap_ctx }}} newcounter #()
WP newcounter #() {{ Φ }}. {{{ γ 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 /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γ]").
...@@ -123,11 +122,11 @@ Section contrib_spec. ...@@ -123,11 +122,11 @@ Section contrib_spec.
iModIntro. iApply "HΦ". rewrite /ccounter_ctx /ccounter; eauto 10. iModIntro. iApply "HΦ". rewrite /ccounter_ctx /ccounter; eauto 10.
Qed. Qed.
Lemma inc_contrib_spec γ l q n (Φ : val iProp Σ) : Lemma inc_contrib_spec γ l q n :
ccounter_ctx γ l ccounter γ q n (ccounter γ q (S n) - Φ #()) {{{ ccounter_ctx γ l ccounter γ q n }}} inc #l
WP inc #l {{ Φ }}. {{{; #(), ccounter γ q (S n) }}}.
Proof. Proof.
iIntros "(#(%&?&?) & Hγf & HΦ)". 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.
...@@ -141,27 +140,26 @@ Section contrib_spec. ...@@ -141,27 +140,26 @@ Section contrib_spec.
iModIntro. wp_if. by iApply "HΦ". iModIntro. wp_if. by iApply "HΦ".
- wp_cas_fail; first (by intros [= ?%Nat2Z.inj]). - wp_cas_fail; first (by intros [= ?%Nat2Z.inj]).
iMod ("Hclose" with "[Hl Hγ]") as "_"; [iNext; iExists c'; by iFrame|]. iMod ("Hclose" with "[Hl Hγ]") as "_"; [iNext; iExists c'; by iFrame|].
iModIntro. wp_if. by iApply ("IH" with "[Hγf] HΦ"). iModIntro. wp_if. by iApply ("IH" with "[Hγf] []"); auto.
Qed. Qed.
Lemma read_contrib_spec γ l q n (Φ : val iProp Σ) : Lemma read_contrib_spec γ l q n :
ccounter_ctx γ l ccounter γ q n {{{ ccounter_ctx γ l ccounter γ q n }}} read #l
( c, (n c)%nat ccounter γ q n - Φ #c) {{{ c; #c, (n c)%nat ccounter γ q n }}}.
WP read #l {{ Φ }}.
Proof. Proof.
iIntros "(#(%&?&?) & Hγf & HΦ)". 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.
iMod ("Hclose" with "[Hl Hγ]") as "_"; [iNext; iExists c; by iFrame|]. iMod ("Hclose" with "[Hl Hγ]") as "_"; [iNext; iExists c; by iFrame|].
iApply ("HΦ" with "[%]"); rewrite /ccounter; eauto 10. iApply ("HΦ" with "[-]"); rewrite /ccounter; eauto 10.
Qed. Qed.
Lemma read_contrib_spec_1 γ l n (Φ : val iProp Σ) : Lemma read_contrib_spec_1 γ l n :
ccounter_ctx γ l ccounter γ 1 n (ccounter γ 1 n - Φ #n) {{{ ccounter_ctx γ l ccounter γ 1 n }}} read #l
WP read #l {{ Φ }}. {{{ n; #n, ccounter γ 1 n }}}.
Proof. Proof.
iIntros "(#(%&?&?) & Hγf & HΦ)". 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.
......
...@@ -16,13 +16,13 @@ Structure lock Σ `{!heapG Σ} := Lock { ...@@ -16,13 +16,13 @@ Structure lock Σ `{!heapG Σ} := Lock {
locked_timeless γ : TimelessP (locked γ); locked_timeless γ : TimelessP (locked γ);
locked_exclusive γ : locked γ locked γ False; locked_exclusive γ : locked γ locked γ False;
(* -- operation specs -- *) (* -- operation specs -- *)
newlock_spec N (R : iProp Σ) Φ : newlock_spec N (R : iProp Σ) :
heapN N heapN N
heap_ctx R ( l γ, is_lock N γ l R - Φ l) WP newlock #() {{ Φ }}; {{{ heap_ctx R }}} newlock #() {{{ lk γ; lk, is_lock N γ lk R }}};
acquire_spec N γ lk R (Φ : val iProp Σ) : acquire_spec N γ lk R :
is_lock N γ lk R (locked γ - R - Φ #()) WP acquire lk {{ Φ }}; {{{ is_lock N γ lk R }}} acquire lk {{{; #(), locked γ R }}};
release_spec N γ lk R (Φ : val iProp Σ) : release_spec N γ lk R :
is_lock N γ lk R locked γ R Φ #() WP release lk {{ Φ }} {{{ is_lock N γ lk R locked γ R }}} release lk {{{; #(), True }}}
}. }.
Arguments newlock {_ _} _. Arguments newlock {_ _} _.
......
...@@ -19,15 +19,15 @@ Context `{!heapG Σ, !spawnG Σ}. ...@@ -19,15 +19,15 @@ Context `{!heapG Σ, !spawnG Σ}.
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 }}
v1 v2, Ψ1 v1 Ψ2 v2 - Φ (v1,v2)%V) v1 v2, Ψ1 v1 Ψ2 v2 - Φ (v1,v2)%V)
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. iModIntro. wp_let. wp_proj.
wp_apply (spawn_spec parN); try wp_done; try solve_ndisj; iFrame "Hf1 Hh". wp_apply (spawn_spec parN); try wp_done; try solve_ndisj; iFrame "Hf1 Hh".
iIntros (l) "Hl". wp_let. wp_proj. wp_bind (f2 _). iNext. iIntros (l) "Hl". wp_let. wp_proj. wp_bind (f2 _).
iApply wp_wand_l; iFrame "Hf2"; iIntros (v) "H2". wp_let. iApply wp_wand_l; iFrame "Hf2"; iIntros (v) "H2". wp_let.
wp_apply join_spec; iFrame "Hl". iIntros (w) "H1". wp_apply join_spec; iFrame "Hl". iNext. 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.
......
...@@ -46,13 +46,12 @@ Global Instance join_handle_ne n l : ...@@ -46,13 +46,12 @@ Global Instance join_handle_ne n l :
Proof. solve_proper. Qed. Proof. solve_proper. Qed.
(** The main proofs. *) (** The main proofs. *)
Lemma spawn_spec (Ψ : val iProp Σ) e (f : val) (Φ : val iProp Σ) : 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 #() {{ Ψ }} ( l, join_handle l Ψ - Φ #l) {{{ heap_ctx WP f #() {{ Ψ }} }}} spawn e {{{ l; #l, join_handle l Ψ }}}.
WP spawn e {{ Φ }}.
Proof. Proof.
iIntros (<-%of_to_val ?) "(#Hh & Hf & HΦ)". 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