Commit 242cee02 authored by Ralf Jung's avatar Ralf Jung

make primitive compare-exchange return both boolean and old value for ease of use

parent 5fae061a
...@@ -116,7 +116,6 @@ theories/heap_lang/lib/clairvoyant_coin.v ...@@ -116,7 +116,6 @@ theories/heap_lang/lib/clairvoyant_coin.v
theories/heap_lang/lib/counter.v theories/heap_lang/lib/counter.v
theories/heap_lang/lib/atomic_heap.v theories/heap_lang/lib/atomic_heap.v
theories/heap_lang/lib/increment.v theories/heap_lang/lib/increment.v
theories/heap_lang/lib/compare_and_set.v
theories/proofmode/base.v theories/proofmode/base.v
theories/proofmode/tokens.v theories/proofmode/tokens.v
theories/proofmode/coq_tactics.v theories/proofmode/coq_tactics.v
......
...@@ -40,7 +40,7 @@ ...@@ -40,7 +40,7 @@
============================ ============================
_ : ▷ l ↦ #0 _ : ▷ l ↦ #0
--------------------------------------∗ --------------------------------------∗
WP CAS #l #0 #1 {{ _, l ↦ #1 }} WP CompareExchange #l #0 #1 {{ _, l ↦ #1 }}
1 subgoal 1 subgoal
...@@ -148,4 +148,5 @@ Tactic failure: wp_pure: cannot find ?y in (Var "x") or ...@@ -148,4 +148,5 @@ Tactic failure: wp_pure: cannot find ?y in (Var "x") or
: string : string
The command has indeed failed with message: The command has indeed failed with message:
Ltac call to "wp_cas_suc" failed. Ltac call to "wp_cas_suc" failed.
Tactic failure: wp_cas_suc: cannot find 'CAS' in (#() #()). Tactic failure: wp_cas_suc: cannot find 'CompareExchange' in
(#() #()).
...@@ -79,7 +79,7 @@ Section tests. ...@@ -79,7 +79,7 @@ Section tests.
Lemma heap_e6_spec (v : val) : (WP heap_e6 v {{ w, w = #true }})%I. Lemma heap_e6_spec (v : val) : (WP heap_e6 v {{ w, w = #true }})%I.
Proof. wp_lam. wp_op. by case_bool_decide. Qed. Proof. wp_lam. wp_op. by case_bool_decide. Qed.
Definition heap_e7 : val := λ: "v", CAS "v" #0 #1. Definition heap_e7 : val := λ: "v", CompareExchange "v" #0 #1.
Lemma heap_e7_spec_total l : l #0 - WP heap_e7 #l [{_, l #1 }]. Lemma heap_e7_spec_total l : l #0 - WP heap_e7 #l [{_, l #1 }].
Proof. iIntros. wp_lam. wp_cas_suc. auto. Qed. Proof. iIntros. wp_lam. wp_cas_suc. auto. Qed.
...@@ -126,7 +126,7 @@ Section tests. ...@@ -126,7 +126,7 @@ Section tests.
Lemma wp_cas l v : Lemma wp_cas l v :
val_is_unboxed v val_is_unboxed v
l v - WP CAS #l v v {{ _, True }}. l v - WP CompareExchange #l v v {{ _, True }}.
Proof. Proof.
iIntros (?) "?". wp_cas as ? | ?. done. done. iIntros (?) "?". wp_cas as ? | ?. done. done.
Qed. Qed.
......
...@@ -11,7 +11,8 @@ Section tests. ...@@ -11,7 +11,8 @@ Section tests.
Lemma test_resolve1 E (l : loc) (n : Z) (p : proph_id) (vs : list (val * val)) (v : val) : Lemma test_resolve1 E (l : loc) (n : Z) (p : proph_id) (vs : list (val * val)) (v : val) :
l #n - l #n -
proph p vs - proph p vs -
WP Resolve (CAS #l #n (#n + #1)) #p v @ E {{ v, v = #n vs, proph p vs l #(n+1) }}%I. WP Resolve (CompareExchange #l #n (#n + #1)) #p v @ E
{{ v, v = (#true, #n)%V vs, proph p vs l #(n+1) }}%I.
Proof. Proof.
iIntros "Hl Hp". wp_pures. wp_apply (wp_resolve with "Hp"); first done. iIntros "Hl Hp". wp_pures. wp_apply (wp_resolve with "Hp"); first done.
wp_cas_suc. iIntros (ws ->) "Hp". eauto with iFrame. wp_cas_suc. iIntros (ws ->) "Hp". eauto with iFrame.
......
...@@ -121,7 +121,7 @@ Definition newcounter : val := λ: <>, ref #0. ...@@ -121,7 +121,7 @@ Definition newcounter : val := λ: <>, ref #0.
Definition incr : val := Definition incr : val :=
rec: "incr" "l" := rec: "incr" "l" :=
let: "n" := !"l" in let: "n" := !"l" in
if: CAS "l" "n" (#1 + "n") = "n" then #() else "incr" "l". if: CAS "l" "n" (#1 + "n") then #() else "incr" "l".
Definition read : val := λ: "l", !"l". Definition read : val := λ: "l", !"l".
(** The CMRA we need. *) (** The CMRA we need. *)
...@@ -222,7 +222,7 @@ Section counter_proof. ...@@ -222,7 +222,7 @@ Section counter_proof.
iDestruct 1 as (c) "[Hl Hγ]". iDestruct 1 as (c) "[Hl Hγ]".
wp_load. iSplitL "Hl Hγ"; [iNext; iExists c; by iFrame|]. wp_load. iSplitL "Hl Hγ"; [iNext; iExists c; by iFrame|].
wp_let. wp_op. wp_let. wp_op.
wp_bind (CAS _ _ _). iApply wp_inv_open; last iFrame "Hinv"; auto. wp_bind (CompareExchange _ _ _). iApply wp_inv_open; last iFrame "Hinv"; auto.
iDestruct 1 as (c') ">[Hl Hγ]". iDestruct 1 as (c') ">[Hl Hγ]".
destruct (decide (c' = c)) as [->|]. destruct (decide (c' = c)) as [->|].
- iCombine "Hγ" "Hγf" as "Hγ". - iCombine "Hγ" "Hγf" as "Hγ".
...@@ -231,11 +231,10 @@ Section counter_proof. ...@@ -231,11 +231,10 @@ Section counter_proof.
rewrite (auth_frag_op (S n) (S c)); last lia; iDestruct "Hγ" as "[Hγ Hγf]". rewrite (auth_frag_op (S n) (S c)); last lia; iDestruct "Hγ" as "[Hγ Hγf]".
wp_cas_suc. iSplitL "Hl Hγ". wp_cas_suc. iSplitL "Hl Hγ".
{ iNext. iExists (S c). rewrite Nat2Z.inj_succ Z.add_1_l. by iFrame. } { iNext. iExists (S c). rewrite Nat2Z.inj_succ Z.add_1_l. by iFrame. }
wp_op. rewrite bool_decide_true //. wp_if. rewrite {3}/C; eauto 10. wp_pures. rewrite {3}/C; eauto 10.
- assert (#c #c') by (intros [=]; abstract omega). wp_cas_fail. - wp_cas_fail; first (intros [=]; abstract omega).
iSplitL "Hl Hγ"; [iNext; iExists c'; by iFrame|]. iSplitL "Hl Hγ"; [iNext; iExists c'; by iFrame|].
wp_op. rewrite bool_decide_false //. wp_if. wp_pures. iApply ("IH" with "[Hγf]"). rewrite {3}/C; eauto 10.
iApply ("IH" with "[Hγf]"). rewrite {3}/C; eauto 10.
Qed. Qed.
Check "read_spec". Check "read_spec".
......
...@@ -9,7 +9,7 @@ Set Default Proof Using "Type". ...@@ -9,7 +9,7 @@ Set Default Proof Using "Type".
Definition one_shot_example : val := λ: <>, Definition one_shot_example : val := λ: <>,
let: "x" := ref NONE in ( let: "x" := ref NONE in (
(* tryset *) (λ: "n", (* tryset *) (λ: "n",
CAS "x" NONE (SOME "n") = NONE), CAS "x" NONE (SOME "n")),
(* check *) (λ: <>, (* check *) (λ: <>,
let: "y" := !"x" in λ: <>, let: "y" := !"x" in λ: <>,
match: "y" with match: "y" with
...@@ -49,15 +49,13 @@ Proof. ...@@ -49,15 +49,13 @@ Proof.
iMod (inv_alloc N _ (one_shot_inv γ l) with "[Hl Hγ]") as "#HN". iMod (inv_alloc N _ (one_shot_inv γ l) with "[Hl Hγ]") as "#HN".
{ iNext. iLeft. by iSplitL "Hl". } { iNext. iLeft. by iSplitL "Hl". }
wp_pures. iModIntro. iApply "Hf"; iSplit. wp_pures. iModIntro. iApply "Hf"; iSplit.
- iIntros (n) "!#". wp_lam. wp_pures. wp_bind (CAS _ _ _). - iIntros (n) "!#". wp_lam. wp_pures. wp_bind (CompareExchange _ _ _).
iInv N as ">[[Hl Hγ]|H]"; last iDestruct "H" as (m) "[Hl Hγ]". iInv N as ">[[Hl Hγ]|H]"; last iDestruct "H" as (m) "[Hl Hγ]".
+ iMod (own_update with "Hγ") as "Hγ". + iMod (own_update with "Hγ") as "Hγ".
{ by apply cmra_update_exclusive with (y:=Shot n). } { by apply cmra_update_exclusive with (y:=Shot n). }
wp_cas_suc. iSplitL; iModIntro; last first. wp_cas_suc. iModIntro. iSplitL; last (wp_pures; by eauto).
{ wp_pures. eauto. }
iNext; iRight; iExists n; by iFrame. iNext; iRight; iExists n; by iFrame.
+ wp_cas_fail. iSplitL; iModIntro; last first. + wp_cas_fail. iModIntro. iSplitL; last (wp_pures; by eauto).
{ wp_pures. eauto. }
rewrite /one_shot_inv; eauto 10. rewrite /one_shot_inv; eauto 10.
- iIntros "!# /=". wp_lam. wp_bind (! _)%E. - iIntros "!# /=". wp_lam. wp_bind (! _)%E.
iInv N as ">Hγ". iInv N as ">Hγ".
......
...@@ -97,7 +97,7 @@ Inductive expr := ...@@ -97,7 +97,7 @@ Inductive expr :=
| AllocN (e1 e2 : expr) (* array length (positive number), initial value *) | AllocN (e1 e2 : expr) (* array length (positive number), initial value *)
| Load (e : expr) | Load (e : expr)
| Store (e1 : expr) (e2 : expr) | Store (e1 : expr) (e2 : expr)
| CAS (e0 : expr) (e1 : expr) (e2 : expr) (* Compare-and-swap (NOT compare-and-set!) *) | CompareExchange (e0 : expr) (e1 : expr) (e2 : expr)
| FAA (e1 : expr) (e2 : expr) (* Fetch-and-add *) | FAA (e1 : expr) (e2 : expr) (* Fetch-and-add *)
(* Prophecy *) (* Prophecy *)
| NewProph | NewProph
...@@ -235,7 +235,7 @@ Proof. ...@@ -235,7 +235,7 @@ Proof.
| Load e, Load e' => cast_if (decide (e = e')) | Load e, Load e' => cast_if (decide (e = e'))
| Store e1 e2, Store e1' e2' => | Store e1 e2, Store e1' e2' =>
cast_if_and (decide (e1 = e1')) (decide (e2 = e2')) cast_if_and (decide (e1 = e1')) (decide (e2 = e2'))
| CAS e0 e1 e2, CAS e0' e1' e2' => | CompareExchange e0 e1 e2, CompareExchange e0' e1' e2' =>
cast_if_and3 (decide (e0 = e0')) (decide (e1 = e1')) (decide (e2 = e2')) cast_if_and3 (decide (e0 = e0')) (decide (e1 = e1')) (decide (e2 = e2'))
| FAA e1 e2, FAA e1' e2' => | FAA e1 e2, FAA e1' e2' =>
cast_if_and (decide (e1 = e1')) (decide (e2 = e2')) cast_if_and (decide (e1 = e1')) (decide (e2 = e2'))
...@@ -311,7 +311,7 @@ Proof. ...@@ -311,7 +311,7 @@ Proof.
| AllocN e1 e2 => GenNode 13 [go e1; go e2] | AllocN e1 e2 => GenNode 13 [go e1; go e2]
| Load e => GenNode 14 [go e] | Load e => GenNode 14 [go e]
| Store e1 e2 => GenNode 15 [go e1; go e2] | Store e1 e2 => GenNode 15 [go e1; go e2]
| CAS e0 e1 e2 => GenNode 16 [go e0; go e1; go e2] | CompareExchange e0 e1 e2 => GenNode 16 [go e0; go e1; go e2]
| FAA e1 e2 => GenNode 17 [go e1; go e2] | FAA e1 e2 => GenNode 17 [go e1; go e2]
| NewProph => GenNode 18 [] | NewProph => GenNode 18 []
| Resolve e0 e1 e2 => GenNode 19 [go e0; go e1; go e2] | Resolve e0 e1 e2 => GenNode 19 [go e0; go e1; go e2]
...@@ -346,7 +346,7 @@ Proof. ...@@ -346,7 +346,7 @@ Proof.
| GenNode 13 [e1; e2] => AllocN (go e1) (go e2) | GenNode 13 [e1; e2] => AllocN (go e1) (go e2)
| GenNode 14 [e] => Load (go e) | GenNode 14 [e] => Load (go e)
| GenNode 15 [e1; e2] => Store (go e1) (go e2) | GenNode 15 [e1; e2] => Store (go e1) (go e2)
| GenNode 16 [e0; e1; e2] => CAS (go e0) (go e1) (go e2) | GenNode 16 [e0; e1; e2] => CompareExchange (go e0) (go e1) (go e2)
| GenNode 17 [e1; e2] => FAA (go e1) (go e2) | GenNode 17 [e1; e2] => FAA (go e1) (go e2)
| GenNode 18 [] => NewProph | GenNode 18 [] => NewProph
| GenNode 19 [e0; e1; e2] => Resolve (go e0) (go e1) (go e2) | GenNode 19 [e0; e1; e2] => Resolve (go e0) (go e1) (go e2)
...@@ -401,9 +401,9 @@ Inductive ectx_item := ...@@ -401,9 +401,9 @@ Inductive ectx_item :=
| LoadCtx | LoadCtx
| StoreLCtx (v2 : val) | StoreLCtx (v2 : val)
| StoreRCtx (e1 : expr) | StoreRCtx (e1 : expr)
| CasLCtx (v1 : val) (v2 : val) | CompareExchangeLCtx (v1 : val) (v2 : val)
| CasMCtx (e0 : expr) (v2 : val) | CompareExchangeMCtx (e0 : expr) (v2 : val)
| CasRCtx (e0 : expr) (e1 : expr) | CompareExchangeRCtx (e0 : expr) (e1 : expr)
| FaaLCtx (v2 : val) | FaaLCtx (v2 : val)
| FaaRCtx (e1 : expr) | FaaRCtx (e1 : expr)
| ResolveLCtx (ctx : ectx_item) (v1 : val) (v2 : val) | ResolveLCtx (ctx : ectx_item) (v1 : val) (v2 : val)
...@@ -437,9 +437,9 @@ Fixpoint fill_item (Ki : ectx_item) (e : expr) : expr := ...@@ -437,9 +437,9 @@ Fixpoint fill_item (Ki : ectx_item) (e : expr) : expr :=
| LoadCtx => Load e | LoadCtx => Load e
| StoreLCtx v2 => Store e (Val v2) | StoreLCtx v2 => Store e (Val v2)
| StoreRCtx e1 => Store e1 e | StoreRCtx e1 => Store e1 e
| CasLCtx v1 v2 => CAS e (Val v1) (Val v2) | CompareExchangeLCtx v1 v2 => CompareExchange e (Val v1) (Val v2)
| CasMCtx e0 v2 => CAS e0 e (Val v2) | CompareExchangeMCtx e0 v2 => CompareExchange e0 e (Val v2)
| CasRCtx e0 e1 => CAS e0 e1 e | CompareExchangeRCtx e0 e1 => CompareExchange e0 e1 e
| FaaLCtx v2 => FAA e (Val v2) | FaaLCtx v2 => FAA e (Val v2)
| FaaRCtx e1 => FAA e1 e | FaaRCtx e1 => FAA e1 e
| ResolveLCtx K v1 v2 => Resolve (fill_item K e) (Val v1) (Val v2) | ResolveLCtx K v1 v2 => Resolve (fill_item K e) (Val v1) (Val v2)
...@@ -468,7 +468,7 @@ Fixpoint subst (x : string) (v : val) (e : expr) : expr := ...@@ -468,7 +468,7 @@ Fixpoint subst (x : string) (v : val) (e : expr) : expr :=
| AllocN e1 e2 => AllocN (subst x v e1) (subst x v e2) | AllocN e1 e2 => AllocN (subst x v e1) (subst x v e2)
| Load e => Load (subst x v e) | Load e => Load (subst x v e)
| Store e1 e2 => Store (subst x v e1) (subst x v e2) | Store e1 e2 => Store (subst x v e1) (subst x v e2)
| CAS e0 e1 e2 => CAS (subst x v e0) (subst x v e1) (subst x v e2) | CompareExchange e0 e1 e2 => CompareExchange (subst x v e0) (subst x v e1) (subst x v e2)
| FAA e1 e2 => FAA (subst x v e1) (subst x v e2) | FAA e1 e2 => FAA (subst x v e1) (subst x v e2)
| NewProph => NewProph | NewProph => NewProph
| Resolve ex e1 e2 => Resolve (subst x v ex) (subst x v e1) (subst x v e2) | Resolve ex e1 e2 => Resolve (subst x v ex) (subst x v e1) (subst x v e2)
...@@ -634,13 +634,14 @@ Inductive head_step : expr → state → list observation → expr → state → ...@@ -634,13 +634,14 @@ Inductive head_step : expr → state → list observation → expr → state →
[] []
(Val $ LitV LitUnit) (state_upd_heap <[l:=v]> σ) (Val $ LitV LitUnit) (state_upd_heap <[l:=v]> σ)
[] []
| CasS l v1 v2 vl σ : | CompareExchangeS l v1 v2 vl σ :
vals_cas_compare_safe vl v1 vals_cas_compare_safe vl v1
σ.(heap) !! l = Some vl σ.(heap) !! l = Some vl
head_step (CAS (Val $ LitV $ LitLoc l) (Val v1) (Val v2)) σ (* Crucially, this compares the same way as [EqOp]! *)
let b := bool_decide (val_for_compare vl = val_for_compare v1) in
head_step (CompareExchange (Val $ LitV $ LitLoc l) (Val v1) (Val v2)) σ
[] []
(* Crucially, this compares the same way as [EqOp]! *) (Val $ PairV (LitV $ LitBool b) vl) (if b then state_upd_heap <[l:=v2]> σ else σ)
(Val vl) (if decide (val_for_compare vl = val_for_compare v1) then state_upd_heap <[l:=v2]> σ else σ)
[] []
| FaaS l i1 i2 σ : | FaaS l i1 i2 σ :
σ.(heap) !! l = Some (LitV (LitInt i1)) σ.(heap) !! l = Some (LitV (LitInt i1))
......
...@@ -31,12 +31,14 @@ Class atomic_heap {Σ} `{!heapG Σ} := AtomicHeap { ...@@ -31,12 +31,14 @@ Class atomic_heap {Σ} `{!heapG Σ} := AtomicHeap {
(* This spec is slightly weaker than it could be: It is sufficient for [w1] (* This spec is slightly weaker than it could be: It is sufficient for [w1]
*or* [v] to be unboxed. However, by writing it this way the [val_is_unboxed] *or* [v] to be unboxed. However, by writing it this way the [val_is_unboxed]
is outside the atomic triple, which makes it much easier to use -- and the is outside the atomic triple, which makes it much easier to use -- and the
spec is still good enough for all our applications. *) spec is still good enough for all our applications.
The postcondition deliberately does not use [bool_decide] so that users can
[destruct (decide (a = b))] and it will simplify in both places. *)
cas_spec (l : loc) (w1 w2 : val) : cas_spec (l : loc) (w1 w2 : val) :
val_is_unboxed w1 val_is_unboxed w1
<<< v, mapsto l 1 v >>> cas #l w1 w2 @ <<< v, mapsto l 1 v >>> cas #l w1 w2 @
<<< if decide (val_for_compare v = val_for_compare w1) then mapsto l 1 w2 else mapsto l 1 v, <<< if decide (val_for_compare v = val_for_compare w1) then mapsto l 1 w2 else mapsto l 1 v,
RET v >>>; RET #(if decide (val_for_compare v = val_for_compare w1) then true else false) >>>;
}. }.
Arguments atomic_heap _ {_}. Arguments atomic_heap _ {_}.
...@@ -100,13 +102,13 @@ Section proof. ...@@ -100,13 +102,13 @@ Section proof.
<<< (v : val), l v >>> <<< (v : val), l v >>>
primitive_cas #l w1 w2 @ primitive_cas #l w1 w2 @
<<< if decide (val_for_compare v = val_for_compare w1) then l w2 else l v, <<< if decide (val_for_compare v = val_for_compare w1) then l w2 else l v,
RET v >>>. RET #(if decide (val_for_compare v = val_for_compare w1) then true else false) >>>.
Proof. Proof.
iIntros (? Φ) "AU". wp_lam. wp_let. wp_let. iIntros (? Φ) "AU". wp_lam. wp_pures. wp_bind (CompareExchange _ _ _).
iMod "AU" as (v) "[H↦ [_ Hclose]]". iMod "AU" as (v) "[H↦ [_ Hclose]]".
destruct (decide (val_for_compare v = val_for_compare w1)) as [Heq|Hne]; destruct (decide (val_for_compare v = val_for_compare w1)) as [Heq|Hne];
[wp_cas_suc|wp_cas_fail]; [wp_cas_suc|wp_cas_fail];
iMod ("Hclose" with "H↦") as "HΦ"; done. iMod ("Hclose" with "H↦") as "HΦ"; iModIntro; by wp_pures.
Qed. Qed.
End proof. End proof.
......
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. ...@@ -3,13 +3,13 @@ From iris.base_logic.lib Require Export invariants.
From iris.heap_lang Require Export lang. From iris.heap_lang Require Export lang.
From iris.proofmode Require Import tactics. From iris.proofmode Require Import tactics.
From iris.algebra Require Import frac_auth auth. From iris.algebra Require Import frac_auth auth.
From iris.heap_lang Require Import proofmode notation lib.compare_and_set. From iris.heap_lang Require Import proofmode notation.
Set Default Proof Using "Type". Set Default Proof Using "Type".
Definition newcounter : val := λ: <>, ref #0. Definition newcounter : val := λ: <>, ref #0.
Definition incr : val := rec: "incr" "l" := Definition incr : val := rec: "incr" "l" :=
let: "n" := !"l" in let: "n" := !"l" in
if: compare_and_set "l" "n" (#1 + "n") then #() else "incr" "l". if: CAS "l" "n" (#1 + "n") then #() else "incr" "l".
Definition read : val := λ: "l", !"l". Definition read : val := λ: "l", !"l".
(** Monotone counter *) (** Monotone counter *)
...@@ -50,25 +50,22 @@ Section mono_proof. ...@@ -50,25 +50,22 @@ Section mono_proof.
iDestruct "Hl" as (γ) "[#? Hγf]". iDestruct "Hl" as (γ) "[#? Hγf]".
wp_bind (! _)%E. iInv N as (c) ">[Hγ Hl]". wp_bind (! _)%E. iInv N as (c) ">[Hγ Hl]".
wp_load. iModIntro. iSplitL "Hl Hγ"; [iNext; iExists c; by iFrame|]. wp_load. iModIntro. iSplitL "Hl Hγ"; [iNext; iExists c; by iFrame|].
wp_pures. wp_apply caset_spec; first done. wp_pures. wp_bind (CompareExchange _ _ _).
iInv N as (c') ">[Hγ Hl]" "Hclose". iInv N as (c') ">[Hγ Hl]".
destruct (decide (c' = c)) as [->|]. destruct (decide (c' = c)) as [->|].
- iDestruct (own_valid_2 with "Hγ Hγf") - iDestruct (own_valid_2 with "Hγ Hγf")
as %[?%mnat_included _]%auth_both_valid. as %[?%mnat_included _]%auth_both_valid.
iMod (own_update_2 with "Hγ Hγf") as "[Hγ Hγf]". iMod (own_update_2 with "Hγ Hγf") as "[Hγ Hγf]".
{ apply auth_update, (mnat_local_update _ _ (S c)); auto. } { apply auth_update, (mnat_local_update _ _ (S c)); auto. }
iExists _; iFrame "Hl". iIntros "!> Hl". wp_cas_suc. iModIntro. iSplitL "Hl Hγ".
rewrite bool_decide_true //. iMod ("Hclose" with "[Hl Hγ]") as "_". { iNext. iExists (S c). rewrite Nat2Z.inj_succ Z.add_1_l. by iFrame. }
{ iNext. iExists (S c). rewrite Nat2Z.inj_succ Z.add_1_l. iFrame. } wp_pures. iApply "HΦ"; iExists γ; repeat iSplit; eauto.
iModIntro. wp_if.
iApply "HΦ"; iExists γ; repeat iSplit; eauto.
iApply (own_mono with "Hγf"). iApply (own_mono with "Hγf").
(* FIXME: FIXME(Coq #6294): needs new unification *) (* FIXME: FIXME(Coq #6294): needs new unification *)
apply: auth_frag_mono. by apply mnat_included, le_n_S. apply: auth_frag_mono. by apply mnat_included, le_n_S.
- iExists _; iFrame "Hl". iIntros "!> Hl". - wp_cas_fail; first (by intros [= ?%Nat2Z.inj]). iModIntro.
rewrite bool_decide_false; last by intros [= ?%Nat2Z.inj]. iSplitL "Hl Hγ"; [iNext; iExists c'; by iFrame|].
iMod ("Hclose" with "[Hl Hγ]") as "_"; [iNext; iExists c'; by iFrame|]. wp_pures. iApply ("IH" with "[Hγf] [HΦ]"); last by auto.
iModIntro. wp_if. iApply ("IH" with "[Hγf] [HΦ]"); last by auto.
rewrite {3}/mcounter; eauto 10. rewrite {3}/mcounter; eauto 10.
Qed. Qed.
...@@ -132,19 +129,17 @@ Section contrib_spec. ...@@ -132,19 +129,17 @@ Section contrib_spec.
iIntros (Φ) "[#? Hγf] HΦ". iLöb as "IH". wp_rec. iIntros (Φ) "[#? Hγf] HΦ". iLöb as "IH". wp_rec.
wp_bind (! _)%E. iInv N as (c) ">[Hγ Hl]". wp_bind (! _)%E. iInv N as (c) ">[Hγ Hl]".
wp_load. iModIntro. iSplitL "Hl Hγ"; [iNext; iExists c; by iFrame|]. wp_load. iModIntro. iSplitL "Hl Hγ"; [iNext; iExists c; by iFrame|].
wp_pures. wp_apply caset_spec; first done. wp_pures. wp_bind (CompareExchange _ _ _).
iInv N as (c') ">[Hγ Hl]" "Hclose". iInv N as (c') ">[Hγ Hl]".
destruct (decide (c' = c)) as [->|]. destruct (decide (c' = c)) as [->|].
- iMod (own_update_2 with "Hγ Hγf") as "[Hγ Hγf]". - iMod (own_update_2 with "Hγ Hγf") as "[Hγ Hγf]".
{ apply frac_auth_update, (nat_local_update _ _ (S c) (S n)); lia. } { apply frac_auth_update, (nat_local_update _ _ (S c) (S n)); lia. }
iExists _; iFrame "Hl". iIntros "!> Hl". wp_cas_suc. iModIntro. iSplitL "Hl Hγ".
rewrite bool_decide_true //. iMod ("Hclose" with "[Hl Hγ]") as "_".
{ iNext. iExists (S c). rewrite Nat2Z.inj_succ Z.add_1_l. by iFrame. } { iNext. iExists (S c). rewrite Nat2Z.inj_succ Z.add_1_l. by iFrame. }
iModIntro. wp_if. by iApply "HΦ". wp_pures. by iApply "HΦ".
- iExists _; iFrame "Hl". iIntros "!> Hl". - wp_cas_fail; first (by intros [= ?%Nat2Z.inj]).
rewrite bool_decide_false; last by intros [= ?%Nat2Z.inj]. iModIntro. iSplitL "Hl Hγ"; [iNext; iExists c'; by iFrame|].
iMod ("Hclose" with "[Hl Hγ]"); [iNext; iExists c'; by iFrame|]. wp_pures. by iApply ("IH" with "[Hγf] [HΦ]"); auto.
iModIntro. wp_if. by iApply ("IH" with "[Hγf] [HΦ]"); auto.
Qed. Qed.
Lemma read_contrib_spec γ l q n : Lemma read_contrib_spec γ l q n :
......
...@@ -16,7 +16,7 @@ Section increment_physical. ...@@ -16,7 +16,7 @@ Section increment_physical.
Definition incr_phy : val := Definition incr_phy : val :=
rec: "incr" "l" := rec: "incr" "l" :=
let: "oldv" := !"l" in let: "oldv" := !"l" in
if: CAS "l" "oldv" ("oldv" + #1) = "oldv" if: CAS "l" "oldv" ("oldv" + #1)
then "oldv" (* return old value if success *) then "oldv" (* return old value if success *)
else "incr" "l". else "incr" "l".
...@@ -26,12 +26,12 @@ Section increment_physical. ...@@ -26,12 +26,12 @@ Section increment_physical.
iIntros (Φ) "AU". iLöb as "IH". wp_lam. iIntros (Φ) "AU". iLöb as "IH". wp_lam.
wp_bind (!_)%E. iMod "AU" as (v) "[Hl [Hclose _]]". wp_bind (!_)%E. iMod "AU" as (v) "[Hl [Hclose _]]".
wp_load. iMod ("Hclose" with "Hl") as "AU". iModIntro. wp_load. iMod ("Hclose" with "Hl") as "AU". iModIntro.
wp_pures. wp_bind (CAS _ _ _)%E. iMod "AU" as (w) "[Hl Hclose]". wp_pures. wp_bind (CompareExchange _ _ _)%E. iMod "AU" as (w) "[Hl Hclose]".
destruct (decide (#v = #w)) as [[= ->]|Hx]. destruct (decide (#v = #w)) as [[= ->]|Hx].
- wp_cas_suc. iDestruct "Hclose" as "[_ Hclose]". iMod ("Hclose" with "Hl") as "HΦ". - wp_cas_suc. iDestruct "Hclose" as "[_ Hclose]". iMod ("Hclose" with "Hl") as "HΦ".
iModIntro. wp_op. rewrite bool_decide_true //. wp_if. done. iModIntro. wp_pures. done.
- wp_cas_fail. iDestruct "Hclose" as "[Hclose _]". iMod ("Hclose" with "Hl") as "AU". - wp_cas_fail. iDestruct "Hclose" as "[Hclose _]". iMod ("Hclose" with "Hl") as "AU".
iModIntro. wp_op. rewrite bool_decide_false //. wp_if. iApply "IH". done. iModIntro. wp_pures. iApply "IH". done.
Qed. Qed.
End increment_physical. End increment_physical.
...@@ -45,7 +45,7 @@ Section increment. ...@@ -45,7 +45,7 @@ Section increment.
Definition incr : val := Definition incr : val :=
rec: "incr" "l" := rec: "incr" "l" :=
let: "oldv" := !"l" in let: "oldv" := !"l" in
if: CAS "l" "oldv" ("oldv" + #1) = "oldv" if: CAS "l" "oldv" ("oldv" + #1)
then "oldv" (* return old value if success *) then "oldv" (* return old value if success *)
else "incr" "l". else "incr" "l".
...@@ -70,9 +70,9 @@ Section increment. ...@@ -70,9 +70,9 @@ Section increment.
{ (* abort case *) iDestruct "Hclose" as "[? _]". done. } { (* abort case *) iDestruct "Hclose" as "[? _]". done. }
iIntros "Hl". simpl. destruct (decide (#w = #v)) as [[= ->]|Hx]. iIntros "Hl". simpl. destruct (decide (#w = #v)) as [[= ->]|Hx].
- iDestruct "Hclose" as "[_ Hclose]". iMod ("Hclose" with "Hl") as "HΦ". - iDestruct "Hclose" as "[_ Hclose]". iMod ("Hclose" with "Hl") as "HΦ".
iIntros "!>". wp_op. rewrite bool_decide_true //. wp_if. by iApply "HΦ". iIntros "!>". wp_if. by iApply "HΦ".
- iDestruct "Hclose" as "[Hclose _]". iMod ("Hclose" with "Hl") as "AU". - iDestruct "Hclose" as "[Hclose _]". iMod ("Hclose" with "Hl") as "AU".
iIntros "!>". wp_op. rewrite bool_decide_false //. wp_if. iApply "IH". done. iIntros "!>". wp_if. iApply "IH". done.
Qed. Qed.