Commit 1f589858 authored by Robbert Krebbers's avatar Robbert Krebbers

Iris 3.0: invariants and weakest preconditions encoded in the logic.

This commit features:

- A simpler model. The recursive domain equation no longer involves a triple
  containing invariants, physical state and ghost state, but just ghost state.
  Invariants and physical state are encoded using (higher-order) ghost state.

- (Primitive) view shifts are formalized in the logic and all properties about
  it are proven in the logic instead of the model. Instead, the core logic
  features only a notion of raw view shifts which internalizing performing frame
  preserving updates.

- A better behaved notion of mask changing view shifts. In particular, we no
  longer have side-conditions on transitivity of view shifts, and we have a
  rule for introduction of mask changing view shifts |={E1,E2}=> P with
  E2 ⊆ E1 which allows to postpone performing a view shift.

- The weakest precondition connective is formalized in the logic using Banach's
  fixpoint. All properties about the connective are proven in the logic instead
  of directly in the model.

- Adequacy is proven in the logic and uses a primitive form of adequacy for
  uPred that only involves raw views shifts and laters.

Some remarks:

- I have removed binary view shifts. I did not see a way to describe all rules
  of the new mask changing view shifts using those.
- There is no longer the need for the notion of "frame shifting assertions" and
  these are thus removed. The rules for Hoare triples are thus also stated in
  terms of primitive view shifts.

TODO:

- Maybe rename primitive view shift into something more sensible
- Figure out a way to deal with closed proofs (see the commented out stuff in
  tests/heap_lang and tests/barrier_client).
parent 6b6381fe
......@@ -66,13 +66,9 @@ program_logic/model.v
program_logic/adequacy.v
program_logic/lifting.v
program_logic/invariants.v
program_logic/viewshifts.v
program_logic/wsat.v
program_logic/ownership.v
program_logic/weakestpre.v
program_logic/weakestpre_fix.v
program_logic/pviewshifts.v
program_logic/resources.v
program_logic/hoare.v
program_logic/language.v
program_logic/ectx_language.v
......@@ -86,6 +82,7 @@ program_logic/sts.v
program_logic/namespaces.v
program_logic/boxes.v
program_logic/counter_examples.v
program_logic/iris.v
heap_lang/lang.v
heap_lang/tactics.v
heap_lang/wp_tactics.v
......@@ -105,7 +102,6 @@ heap_lang/lib/barrier/protocol.v
heap_lang/lib/barrier/proof.v
heap_lang/proofmode.v
tests/heap_lang.v
tests/program_logic.v
tests/one_shot.v
tests/joining_existentials.v
tests/proofmode.v
......@@ -122,6 +118,5 @@ proofmode/notation.v
proofmode/invariants.v
proofmode/weakestpre.v
proofmode/ghost_ownership.v
proofmode/sts.v
proofmode/classes.v
proofmode/class_instances.v
......@@ -12,9 +12,9 @@ Notation Skip := (Seq (Lit LitUnit) (Lit LitUnit)).
Notation Match e0 x1 e1 x2 e2 := (Case e0 (Lam x1 e1) (Lam x2 e2)).
Section derived.
Context {Σ : iFunctor}.
Implicit Types P Q : iProp heap_lang Σ.
Implicit Types Φ : val iProp heap_lang Σ.
Context `{irisG heap_lang Σ}.
Implicit Types P Q : iProp Σ.
Implicit Types Φ : val iProp Σ.
(** Proof rules for the sugar *)
Lemma wp_lam E x ef e Φ :
......
From iris.heap_lang Require Export lifting.
From iris.algebra Require Import upred_big_op frac dec_agree.
From iris.algebra Require Import upred_big_op gmap frac dec_agree.
From iris.program_logic Require Export invariants ghost_ownership.
From iris.program_logic Require Import ownership auth.
From iris.proofmode Require Import weakestpre.
......@@ -13,7 +13,8 @@ Definition heapUR : ucmraT := gmapUR loc (prodR fracR (dec_agreeR val)).
(** The CMRA we need. *)
Class heapG Σ := HeapG {
heap_inG :> authG heap_lang Σ heapUR;
heapG_iris_inG :> irisG heap_lang Σ;
heap_inG :> authG Σ heapUR;
heap_name : gname
}.
(** The Functor we need. *)
......@@ -25,16 +26,16 @@ Definition of_heap : heapUR → state := omap (maybe DecAgree ∘ snd).
Section definitions.
Context `{heapG Σ}.
Definition heap_mapsto_def (l : loc) (q : Qp) (v: val) : iPropG heap_lang Σ :=
Definition heap_mapsto_def (l : loc) (q : Qp) (v: val) : iProp Σ :=
auth_own heap_name {[ l := (q, DecAgree v) ]}.
Definition heap_mapsto_aux : { x | x = @heap_mapsto_def }. by eexists. Qed.
Definition heap_mapsto := proj1_sig heap_mapsto_aux.
Definition heap_mapsto_eq : @heap_mapsto = @heap_mapsto_def :=
proj2_sig heap_mapsto_aux.
Definition heap_inv (h : heapUR) : iPropG heap_lang Σ :=
Definition heap_inv (h : heapUR) : iProp Σ :=
ownP (of_heap h).
Definition heap_ctx : iPropG heap_lang Σ :=
Definition heap_ctx : iProp Σ :=
auth_ctx heap_name heapN heap_inv.
Global Instance heap_inv_proper : Proper (() ==> ()) heap_inv.
......@@ -44,9 +45,7 @@ Section definitions.
End definitions.
Typeclasses Opaque heap_ctx heap_mapsto.
Instance: Params (@heap_inv) 1.
Instance: Params (@heap_mapsto) 4.
Instance: Params (@heap_ctx) 2.
Instance: Params (@heap_inv) 2.
Notation "l ↦{ q } v" := (heap_mapsto l q v)
(at level 20, q at level 50, format "l ↦{ q } v") : uPred_scope.
......@@ -54,8 +53,8 @@ Notation "l ↦ v" := (heap_mapsto l 1 v) (at level 20) : uPred_scope.
Section heap.
Context {Σ : gFunctors}.
Implicit Types P Q : iPropG heap_lang Σ.
Implicit Types Φ : val iPropG heap_lang Σ.
Implicit Types P Q : iProp Σ.
Implicit Types Φ : val iProp Σ.
Implicit Types σ : state.
Implicit Types h g : heapUR.
......@@ -103,15 +102,14 @@ Section heap.
Hint Resolve heap_store_valid.
(** Allocation *)
Lemma heap_alloc E σ :
authG heap_lang Σ heapUR nclose heapN E
Lemma heap_alloc `{irisG heap_lang Σ, authG Σ heapUR} E σ :
ownP σ ={E}=> _ : heapG Σ, heap_ctx [ map] lv σ, l v.
Proof.
intros. rewrite -{1}(from_to_heap σ). etrans.
{ rewrite [ownP _]later_intro.
apply (auth_alloc (ownP of_heap) heapN E); auto using to_heap_valid. }
apply pvs_mono, exist_elim=> γ.
rewrite -(exist_intro (HeapG _ _ γ)) /heap_ctx; apply and_mono_r.
rewrite -(exist_intro (HeapG _ _ _ γ)) /heap_ctx; apply and_mono_r.
rewrite heap_mapsto_eq /heap_mapsto_def /heap_name.
induction σ as [|l v σ Hl IH] using map_ind.
{ rewrite big_sepM_empty; apply True_intro. }
......@@ -157,22 +155,21 @@ Section heap.
Proof. by rewrite heap_mapsto_op_half. Qed.
(** Weakest precondition *)
(* FIXME: try to reduce usage of wp_pvs. We're losing view shifts here. *)
Lemma wp_alloc E e v Φ :
to_val e = Some v nclose heapN E
heap_ctx ( l, l v ={E}= Φ (LitV (LitLoc l))) WP Alloc e @ E {{ Φ }}.
Proof.
iIntros (<-%of_to_val ?) "[#Hinv HΦ]". rewrite /heap_ctx.
iPvs (auth_empty heap_name) as "Hheap".
iApply wp_pvs; iApply (auth_fsa heap_inv (wp_fsa _)); eauto with fsaV.
iFrame "Hinv Hheap". iIntros (h). rewrite left_id.
iIntros "[% Hheap]". rewrite /heap_inv.
iApply wp_alloc_pst. iFrame "Hheap". iNext.
iIntros (l) "[% Hheap]"; iPvsIntro; iExists {[ l := (1%Qp, DecAgree v) ]}.
rewrite -of_heap_insert -(insert_singleton_op h); last by apply of_heap_None.
iFrame "Hheap". iSplitR; first iPureIntro.
{ by apply alloc_unit_singleton_local_update; first apply of_heap_None. }
iIntros "Hheap". iApply "HΦ". by rewrite heap_mapsto_eq /heap_mapsto_def.
iVs (auth_empty heap_name) as "Hh".
iVs (auth_open with "[Hh]") as (h) "[Hv [Hh Hclose]]"; eauto.
rewrite left_id /heap_inv. iDestruct "Hv" as %?.
iApply wp_alloc_pst. iFrame "Hh". iNext.
iIntros (l) "[% Hh]"; iVsIntro.
iVs ("Hclose" $! {[ l := (1%Qp, DecAgree v) ]} with "[Hh]").
{ rewrite -of_heap_insert -(insert_singleton_op h); last by apply of_heap_None.
iFrame "Hh". iPureIntro.
by apply alloc_unit_singleton_local_update; first apply of_heap_None. }
iApply "HΦ". by rewrite heap_mapsto_eq /heap_mapsto_def.
Qed.
Lemma wp_load E l q v Φ :
......@@ -180,14 +177,15 @@ Section heap.
heap_ctx l {q} v (l {q} v ={E}= Φ v)
WP Load (Lit (LitLoc l)) @ E {{ Φ }}.
Proof.
iIntros (?) "[#Hh [Hl HΦ]]".
iIntros (?) "[#Hinv [Hl HΦ]]".
rewrite /heap_ctx heap_mapsto_eq /heap_mapsto_def.
iApply wp_pvs; iApply (auth_fsa heap_inv (wp_fsa _)); eauto with fsaV.
iFrame "Hh Hl". iIntros (h) "[% Hl]". rewrite /heap_inv.
iVs (auth_open with "[Hl]") as (h) "[% [Hl Hclose]]"; eauto.
rewrite /heap_inv.
iApply (wp_load_pst _ (<[l:=v]>(of_heap h)));first by rewrite lookup_insert.
rewrite of_heap_singleton_op //. iFrame "Hl".
iIntros "> Hown". iPvsIntro. iExists _; iSplit; first done.
rewrite of_heap_singleton_op //. by iFrame.
iIntros "> Hown". iVsIntro. iVs ("Hclose" with "* [Hown]").
{ iSplit; first done. rewrite of_heap_singleton_op //. by iFrame. }
by iApply "HΦ".
Qed.
Lemma wp_store E l v' e v Φ :
......@@ -195,15 +193,18 @@ Section heap.
heap_ctx l v' (l v ={E}= Φ (LitV LitUnit))
WP Store (Lit (LitLoc l)) e @ E {{ Φ }}.
Proof.
iIntros (<-%of_to_val ?) "[#Hh [Hl HΦ]]".
iIntros (<-%of_to_val ?) "[#Hinv [Hl HΦ]]".
rewrite /heap_ctx heap_mapsto_eq /heap_mapsto_def.
iApply wp_pvs; iApply (auth_fsa heap_inv (wp_fsa _)); eauto with fsaV.
iFrame "Hh Hl". iIntros (h) "[% Hl]". rewrite /heap_inv.
iVs (auth_open with "[Hl]") as (h) "[% [Hl Hclose]]"; eauto.
rewrite /heap_inv.
iApply (wp_store_pst _ (<[l:=v']>(of_heap h))); rewrite ?lookup_insert //.
rewrite insert_insert !of_heap_singleton_op; eauto. iFrame "Hl".
iIntros "> Hown". iPvsIntro. iExists {[l := (1%Qp, DecAgree v)]}; iSplit.
{ iPureIntro; by apply singleton_local_update, exclusive_local_update. }
rewrite of_heap_singleton_op //; eauto. by iFrame.
iIntros "> Hl". iVsIntro.
iVs ("Hclose" $! {[l := (1%Qp, DecAgree v)]} with "[Hl]").
{ iSplit.
- iPureIntro; by apply singleton_local_update, exclusive_local_update.
- rewrite of_heap_singleton_op //; eauto. }
by iApply "HΦ".
Qed.
Lemma wp_cas_fail E l q v' e1 v1 e2 v2 Φ :
......@@ -213,12 +214,13 @@ Section heap.
Proof.
iIntros (<-%of_to_val <-%of_to_val ??) "[#Hh [Hl HΦ]]".
rewrite /heap_ctx heap_mapsto_eq /heap_mapsto_def.
iApply wp_pvs; iApply (auth_fsa heap_inv (wp_fsa _)); eauto with fsaV.
iFrame "Hh Hl". iIntros (h) "[% Hl]". rewrite /heap_inv.
iVs (auth_open with "[Hl]") as (h) "[% [Hl Hclose]]"; eauto.
rewrite /heap_inv.
iApply (wp_cas_fail_pst _ (<[l:=v']>(of_heap h))); rewrite ?lookup_insert //.
rewrite of_heap_singleton_op //. iFrame "Hl".
iIntros "> Hown". iPvsIntro. iExists _; iSplit; first done.
rewrite of_heap_singleton_op //. by iFrame.
iIntros "> Hown". iVsIntro. iVs ("Hclose" with "* [Hown]").
{ iSplit; first done. rewrite of_heap_singleton_op //. by iFrame. }
by iApply "HΦ".
Qed.
Lemma wp_cas_suc E l e1 v1 e2 v2 Φ :
......@@ -228,12 +230,15 @@ Section heap.
Proof.
iIntros (<-%of_to_val <-%of_to_val ?) "[#Hh [Hl HΦ]]".
rewrite /heap_ctx heap_mapsto_eq /heap_mapsto_def.
iApply wp_pvs; iApply (auth_fsa heap_inv (wp_fsa _)); eauto with fsaV.
iFrame "Hh Hl". iIntros (h) "[% Hl]". rewrite /heap_inv.
iVs (auth_open with "[Hl]") as (h) "[% [Hl Hclose]]"; eauto.
rewrite /heap_inv.
iApply (wp_cas_suc_pst _ (<[l:=v1]>(of_heap h))); rewrite ?lookup_insert //.
rewrite insert_insert !of_heap_singleton_op; eauto. iFrame "Hl".
iIntros "> Hown". iPvsIntro. iExists {[l := (1%Qp, DecAgree v2)]}; iSplit.
{ iPureIntro; by apply singleton_local_update, exclusive_local_update. }
rewrite of_heap_singleton_op //; eauto. by iFrame.
iIntros "> Hl". iVsIntro.
iVs ("Hclose" $! {[l := (1%Qp, DecAgree v2)]} with "[Hl]").
{ iSplit.
- iPureIntro; by apply singleton_local_update, exclusive_local_update.
- rewrite of_heap_singleton_op //; eauto. }
by iApply "HΦ".
Qed.
End heap.
......@@ -7,7 +7,7 @@ Definition assert : val :=
Notation "'assert:' e" := (assert (λ: <>, e))%E (at level 99) : expr_scope.
Global Opaque assert.
Lemma wp_assert {Σ} E (Φ : val iProp heap_lang Σ) e `{!Closed [] e} :
Lemma wp_assert `{heapG Σ} E (Φ : val iProp Σ) e `{!Closed [] e} :
WP e @ E {{ v, v = #true Φ #() }} WP assert: e @ E {{ Φ }}.
Proof.
iIntros "HΦ". rewrite /assert. wp_let. wp_seq.
......
From iris.prelude Require Import functions.
From iris.algebra Require Import upred_big_op.
From iris.program_logic Require Import saved_prop.
From iris.program_logic Require Import saved_prop sts.
From iris.heap_lang Require Import proofmode.
From iris.proofmode Require Import sts.
From iris.heap_lang.lib.barrier Require Export barrier.
From iris.heap_lang.lib.barrier Require Import protocol.
Import uPred.
(** The CMRAs we need. *)
(* Not bundling heapG, as it may be shared with other users. *)
Class barrierG Σ := BarrierG {
barrier_stsG :> stsG heap_lang Σ sts;
barrier_savedPropG :> savedPropG heap_lang Σ idCF;
barrier_stsG :> stsG Σ sts;
barrier_savedPropG :> savedPropG Σ idCF;
}.
(** The Functors we need. *)
Definition barrierGF : gFunctorList := [stsGF sts; savedPropGF idCF].
(* Show and register that they match. *)
Instance inGF_barrierG `{H : inGFs heap_lang Σ barrierGF} : barrierG Σ.
Instance inGF_barrierG `{H : inGFs Σ barrierGF} : barrierG Σ.
Proof. destruct H as (?&?&?). split; apply _. Qed.
(** Now we come to the Iris part of the proof. *)
Section proof.
Context `{!heapG Σ, !barrierG Σ} (N : namespace).
Implicit Types I : gset gname.
Local Notation iProp := (iPropG heap_lang Σ).
Definition ress (P : iProp) (I : gset gname) : iProp :=
( Ψ : gname iProp,
Definition ress (P : iProp Σ) (I : gset gname) : iProp Σ :=
( Ψ : gname iProp Σ,
(P - [ set] i I, Ψ i) [ set] i I, saved_prop_own i (Ψ i))%I.
Coercion state_to_val (s : state) : val :=
match s with State Low _ => #0 | State High _ => #1 end.
Arguments state_to_val !_ / : simpl nomatch.
Definition state_to_prop (s : state) (P : iProp) : iProp :=
Definition state_to_prop (s : state) (P : iProp Σ) : iProp Σ :=
match s with State Low _ => P | State High _ => True%I end.
Arguments state_to_prop !_ _ / : simpl nomatch.
Definition barrier_inv (l : loc) (P : iProp) (s : state) : iProp :=
Definition barrier_inv (l : loc) (P : iProp Σ) (s : state) : iProp Σ :=
(l s ress (state_to_prop s P) (state_I s))%I.
Definition barrier_ctx (γ : gname) (l : loc) (P : iProp) : iProp :=
Definition barrier_ctx (γ : gname) (l : loc) (P : iProp Σ) : iProp Σ :=
( (heapN N) heap_ctx sts_ctx γ N (barrier_inv l P))%I.
Definition send (l : loc) (P : iProp) : iProp :=
Definition send (l : loc) (P : iProp Σ) : iProp Σ :=
( γ, barrier_ctx γ l P sts_ownS γ low_states {[ Send ]})%I.
Definition recv (l : loc) (R : iProp) : iProp :=
Definition recv (l : loc) (R : iProp Σ) : iProp Σ :=
( γ P Q i,
barrier_ctx γ l P sts_ownS γ (i_states i) {[ Change i ]}
saved_prop_own i Q (Q - R))%I.
Global Instance barrier_ctx_persistent (γ : gname) (l : loc) (P : iProp) :
Global Instance barrier_ctx_persistent (γ : gname) (l : loc) (P : iProp Σ) :
PersistentP (barrier_ctx γ l P).
Proof. apply _. Qed.
......@@ -93,15 +90,15 @@ Proof.
Qed.
(** Actual proofs *)
Lemma newbarrier_spec (P : iProp) (Φ : val iProp) :
Lemma newbarrier_spec (P : iProp Σ) (Φ : val iProp Σ) :
heapN N
heap_ctx ( l, recv l P send l P - Φ #l) WP newbarrier #() {{ Φ }}.
Proof.
iIntros (HN) "[#? HΦ]".
rewrite /newbarrier. wp_seq. wp_alloc l as "Hl".
iApply ("HΦ" with "|==>[-]").
iPvs (saved_prop_alloc (F:=idCF) _ P) as (γ) "#?".
iPvs (sts_alloc (barrier_inv l P) _ N (State Low {[ γ ]}) with "[-]")
iVs (saved_prop_alloc (F:=idCF) P) as (γ) "#?".
iVs (sts_alloc (barrier_inv l P) _ N (State Low {[ γ ]}) with "[-]")
as (γ') "[#? Hγ']"; eauto.
{ iNext. rewrite /barrier_inv /=. iFrame.
iExists (const P). rewrite !big_sepS_singleton /=. eauto. }
......@@ -110,59 +107,57 @@ Proof.
iAssert (sts_ownS γ' (i_states γ) {[Change γ]}
sts_ownS γ' low_states {[Send]})%I with "|==>[-]" as "[Hr Hs]".
{ iApply sts_ownS_op; eauto using i_states_closed, low_states_closed.
+ set_solver.
+ iApply (sts_own_weaken with "Hγ'");
- set_solver.
- iApply (sts_own_weaken with "Hγ'");
auto using sts.closed_op, i_states_closed, low_states_closed;
abstract set_solver. }
iPvsIntro. rewrite /recv /send. iSplitL "Hr".
iVsIntro. rewrite /recv /send. iSplitL "Hr".
- iExists γ', P, P, γ. iFrame. auto.
- auto.
Qed.
Lemma signal_spec l P (Φ : val iProp) :
Lemma signal_spec l P (Φ : val iProp Σ) :
send l P P Φ #() WP signal #l {{ Φ }}.
Proof.
rewrite /signal /send /barrier_ctx.
iIntros "(Hs&HP&HΦ)"; iDestruct "Hs" as (γ) "[#(%&Hh&Hsts) Hγ]". wp_let.
iSts γ as [p I]; iDestruct "Hγ" as "[Hl Hr]".
wp_store. iPvsIntro. destruct p; [|done].
iExists (State High I), ( : set token).
iVs (sts_openS (barrier_inv l P) _ _ γ with "[Hγ]")
as ([p I]) "(% & [Hl Hr] & Hclose)"; eauto.
destruct p; [|done]. wp_store. iFrame "HΦ".
iVs ("Hclose" $! (State High I) ( : set token) with "[-]"); last done.
iSplit; [iPureIntro; by eauto using signal_step|].
iSplitR "HΦ"; [iNext|by auto].
rewrite {2}/barrier_inv /ress /=; iFrame "Hl".
iNext. rewrite {2}/barrier_inv /ress /=; iFrame "Hl".
iDestruct "Hr" as (Ψ) "[Hr Hsp]"; iExists Ψ; iFrame "Hsp".
iIntros "> _"; by iApply "Hr".
Qed.
Lemma wait_spec l P (Φ : val iProp) :
Lemma wait_spec l P (Φ : val iProp Σ) :
recv l P (P - Φ #()) WP wait #l {{ Φ }}.
Proof.
rename P into R; rewrite /recv /barrier_ctx.
iIntros "[Hr HΦ]"; iDestruct "Hr" as (γ P Q i) "(#(%&Hh&Hsts)&Hγ&#HQ&HQR)".
iLöb as "IH". wp_rec. wp_focus (! _)%E.
iSts γ as [p I]; iDestruct "Hγ" as "[Hl Hr]".
wp_load. iPvsIntro. destruct p.
- (* a Low state. The comparison fails, and we recurse. *)
iExists (State Low I), {[ Change i ]}; iSplit; [done|iSplitL "Hl Hr"].
{ iNext. rewrite {2}/barrier_inv /=. by iFrame. }
iIntros "Hγ".
iVs (sts_openS (barrier_inv l P) _ _ γ with "[Hγ]")
as ([p I]) "(% & [Hl Hr] & Hclose)"; eauto.
wp_load. destruct p.
- iVs ("Hclose" $! (State Low I) {[ Change i ]} with "[Hl Hr]") as "Hγ".
{ iSplit; first done. iNext. 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. }
wp_op=> ?; simplify_eq; wp_if. iApply ("IH" with "Hγ [HQR] HΦ"). auto.
iVsIntro. wp_op=> ?; simplify_eq; wp_if.
iApply ("IH" with "Hγ [HQR] HΦ"). auto.
- (* a High state: the comparison succeeds, and we perform a transition and
return to the client *)
iExists (State High (I {[ i ]})), ( : set token).
iSplit; [iPureIntro; by eauto using wait_step|].
iDestruct "Hr" as (Ψ) "[HΨ Hsp]".
iDestruct (big_sepS_delete _ _ i with "Hsp") as "[#HΨi Hsp]"; first done.
iAssert ( Ψ i [ set] j I {[i]}, Ψ j)%I with "[HΨ]" as "[HΨ HΨ']".
{ iNext. iApply (big_sepS_delete _ _ i); first done. by iApply "HΨ". }
iSplitL "HΨ' Hl Hsp"; [iNext|].
+ rewrite {2}/barrier_inv /=; iFrame "Hl".
iExists Ψ; iFrame. auto.
+ iPoseProof (saved_prop_agree i Q (Ψ i) with "[#]") as "Heq"; first by auto.
iIntros "_". wp_op=> ?; simplify_eq/=; wp_if.
iPvsIntro. iApply "HΦ". iApply "HQR". by iRewrite "Heq".
iVs ("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. }
iPoseProof (saved_prop_agree i Q (Ψ i) with "[#]") as "Heq"; first by auto.
iVsIntro. wp_op=> ?; simplify_eq/=; wp_if.
iVsIntro. iApply "HΦ". iApply "HQR". by iRewrite "Heq".
Qed.
Lemma recv_split E l P1 P2 :
......@@ -170,28 +165,27 @@ Lemma recv_split E l P1 P2 :
Proof.
rename P1 into R1; rename P2 into R2. rewrite {1}/recv /barrier_ctx.
iIntros (?). iDestruct 1 as (γ P Q i) "(#(%&Hh&Hsts)&Hγ&#HQ&HQR)".
iApply pvs_trans'.
iSts γ as [p I]; iDestruct "Hγ" as "[Hl Hr]".
iPvs (saved_prop_alloc_strong _ (R1: %CF iProp) I) as (i1) "[% #Hi1]".
iPvs (saved_prop_alloc_strong _ (R2: %CF iProp) (I {[i1]}))
as (i2) "[Hi2' #Hi2]"; iDestruct "Hi2'" as %Hi2; iPvsIntro.
iVs (sts_openS (barrier_inv l P) _ _ γ with "[Hγ]")
as ([p I]) "(% & [Hl Hr] & Hclose)"; eauto.
iVs (saved_prop_alloc_strong (R1: %CF (iProp Σ)) I) as (i1) "[% #Hi1]".
iVs (saved_prop_alloc_strong (R2: %CF (iProp Σ)) (I {[i1]}))
as (i2) "[Hi2' #Hi2]"; iDestruct "Hi2'" as %Hi2.
rewrite ->not_elem_of_union, elem_of_singleton in Hi2; destruct Hi2.
iExists (State p ({[i1; i2]} I {[i]})).
iExists ({[Change i1; Change i2 ]}).
iSplit; [by eauto using split_step|iSplitL].
- iNext. rewrite {2}/barrier_inv /=. iFrame "Hl".
iApply (ress_split _ _ _ Q R1 R2); eauto. iFrame; auto.
- iIntros "Hγ".
iVs ("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".
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]".
{ iApply sts_ownS_op; eauto using i_states_closed, low_states_closed.
+ set_solver.
+ iApply (sts_own_weaken with "Hγ");
- abstract set_solver.
- iApply (sts_own_weaken with "Hγ");
eauto using sts.closed_op, i_states_closed.
abstract set_solver. }
iPvsIntro; iSplitL "Hγ1"; rewrite /recv /barrier_ctx.
+ iExists γ, P, R1, i1. iFrame; auto.
+ iExists γ, P, R2, i2. iFrame; auto.
iVsIntro; iSplitL "Hγ1"; rewrite /recv /barrier_ctx.
- iExists γ, P, R1, i1. iFrame; auto.
- iExists γ, P, R2, i2. iFrame; auto.
Qed.
Lemma recv_weaken l P1 P2 : (P1 - P2) recv l P1 - recv l P2.
......@@ -203,9 +197,7 @@ Proof.
Qed.
Lemma recv_mono l P1 P2 : (P1 P2) recv l P1 recv l P2.
Proof.
intros HP%entails_wand. apply wand_entails. rewrite HP. apply recv_weaken.
Qed.
Proof. iIntros (HP) "H". iApply (recv_weaken with "[] H"). iApply HP. Qed.
End proof.
Typeclasses Opaque barrier_ctx send recv.
From iris.algebra Require Export sts.
From iris.program_logic Require Import ghost_ownership.
From iris.prelude Require Export gmap.
(** The STS describing the main barrier protocol. Every state has an index-set
associated with it. These indices are actually [gname], because we use them
......
......@@ -5,13 +5,11 @@ From iris.heap_lang Require Import proofmode.
Import uPred.
Section spec.
Context {Σ : gFunctors} `{!heapG Σ} `{!barrierG Σ}.
Local Notation iProp := (iPropG heap_lang Σ).
Context `{!heapG Σ} `{!barrierG Σ}.
Lemma barrier_spec (N : namespace) :
heapN N
recv send : loc iProp -n> iProp,
recv send : loc iProp Σ -n> iProp Σ,
( P, heap_ctx {{ True }} newbarrier #()
{{ v, l : loc, v = #l recv l P send l P }})
( l P, {{ send l P P }} signal #l {{ _, True }})
......
(* Monotone counter, but using an explicit CMRA instead of auth *)
From iris.program_logic Require Export global_functor.
From iris.heap_lang Require Export lang.
From iris.proofmode Require Import invariants tactics.
From iris.program_logic Require Import auth.
From iris.proofmode Require Import invariants ghost_ownership coq_tactics.
From iris.heap_lang Require Import proofmode notation.
Import uPred.
Definition newcounter : val := λ: <>, ref #0.
Definition inc : val :=
......@@ -14,18 +12,17 @@ Definition read : val := λ: "l", !"l".
Global Opaque newcounter inc get.
(** The CMRA we need. *)