Commit bb7c8731 by Dan Frumin

### Full version of the "callback with lock" example

parent 52f32aaa
Pipeline #8690 passed with stage
in 6 minutes and 28 seconds
 ... @@ -186,10 +186,10 @@ Section refinement. ... @@ -186,10 +186,10 @@ Section refinement. Qed. Qed. (* Also known as "callback with lock" *) (* Also known as "callback with lock" *) Definition i3 x x' b b' : iProp Σ := Definition i3 (x x' b b' : loc) : iProp Σ := ((∃ (n : nat), x ↦ᵢ #n ∗ x' ↦ₛ #n ∗ (∃ (n:nat), x ↦ᵢ{1/2} #n ∗ x' ↦ₛ{1/2} #n ∗ b ↦ᵢ #true ∗ b' ↦ₛ #true) ((b ↦ᵢ #true ∗ b' ↦ₛ #true ∗ x ↦ᵢ{1/2} #n ∗ x' ↦ₛ{1/2} #n) ∨ (b ↦ᵢ #false ∗ b' ↦ₛ #false))%I. ∨ (b ↦ᵢ #false ∗ b' ↦ₛ #false)))%I. Definition i3n := nroot .@ "i3". Definition i3n := nroot .@ "i3". Lemma refinement3 Γ : Lemma refinement3 Γ : Γ ⊨ Γ ⊨ ... @@ -197,15 +197,17 @@ Section refinement. ... @@ -197,15 +197,17 @@ Section refinement. let: "x" := ref #0 in let: "x" := ref #0 in (λ: "f", if: CAS "b" #true #false (λ: "f", if: CAS "b" #true #false then "f" #();; "x" <- !"x" + #1 ;; "b" <- #true then "f" #();; "x" <- !"x" + #1 ;; "b" <- #true else #()) else #(), λ: <>, !"x") ≤log≤ ≤log≤ (let: "b" := ref #true in (let: "b" := ref #true in let: "x" := ref #0 in let: "x" := ref #0 in (λ: "f", if: CAS "b" #true #false (λ: "f", if: CAS "b" #true #false then let: "n" := !"x" in then let: "n" := !"x" in "f" #();; "x" <- "n" + #1 ;; "b" <- #true "f" #();; "x" <- "n" + #1 ;; "b" <- #true else #())) else #(), : TArrow (TArrow TUnit TUnit) TUnit. λ: <>, !"x")) : ((Unit → Unit) → Unit) × (Unit → TNat). Proof. Proof. iIntros (Δ). iIntros (Δ). rel_alloc_l as b "Hb". rel_alloc_l as b "Hb". ... @@ -217,51 +219,77 @@ Section refinement. ... @@ -217,51 +219,77 @@ Section refinement. rel_alloc_r as x' "Hx'". rel_alloc_r as x' "Hx'". rel_let_r. rel_let_r. iMod (inv_alloc i3n _ (i3 x x' b b') with "[-]") as "#Hinv". iMod (inv_alloc i3n _ (i3 x x' b b') with "[-]") as "#Hinv". { iNext. unfold i3. { iNext. unfold i3. iExists 0. iLeft. iExists 0. iFrame. } iDestruct "Hx" as "[\$ Hx]". iApply bin_log_related_arrow; eauto. iDestruct "Hx'" as "[\$ Hx']". iAlways. iIntros (f f') "Hf". iLeft. iFrame. } rel_let_l. iApply bin_log_related_pair. rel_let_r. - iApply bin_log_related_arrow; eauto. rel_cas_l_atomic. iAlways. iIntros (f f') "Hf". iInv i3n as ">Hbb" "Hcl". rel_let_l. rewrite {2}/i3. rel_let_r. iDestruct "Hbb" as "[Hbb | (Hb & Hb')]"; last first. rel_cas_l_atomic. { iModIntro; iExists _; iFrame. iInv i3n as (n) "(Hx & Hx' & >Hbb)" "Hcl". iSplitL; last by iIntros (?); congruence. iDestruct "Hbb" as "[(Hb & Hb' & Hx1 & Hx'1) | (Hb & Hb')]"; last first. iIntros (?); iNext; iIntros "Hb". { iModIntro; iExists _; iFrame. rel_cas_fail_r; rel_if_r; rel_if_l. iSplitL; last by iIntros (?); congruence. iMod ("Hcl" with "[-]"). iIntros (?); iNext; iIntros "Hb". { iNext. iRight. iFrame. } rel_cas_fail_r; rel_if_r; rel_if_l. rel_vals; eauto. iMod ("Hcl" with "[-]"). } { iNext. iExists n. iFrame. iRight. iFrame. } { iDestruct "Hbb" as (n) "(Hx & Hx' & Hb & Hb')". rel_vals; eauto. iModIntro. iExists _; iFrame. } iSplitR; first by iIntros (?); congruence. { iModIntro. iExists _; iFrame. iIntros (?); iNext; iIntros "Hb". iSplitR; first by iIntros (?); congruence. rel_cas_suc_r; rel_if_r; rel_if_l. iIntros (?); iNext; iIntros "Hb". rel_load_r. rel_let_r. rel_cas_suc_r; rel_if_r; rel_if_l. iMod ("Hcl" with "[Hb Hb']") as "_". rel_load_r. rel_let_r. { iNext. iRight. iFrame. } iMod ("Hcl" with "[Hb Hb' Hx Hx']") as "_". iApply (bin_log_related_seq' with "[Hf]"); auto. { iNext. iExists _; iFrame. iRight. iFrame. } { iApply (bin_log_related_app with "Hf"). iApply (bin_log_related_seq' with "[Hf]"); auto. iApply bin_log_related_unit. } { iApply (bin_log_related_app with "Hf"). rel_load_l. iApply bin_log_related_unit. } rel_op_l. rel_op_r. rel_load_l. rel_store_l. rel_store_r. rel_op_l. rel_op_r. rel_seq_l. rel_seq_r. rel_store_l_atomic. rel_store_l_atomic. iInv i3n as (n') "(>Hx & Hx' & >Hbb)" "Hcl". iInv i3n as ">Hi3" "Hcl". iDestruct (mapsto_agree with "Hx Hx1") as %->. iDestruct "Hi3" as "[Hi3 | [Hb Hb']]". iCombine "Hx Hx1" as "Hx". { iDestruct "Hi3" as (m) "(Hx1 & Hx1' & Hb & Hb')". iModIntro. iExists _; iFrame. iNext. iModIntro. iExists _; iFrame; iNext. iIntros "Hb". iIntros "Hx". iDestruct (mapsto_valid_2 x with "Hx Hx1") as %Hfoo. iCombine "Hx' Hx'1" as "Hx'". cbv in Hfoo. by exfalso. } rel_store_r. iModIntro; iExists _; iFrame; iNext; iIntros "Hb". iDestruct "Hx" as "[Hx Hx1]". rel_store_r. iDestruct "Hx'" as "[Hx' Hx'1]". iDestruct "Hbb" as "[(Hb & Hb' & Hx2 & Hx'2) | Hbb]". { iCombine "Hx Hx1" as "Hx". iDestruct (mapsto_valid_2 with "Hx Hx2") as %Hfoo. exfalso. compute in Hfoo. eauto. } iMod ("Hcl" with "[Hx Hx' Hbb]") as "_". { iNext. iExists _. iFrame. } rel_seq_l. rel_seq_r. rel_store_l_atomic. clear n'. iInv i3n as (n') "(>Hx & Hx' & >Hbb)" "Hcl". iDestruct (mapsto_agree with "Hx Hx1") as %->. iDestruct "Hbb" as "[(Hb & Hb' & Hx2 & Hx'2) | (Hb & Hb')]". { iCombine "Hx Hx1" as "Hx". iDestruct (mapsto_valid_2 with "Hx Hx2") as %Hfoo. exfalso. compute in Hfoo. eauto. } iModIntro; iExists _; iFrame; iNext. iIntros "Hb". rel_store_r. iMod ("Hcl" with "[-]") as "_". { iNext. iExists _. iFrame. iLeft. iFrame. } rel_vals; eauto. } - iApply bin_log_related_arrow; eauto. iAlways. iIntros (u u') "_". rel_let_l. rel_let_r. rel_load_l_atomic. iInv i3n as (n) "(>Hx & Hx' & >Hbb)" "Hcl". iModIntro. iExists _; iFrame; iNext. iIntros "Hx". rel_load_r. iMod ("Hcl" with "[-]") as "_". iMod ("Hcl" with "[-]") as "_". { iNext. iLeft. iExists _. iFrame. } { iNext. iExists _. iFrame. } rel_vals; eauto. } iApply bin_log_related_nat. Qed. Qed. (* /Sort of/ a well-bracketedness example. (* /Sort of/ a well-bracketedness example. ... ...
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!