Commit bb7c8731 authored by Dan Frumin's avatar 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!
Please register or to comment