Commit 10809c68 authored by Ralf Jung's avatar Ralf Jung

add 'atomic triple' for compare-and-set, and use it in one example

parent 011eb020
Pipeline #17648 passed with stage
in 13 minutes and 39 seconds
......@@ -115,6 +115,7 @@ theories/heap_lang/lib/lazy_coin.v
theories/heap_lang/lib/counter.v
theories/heap_lang/lib/atomic_heap.v
theories/heap_lang/lib/increment.v
theories/heap_lang/lib/compare_and_set.v
theories/proofmode/base.v
theories/proofmode/tokens.v
theories/proofmode/coq_tactics.v
......
From iris.heap_lang Require Export lifting notation.
From iris.program_logic Require Export atomic.
From iris.heap_lang Require Import proofmode notation.
Set Default Proof Using "Type".
(* Defines compare-and-set (CASet) on top of compare-and-swap (CAS). *)
Definition compare_and_set : val :=
λ: "l" "v1" "v2", CAS "l" "v1" "v2" = "v1".
Section proof.
Context `{!heapG Σ}.
(* This is basically a logically atomic spec, but stronger and hence easier to apply. *)
Lemma caset_spec (l : loc) (v1 v2 : val) Φ E :
val_is_unboxed v1
(|={,E}=> v, l v let b := bool_decide (val_for_compare v = val_for_compare v1) in
(l (if b then v2 else v) ={E,}= Φ #b) ) -
WP compare_and_set #l v1 v2 @ {{ Φ }}.
Proof.
iIntros (?) "AU". wp_lam. wp_pures. wp_bind (CAS _ _ _).
iMod "AU" as (v) "[H↦ Hclose]". case_bool_decide.
- wp_cas_suc. iMod ("Hclose" with "H↦"). iModIntro. wp_op.
rewrite bool_decide_true //.
- wp_cas_fail. iMod ("Hclose" with "H↦"). iModIntro. wp_op.
rewrite bool_decide_false //.
Qed.
End proof.
......@@ -3,13 +3,13 @@ From iris.base_logic.lib Require Export invariants.
From iris.heap_lang Require Export lang.
From iris.proofmode Require Import tactics.
From iris.algebra Require Import frac_auth auth.
From iris.heap_lang Require Import proofmode notation.
From iris.heap_lang Require Import proofmode notation lib.compare_and_set.
Set Default Proof Using "Type".
Definition newcounter : val := λ: <>, ref #0.
Definition incr : val := rec: "incr" "l" :=
let: "n" := !"l" in
if: CAS "l" "n" (#1 + "n") = "n" then #() else "incr" "l".
if: compare_and_set "l" "n" (#1 + "n") then #() else "incr" "l".
Definition read : val := λ: "l", !"l".
(** Monotone counter *)
......@@ -50,25 +50,25 @@ Section mono_proof.
iDestruct "Hl" as (γ) "[#? Hγf]".
wp_bind (! _)%E. iInv N as (c) ">[Hγ Hl]".
wp_load. iModIntro. iSplitL "Hl Hγ"; [iNext; iExists c; by iFrame|].
wp_pures.
wp_bind (CAS _ _ _). iInv N as (c') ">[Hγ Hl]".
wp_pures. wp_apply caset_spec; first done.
iInv N as (c') ">[Hγ Hl]" "Hclose".
destruct (decide (c' = c)) as [->|].
- iDestruct (own_valid_2 with "Hγ Hγf")
as %[?%mnat_included _]%auth_both_valid.
iMod (own_update_2 with "Hγ Hγf") as "[Hγ Hγf]".
{ apply auth_update, (mnat_local_update _ _ (S c)); auto. }
wp_cas_suc. iModIntro. iSplitL "Hl Hγ".
{ iNext. iExists (S c). rewrite Nat2Z.inj_succ Z.add_1_l. by iFrame. }
wp_op. rewrite bool_decide_true //. wp_if.
iExists _; iFrame "Hl". iIntros "!> Hl".
rewrite bool_decide_true //. iMod ("Hclose" with "[Hl Hγ]") as "_".
{ iNext. iExists (S c). rewrite Nat2Z.inj_succ Z.add_1_l. iFrame. }
iModIntro. wp_if.
iApply "HΦ"; iExists γ; repeat iSplit; eauto.
iApply (own_mono with "Hγf").
(* FIXME: FIXME(Coq #6294): needs new unification *)
apply: auth_frag_mono. by apply mnat_included, le_n_S.
- assert (#c #c') by by intros [= ?%Nat2Z.inj].
wp_cas_fail. iModIntro.
iSplitL "Hl Hγ"; [iNext; iExists c'; by iFrame|].
wp_op. rewrite bool_decide_false //. wp_if.
iApply ("IH" with "[Hγf] [HΦ]"); last by auto.
- iExists _; iFrame "Hl". iIntros "!> Hl".
rewrite bool_decide_false; last by intros [= ?%Nat2Z.inj].
iMod ("Hclose" with "[Hl Hγ]") as "_"; [iNext; iExists c'; by iFrame|].
iModIntro. wp_if. iApply ("IH" with "[Hγf] [HΦ]"); last by auto.
rewrite {3}/mcounter; eauto 10.
Qed.
......@@ -132,18 +132,19 @@ Section contrib_spec.
iIntros (Φ) "[#? Hγf] HΦ". iLöb as "IH". wp_rec.
wp_bind (! _)%E. iInv N as (c) ">[Hγ Hl]".
wp_load. iModIntro. iSplitL "Hl Hγ"; [iNext; iExists c; by iFrame|].
wp_pures.
wp_bind (CAS _ _ _). iInv N as (c') ">[Hγ Hl]".
wp_pures. wp_apply caset_spec; first done.
iInv N as (c') ">[Hγ Hl]" "Hclose".
destruct (decide (c' = c)) as [->|].
- iMod (own_update_2 with "Hγ Hγf") as "[Hγ Hγf]".
{ apply frac_auth_update, (nat_local_update _ _ (S c) (S n)); lia. }
wp_cas_suc. iModIntro. iSplitL "Hl Hγ".
iExists _; iFrame "Hl". iIntros "!> Hl".
rewrite bool_decide_true //. iMod ("Hclose" with "[Hl Hγ]") as "_".
{ iNext. iExists (S c). rewrite Nat2Z.inj_succ Z.add_1_l. by iFrame. }
wp_op. rewrite bool_decide_true //. wp_if. by iApply "HΦ".
- assert (#c #c') by by intros [= ?%Nat2Z.inj]. wp_cas_fail.
iModIntro. iSplitL "Hl Hγ"; [iNext; iExists c'; by iFrame|].
wp_op. rewrite bool_decide_false //. wp_if.
by iApply ("IH" with "[Hγf] [HΦ]"); auto.
iModIntro. wp_if. by iApply "HΦ".
- iExists _; iFrame "Hl". iIntros "!> Hl".
rewrite bool_decide_false; last by intros [= ?%Nat2Z.inj].
iMod ("Hclose" with "[Hl Hγ]"); [iNext; iExists c'; by iFrame|].
iModIntro. wp_if. by iApply ("IH" with "[Hγf] [HΦ]"); auto.
Qed.
Lemma read_contrib_spec γ l q n :
......
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