Commit b85484c9 authored by Dan Frumin's avatar Dan Frumin

finish the store_strong example

parent 1ee95d7b
...@@ -24,3 +24,4 @@ theories/tests/fact.v ...@@ -24,3 +24,4 @@ theories/tests/fact.v
theories/tests/array_copy.v theories/tests/array_copy.v
theories/tests/gcd.v theories/tests/gcd.v
theories/tests/par_inc.v theories/tests/par_inc.v
theories/tests/store_strong.v
...@@ -6,11 +6,11 @@ From iris.algebra Require Import frac_auth csum excl agree. ...@@ -6,11 +6,11 @@ From iris.algebra Require Import frac_auth csum excl agree.
Definition storeme : val := λᶜ "l", Definition storeme : val := λᶜ "l",
c_ret "l" = 10 ; 10. c_ret "l" = 10 ; 10.
Definition lol : val := λᶜ "l", Definition test : val := λᶜ "l",
call (c_ret storeme) (c_ret "l") + (c_ret "l" = 11). call (c_ret storeme) (c_ret "l") + (c_ret "l" = 11).
Section lol. Section test.
Context `{cmonadG Σ, !inG Σ (frac_authR natR)}. Context `{cmonadG Σ, !inG Σ (authR (optionUR (exclR boolC)))}.
Lemma cwp_store_hard R Φ Ψ1 Ψ2 e1 e2 : Lemma cwp_store_hard R Φ Ψ1 Ψ2 e1 e2 :
CWP e1 @ R {{ Ψ1 }} - CWP e1 @ R {{ Ψ1 }} -
...@@ -41,7 +41,7 @@ Section lol. ...@@ -41,7 +41,7 @@ Section lol.
iEval (rewrite -(Z2Nat.id (cloc_offset cl)) //). iEval (rewrite -(Z2Nat.id (cloc_offset cl)) //).
wp_apply (linsert_spec with "[//]"); [eauto|]. iIntros (ll' Hl'). wp_apply (linsert_spec with "[//]"); [eauto|]. iIntros (ll' Hl').
iApply wp_fupd. wp_store. iApply wp_fupd. wp_store.
iMod ("Hclose" $! _ LLvl with "[//] Hl") as "[Hσ Hl]". iMod ("Hclose" $! _ LLvl with "[//] Hl") as "[Hσ Hl]".
iMod ("HΦ" with "Hl") as "[$ $]". iIntros "!> !>". iMod ("HΦ" with "Hl") as "[$ $]". iIntros "!> !>".
iExists ({[(#(cloc_base cl), #(cloc_offset cl))%V]} X), _. iExists ({[(#(cloc_base cl), #(cloc_offset cl))%V]} X), _.
iFrame "Hσ Hlocks". iPureIntro. rewrite locked_locs_lock. set_solver. iFrame "Hσ Hlocks". iPureIntro. rewrite locked_locs_lock. set_solver.
...@@ -54,73 +54,91 @@ Section lol. ...@@ -54,73 +54,91 @@ Section lol.
iIntros "? H". iApply cwp_fun; simpl. vcg; iIntros "? !>". by iApply "H". iIntros "? H". iApply cwp_fun; simpl. vcg; iIntros "? !>". by iApply "H".
Qed. Qed.
Definition oneshotR := csumR (exclR unitR) (agreeR natC). Definition gpointsto γ (b : bool) := own γ ( (Excl' b)).
Class oneshotG Σ := { oneshot_inG :> inG Σ oneshotR }. Notation "γ '≔' b" := (gpointsto γ b) (at level 80).
Definition oneshotΣ : gFunctors := #[GFunctor oneshotR]. Definition gauth γ b := own γ ( (Excl' b)).
Instance subG_oneshotΣ {Σ} : subG oneshotΣ Σ oneshotG Σ. Lemma gagree γ b1 b2 :
Proof. solve_inG. Qed. γ b1 - gauth γ b2 - b1 = b2.
Definition pending γ `{oneshotG Σ} := own γ (Cinl (Excl ())).
Definition shot γ n `{oneshotG Σ} := own γ (Cinr (to_agree n)).
Lemma new_pending `{oneshotG Σ} : (|==> γ, pending γ)%I.
Proof. by apply own_alloc. Qed.
Lemma shoot γ m `{oneshotG Σ} : pending γ == shot γ m.
Proof. Proof.
apply own_update. iIntros "H1 H2".
intros n [f |]; simpl; eauto. by iDestruct (own_valid_2 with "H2 H1")
destruct f; simpl; try by inversion 1. as %[<-%Excl_included%leibniz_equiv _]%auth_valid_discrete_2.
Qed. Qed.
Lemma shot_not_pending γ b `{oneshotG Σ} : Lemma gnew : (|==> γ, gauth γ false γ false)%I.
shot γ b - pending γ - False.
Proof. Proof.
iIntros "Hs Hp". iMod (own_alloc ( (Excl' false) (Excl' false)))%I as (γ) "[H1 H2]";
iPoseProof (own_valid_2 with "Hs Hp") as "H". first done;
iDestruct "H" as %[]. eauto with iFrame.
Qed. Qed.
Lemma gupdate b3 γ b1 b2 :
Lemma shot_agree γ m n `{oneshotG Σ} : γ b1 - gauth γ b2 == γ b3 gauth γ b3.
shot γ m - shot γ n - m = n.
Proof. Proof.
iIntros "Hs Hs'". iIntros "H1 H2".
iPoseProof (own_valid_2 with "Hs Hs'") as "H". iMod (own_update_2 with "H2 H1") as "[? ?]".
rewrite Cinr_op /=. { apply auth_update, option_local_update.
by iDestruct "H" as %LOL%agree_op_invL'. by apply (exclusive_local_update (Excl b2) (Excl b3)). }
by iFrame.
Qed. Qed.
Lemma lol_spec R cl `{oneshotG Σ} : Lemma test_spec R cl `{inG Σ testR, inG Σ fracR} :
cl C #0%nat - cl C #0%nat -
CWP lol (cloc_to_val cl) @ R {{ v, v = #21 CWP "x" ←ᶜ test (cloc_to_val cl); c_ret "x" @ R {{ v, v = #21
(cl C #10 cl C #11) }}. (cl C #10 cl C #11) }}.
Proof. Proof.
iIntros "Hl". iApply cwp_fun. iIntros "Hl". iApply cwp_seq_bind. iApply cwp_fun. simpl.
iMod (own_alloc (! 0%nat ! 0%nat)) as (γ) "[Hγ [Hγ1 Hγ2]]"; [done|]. iMod gnew as (γl) "[H1 lb]".
set (lol_inv := ((cl C #0 own γ (! 0%nat)) iMod gnew as (γr) "[H2 rb]".
(cl C #10 own γ (! 10%nat)) set (test_inv := ( b1 b2, gauth γl b1 gauth γr b2
(cl C[LLvl] #11 own γ (! 11%nat)) match b1, b2 with
| false, false => cl C #0
| true, false => cl C #10
| false, true => cl C[LLvl] #11
| _, _ => cl C #10 cl C[LLvl] #11
end
)%I). )%I).
iApply (cwp_insert_res _ _ lol_inv with "[Hγ Hl]"). iApply (cwp_insert_res _ _ test_inv with "[H1 H2 Hl]").
{ iNext. iLeft. eauto with iFrame. } { iNext. iExists false,false. iFrame. }
simpl. iApply (cwp_bin_op _ _ (λ v, v = #10 γl true)%I
iApply (cwp_bin_op _ _ (λ v, v = #10 own γ (!{1 / 2} 10%nat))%I (λ v, v = #11 γr true)%I
(λ v, v = #11 own γ (!{1 / 2} 11%nat))%I with "[lb] [rb]").
with "[Hγ1] [Hγ2]"). - vcg. unfold test_inv. iIntros "[H R]".
- vcg. unfold lol_inv. iIntros "[H R]". iDestruct "H" as (b1 b2) "(H1 & H2 & H)".
admit. iDestruct (gagree with "lb H1") as %<-.
destruct b2; iNext; iModIntro.
+ iMod (gupdate true with "lb H1") as "[lb H1]".
iApply (storeme_spec with "H").
iIntros "Hl". iFrame "R".
iSplitR "lb"; last by (vcg_continue; eauto with iFrame).
iExists _,_; eauto with iFrame.
+ iMod (gupdate true with "lb H1") as "[lb H1]".
iApply (storeme_spec with "H").
iIntros "Hl". iFrame "R".
iSplitR "lb"; last by (vcg_continue; eauto with iFrame).
iExists _,_; eauto with iFrame.
- iApply (cwp_store_hard _ _ (λ v, v = cloc_to_val cl)%I - iApply (cwp_store_hard _ _ (λ v, v = cloc_to_val cl)%I
(λ v, v = #11)%I). (λ v, v = #11)%I).
1,2: vcg; eauto. 1,2: vcg; eauto.
iIntros (? ? -> ->) "[H R]". unfold lol_inv. iIntros (? ? -> ->) "[H R]". unfold test_inv.
iDestruct "H" as "[[Hcl H] | [[Hcl H] | [Hcl H]]]". iDestruct "H" as (b1 b2) "(H1 & H2 & H)".
iDestruct (gagree with "rb H2") as %<-.
destruct b1; iEval (simpl) in "H".
+ iExists cl, _. iFrame. iSplit; first done. + iExists cl, _. iFrame. iSplit; first done.
iIntros "Hl". iMod (own_update_2 with "H Hγ2") as "[H Hγ2]". iIntros "Hl".
{ apply frac_auth_update. iMod (gupdate true with "rb H2") as "[rb H2]".
apply (nat_local_update _ _ 11%nat 11%nat); lia. } iModIntro. iSplitR "rb"; last by eauto with iFrame.
iModIntro. iFrame "Hγ2". iSplit; last done. iExists _,_; eauto with iFrame.
iRight. iRight. iFrame.
+ iExists cl, _. iFrame. iSplit; first done. + iExists cl, _. iFrame. iSplit; first done.
iIntros "Hl". iMod (own_update_2 with "H Hγ2") as "[H Hγ2]". iIntros "Hl".
{ apply frac_auth_update. iMod (gupdate true with "rb H2") as "[rb H2]".
apply (nat_local_update _ _ 11%nat 1%nat). lia. } iModIntro. iSplitR "rb"; last by eauto with iFrame.
iModIntro. Abort. iExists _,_; eauto with iFrame.
End lol. - iIntros (v1 v2) "[% lb] [% rb]"; simplify_eq/=.
iExists #21; simpl. iSplit; first done.
iIntros "H". iDestruct "H" as (b1 b2) "(H1 & H2 & H)".
do 3 iModIntro.
iDestruct (gagree with "lb H1") as %<-.
iDestruct (gagree with "rb H2") as %<-.
iDestruct "H" as "[H|H]"; iModIntro; vcg; eauto with iFrame.
Qed.
End test.
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