Commit b85484c9 by 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!