Commit 0d88e833 authored by Jacques-Henri Jourdan's avatar Jacques-Henri Jourdan

Got rid of one_shot

parent 09b1563c
...@@ -54,7 +54,6 @@ algebra/upred.v ...@@ -54,7 +54,6 @@ algebra/upred.v
algebra/upred_tactics.v algebra/upred_tactics.v
algebra/upred_big_op.v algebra/upred_big_op.v
algebra/frac.v algebra/frac.v
algebra/one_shot.v
algebra/csum.v algebra/csum.v
algebra/list.v algebra/list.v
program_logic/model.v program_logic/model.v
...@@ -78,7 +77,6 @@ program_logic/ectx_lifting.v ...@@ -78,7 +77,6 @@ program_logic/ectx_lifting.v
program_logic/ghost_ownership.v program_logic/ghost_ownership.v
program_logic/global_functor.v program_logic/global_functor.v
program_logic/saved_prop.v program_logic/saved_prop.v
program_logic/saved_one_shot.v
program_logic/auth.v program_logic/auth.v
program_logic/sts.v program_logic/sts.v
program_logic/namespaces.v program_logic/namespaces.v
......
This diff is collapsed.
From iris.algebra Require Export agree one_shot.
From iris.program_logic Require Export ghost_ownership.
Import uPred.
Class oneShotG (Λ : language) (Σ : gFunctors) (F : cFunctor) :=
one_shot_inG :> inG Λ Σ (one_shotR $ agreeR $ laterC $ F (iPrePropG Λ Σ)).
Definition oneShotGF (F : cFunctor) : gFunctor :=
GFunctor (one_shotRF (agreeRF ( F))).
Instance inGF_oneShotG `{inGF Λ Σ (oneShotGF F)} : oneShotG Λ Σ F.
Proof. apply: inGF_inG. Qed.
Definition one_shot_pending `{oneShotG Λ Σ F} (γ : gname) : iPropG Λ Σ :=
own γ OneShotPending.
Definition one_shot_own `{oneShotG Λ Σ F}
(γ : gname) (x : F (iPropG Λ Σ)) : iPropG Λ Σ :=
own γ (Shot $ to_agree $ Next (cFunctor_map F (iProp_fold, iProp_unfold) x)).
Typeclasses Opaque one_shot_pending one_shot_own.
Instance: Params (@one_shot_own) 4.
Section one_shot.
Context `{oneShotG Λ Σ F}.
Implicit Types x y : F (iPropG Λ Σ).
Implicit Types γ : gname.
Global Instance ne_shot_own_persistent γ x : PersistentP (one_shot_own γ x).
Proof. rewrite /one_shot_own; apply _. Qed.
Lemma one_shot_alloc_strong E (G : gset gname) :
True ={E}=> γ, (γ G) one_shot_pending γ.
Proof. by apply own_alloc_strong. Qed.
Lemma one_shot_alloc E : True ={E}=> γ, one_shot_pending γ.
Proof. by apply own_alloc. Qed.
Lemma one_shot_init E γ x : one_shot_pending γ ={E}=> one_shot_own γ x.
Proof. by apply own_update, one_shot_update_shoot. Qed.
Lemma one_shot_alloc_init E x : True ={E}=> γ, one_shot_own γ x.
Proof.
rewrite (one_shot_alloc E). apply pvs_strip_pvs.
apply exist_elim=>γ. rewrite -(exist_intro γ).
apply one_shot_init.
Qed.
Lemma one_shot_agree γ x y : one_shot_own γ x one_shot_own γ y (x y).
Proof.
rewrite -own_op own_valid one_shot_validI /= agree_validI.
rewrite agree_equivI later_equivI.
set (G1 := cFunctor_map F (iProp_fold, iProp_unfold)).
set (G2 := cFunctor_map F (@iProp_unfold Λ (globalF Σ),
@iProp_fold Λ (globalF Σ))).
assert ( z, G2 (G1 z) z) as help.
{ intros z. rewrite /G1 /G2 -cFunctor_compose -{2}[z]cFunctor_id.
apply (ne_proper (cFunctor_map F)); split=>?; apply iProp_fold_unfold. }
rewrite -{2}[x]help -{2}[y]help. apply later_mono.
apply (eq_rewrite (G1 x) (G1 y) (λ z, G2 (G1 x) G2 z))%I;
first solve_proper; auto with I.
Qed.
End one_shot.
From iris.program_logic Require Import saved_one_shot hoare. From iris.algebra Require Import csum.
From iris.program_logic Require Import hoare.
From iris.heap_lang.lib.barrier Require Import proof specification. From iris.heap_lang.lib.barrier Require Import proof specification.
From iris.heap_lang Require Import notation par proofmode. From iris.heap_lang Require Import notation par proofmode.
From iris.proofmode Require Import invariants. From iris.proofmode Require Import invariants.
Import uPred. Import uPred.
Class oneShotG (Λ : language) (Σ : gFunctors) (F : cFunctor) :=
one_shot_inG :>
inG Λ Σ (csumR (exclR unitC) (agreeR $ laterC $ F (iPrePropG Λ Σ))).
Definition oneShotGF (F : cFunctor) : gFunctor :=
GFunctor (csumRF (exclRF unitC) (agreeRF ( F))).
Instance inGF_oneShotG `{inGF Λ Σ (oneShotGF F)} : oneShotG Λ Σ F.
Proof. apply: inGF_inG. Qed.
Definition client eM eW1 eW2 : expr [] := Definition client eM eW1 eW2 : expr [] :=
let: "b" := newbarrier #() in let: "b" := newbarrier #() in
(eM ;; ^signal '"b") || ((^wait '"b" ;; eW1) || (^wait '"b" ;; eW2)). (eM ;; ^signal '"b") || ((^wait '"b" ;; eW1) || (^wait '"b" ;; eW2)).
...@@ -17,7 +26,8 @@ Local Notation iProp := (iPropG heap_lang Σ). ...@@ -17,7 +26,8 @@ Local Notation iProp := (iPropG heap_lang Σ).
Local Notation X := (G iProp). Local Notation X := (G iProp).
Definition barrier_res γ (Φ : X iProp) : iProp := Definition barrier_res γ (Φ : X iProp) : iProp :=
( x, one_shot_own γ x Φ x)%I. ( x, own γ (Cinr $ to_agree $
Next (cFunctor_map G (iProp_fold, iProp_unfold) x)) Φ x)%I.
Lemma worker_spec e γ l (Φ Ψ : X iProp) : Lemma worker_spec e γ l (Φ Ψ : X iProp) :
recv heapN N l (barrier_res γ Φ) ( x, {{ Φ x }} e {{ _, Ψ x }}) recv heapN N l (barrier_res γ Φ) ( x, {{ Φ x }} e {{ _, Ψ x }})
...@@ -43,7 +53,13 @@ Lemma Q_res_join γ : barrier_res γ Ψ1 ★ barrier_res γ Ψ2 ⊢ ▷ barrier_ ...@@ -43,7 +53,13 @@ Lemma Q_res_join γ : barrier_res γ Ψ1 ★ barrier_res γ Ψ2 ⊢ ▷ barrier_
Proof. Proof.
iIntros "[Hγ Hγ']"; iIntros "[Hγ Hγ']";
iDestruct "Hγ" as {x} "[#Hγ Hx]"; iDestruct "Hγ'" as {x'} "[#Hγ' Hx']". iDestruct "Hγ" as {x} "[#Hγ Hx]"; iDestruct "Hγ'" as {x'} "[#Hγ' Hx']".
iDestruct (one_shot_agree γ x x' with "[#]") as "Hxx"; first (by iSplit). iAssert ( (x x'):iProp)%I as "Hxx" .
{ iCombine "Hγ" "Hγ'" as "Hγ2". iClear "Hγ Hγ'".
rewrite own_valid csum_validI /= agree_validI agree_equivI later_equivI /=.
rewrite -{2}[x]cFunctor_id -{2}[x']cFunctor_id.
rewrite (ne_proper (cFunctor_map G) (cid, cid) (_ _, _ _)).
2:by split; intro; simpl; symmetry; apply iProp_fold_unfold.
rewrite !cFunctor_compose. iNext. by iRewrite "Hγ2". }
iNext. iRewrite -"Hxx" in "Hx'". iNext. iRewrite -"Hxx" in "Hx'".
iExists x; iFrame "Hγ". iApply Ψ_join; by iSplitL "Hx". iExists x; iFrame "Hγ". iApply Ψ_join; by iSplitL "Hx".
Qed. Qed.
...@@ -57,7 +73,7 @@ Lemma client_spec_new (eM eW1 eW2 : expr []) (eM' eW1' eW2' : expr ("b" :b: [])) ...@@ -57,7 +73,7 @@ Lemma client_spec_new (eM eW1 eW2 : expr []) (eM' eW1' eW2' : expr ("b" :b: []))
WP client eM' eW1' eW2' {{ _, γ, barrier_res γ Ψ }}. WP client eM' eW1' eW2' {{ _, γ, barrier_res γ Ψ }}.
Proof. Proof.
iIntros {HN -> -> ->} "/= (#Hh&HP&#He&#He1&#He2)"; rewrite /client. iIntros {HN -> -> ->} "/= (#Hh&HP&#He&#He1&#He2)"; rewrite /client.
iPvs one_shot_alloc as {γ} "Hγ". iPvs (own_alloc (Cinl (Excl ()))) as {γ} "Hγ". done.
wp_apply (newbarrier_spec heapN N (barrier_res γ Φ)); auto. wp_apply (newbarrier_spec heapN N (barrier_res γ Φ)); auto.
iFrame "Hh". iIntros {l} "[Hr Hs]". iFrame "Hh". iIntros {l} "[Hr Hs]".
set (workers_post (v : val) := (barrier_res γ Ψ1 barrier_res γ Ψ2)%I). set (workers_post (v : val) := (barrier_res γ Ψ1 barrier_res γ Ψ2)%I).
...@@ -65,7 +81,8 @@ Proof. ...@@ -65,7 +81,8 @@ Proof.
iFrame "Hh". iSplitL "HP Hs Hγ"; [|iSplitL "Hr"]. iFrame "Hh". iSplitL "HP Hs Hγ"; [|iSplitL "Hr"].
- wp_focus eM. iApply wp_wand_l; iSplitR "HP"; [|by iApply "He"]. - wp_focus eM. iApply wp_wand_l; iSplitR "HP"; [|by iApply "He"].
iIntros {v} "HP"; iDestruct "HP" as {x} "HP". wp_let. iIntros {v} "HP"; iDestruct "HP" as {x} "HP". wp_let.
iPvs (one_shot_init _ _ x with "Hγ") as "Hx". iPvs (own_update _ _ (Cinr (to_agree _)) with "Hγ") as "Hx".
by apply cmra_update_exclusive.
iApply signal_spec; iFrame "Hs"; iSplit; last done. iApply signal_spec; iFrame "Hs"; iSplit; last done.
iExists x; auto. iExists x; auto.
- iDestruct (recv_weaken with "[] Hr") as "Hr"; first by iApply P_res_split. - iDestruct (recv_weaken with "[] Hr") as "Hr"; first by iApply P_res_split.
......
From iris.algebra Require Import one_shot dec_agree. From iris.algebra Require Import dec_agree csum.
From iris.program_logic Require Import hoare. From iris.program_logic Require Import hoare.
From iris.heap_lang Require Import assert proofmode notation. From iris.heap_lang Require Import assert proofmode notation.
From iris.proofmode Require Import invariants ghost_ownership. From iris.proofmode Require Import invariants ghost_ownership.
...@@ -21,11 +21,13 @@ Definition one_shot_example : val := λ: <>, ...@@ -21,11 +21,13 @@ Definition one_shot_example : val := λ: <>,
Global Opaque one_shot_example. Global Opaque one_shot_example.
Class one_shotG Σ := Class one_shotG Σ :=
OneShotG { one_shot_inG :> inG heap_lang Σ (one_shotR (dec_agreeR Z)) }. one_shot_inG :> inG heap_lang Σ (csumR (exclR unitC)(dec_agreeR Z)).
Definition one_shotGF : gFunctorList := Definition one_shotGF : gFunctorList :=
[GFunctor (constRF (one_shotR (dec_agreeR Z)))]. [GFunctor (constRF (csumR (exclR unitC)(dec_agreeR Z)))].
Instance inGF_one_shotG Σ : inGFs heap_lang Σ one_shotGF one_shotG Σ. Instance inGF_one_shotG Σ : inGFs heap_lang Σ one_shotGF one_shotG Σ.
Proof. intros [? _]; split; apply: inGF_inG. Qed. Proof. intros [? _]; apply: inGF_inG. Qed.
Notation Pending := (Cinl (Excl ())).
Section proof. Section proof.
Context {Σ : gFunctors} `{!heapG Σ, !one_shotG Σ}. Context {Σ : gFunctors} `{!heapG Σ, !one_shotG Σ}.
...@@ -33,8 +35,8 @@ Context (heapN N : namespace) (HN : heapN ⊥ N). ...@@ -33,8 +35,8 @@ Context (heapN N : namespace) (HN : heapN ⊥ N).
Local Notation iProp := (iPropG heap_lang Σ). Local Notation iProp := (iPropG heap_lang Σ).
Definition one_shot_inv (γ : gname) (l : loc) : iProp := Definition one_shot_inv (γ : gname) (l : loc) : iProp :=
(l InjLV #0 own γ OneShotPending (l InjLV #0 own γ Pending
n : Z, l InjRV #n own γ (Shot (DecAgree n)))%I. n : Z, l InjRV #n own γ (Cinr (DecAgree n)))%I.
Lemma wp_one_shot (Φ : val iProp) : Lemma wp_one_shot (Φ : val iProp) :
heap_ctx heapN ( f1 f2 : val, heap_ctx heapN ( f1 f2 : val,
...@@ -44,7 +46,7 @@ Lemma wp_one_shot (Φ : val → iProp) : ...@@ -44,7 +46,7 @@ Lemma wp_one_shot (Φ : val → iProp) :
Proof. Proof.
iIntros "[#? Hf] /=". iIntros "[#? Hf] /=".
rewrite /one_shot_example. wp_seq. wp_alloc l as "Hl". wp_let. rewrite /one_shot_example. wp_seq. wp_alloc l as "Hl". wp_let.
iPvs (own_alloc OneShotPending) as {γ} "Hγ"; first done. iPvs (own_alloc Pending) as {γ} "Hγ"; first done.
iPvs (inv_alloc N _ (one_shot_inv γ l) with "[Hl Hγ]") as "#HN"; first done. iPvs (inv_alloc N _ (one_shot_inv γ l) with "[Hl Hγ]") as "#HN"; first done.
{ iNext. iLeft. by iSplitL "Hl". } { iNext. iLeft. by iSplitL "Hl". }
iPvsIntro. iApply "Hf"; iSplit. iPvsIntro. iApply "Hf"; iSplit.
...@@ -52,18 +54,18 @@ Proof. ...@@ -52,18 +54,18 @@ Proof.
iInv> N as "[[Hl Hγ]|H]"; last iDestruct "H" as {m} "[Hl Hγ]". iInv> N as "[[Hl Hγ]|H]"; last iDestruct "H" as {m} "[Hl Hγ]".
+ iApply wp_pvs. wp_cas_suc. iSplitL; [|by iLeft; iPvsIntro]. + iApply wp_pvs. wp_cas_suc. iSplitL; [|by iLeft; iPvsIntro].
iPvs (own_update with "Hγ") as "Hγ". iPvs (own_update with "Hγ") as "Hγ".
{ by apply (one_shot_update_shoot (DecAgree n)). } { by apply cmra_update_exclusive with (y:=Cinr (DecAgree n)). }
iPvsIntro; iRight; iExists n; by iSplitL "Hl". iPvsIntro; iRight; iExists n; by iSplitL "Hl".
+ wp_cas_fail. iSplitL. iRight; iExists m; by iSplitL "Hl". by iRight. + wp_cas_fail. iSplitL. iRight; iExists m; by iSplitL "Hl". by iRight.
- iIntros "!". wp_seq. wp_focus (! _)%E. iInv> N as "Hγ". - iIntros "!". wp_seq. wp_focus (! _)%E. iInv> N as "Hγ".
iAssert ( v, l v ((v = InjLV #0 own γ OneShotPending) iAssert ( v, l v ((v = InjLV #0 own γ Pending)
n : Z, v = InjRV #n own γ (Shot (DecAgree n))))%I with "[-]" as "Hv". n : Z, v = InjRV #n own γ (Cinr (DecAgree n))))%I with "[-]" as "Hv".
{ iDestruct "Hγ" as "[[Hl Hγ]|Hl]"; last iDestruct "Hl" as {m} "[Hl Hγ]". { iDestruct "Hγ" as "[[Hl Hγ]|Hl]"; last iDestruct "Hl" as {m} "[Hl Hγ]".
+ iExists (InjLV #0). iFrame. eauto. + iExists (InjLV #0). iFrame. eauto.
+ iExists (InjRV #m). iFrame. eauto. } + iExists (InjRV #m). iFrame. eauto. }
iDestruct "Hv" as {v} "[Hl Hv]". wp_load. iDestruct "Hv" as {v} "[Hl Hv]". wp_load.
iAssert (one_shot_inv γ l (v = InjLV #0 n : Z, iAssert (one_shot_inv γ l (v = InjLV #0 n : Z,
v = InjRV #n own γ (Shot (DecAgree n))))%I with "[-]" as "[$ #Hv]". v = InjRV #n own γ (Cinr (DecAgree n))))%I with "[-]" as "[$ #Hv]".
{ iDestruct "Hv" as "[[% ?]|Hv]"; last iDestruct "Hv" as {m} "[% ?]"; subst. { iDestruct "Hv" as "[[% ?]|Hv]"; last iDestruct "Hv" as {m} "[% ?]"; subst.
+ iSplit. iLeft; by iSplitL "Hl". eauto. + iSplit. iLeft; by iSplitL "Hl". eauto.
+ iSplit. iRight; iExists m; by iSplitL "Hl". eauto. } + iSplit. iRight; iExists m; by iSplitL "Hl". eauto. }
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment