Commit 3b076d87 authored by Robbert Krebbers's avatar Robbert Krebbers

Prove correctness of counter with contributions.

parent d34f5890
From iris.program_logic Require Export weakestpre. From iris.program_logic Require Export weakestpre.
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 auth. From iris.algebra Require Import frac auth.
From iris.heap_lang Require Import proofmode notation. From iris.heap_lang Require Import proofmode notation.
Definition newcounter : val := λ: <>, ref #0. Definition newcounter : val := λ: <>, ref #0.
...@@ -12,73 +12,160 @@ Definition inc : val := ...@@ -12,73 +12,160 @@ Definition inc : val :=
Definition read : val := λ: "l", !"l". Definition read : val := λ: "l", !"l".
Global Opaque newcounter inc get. Global Opaque newcounter inc get.
(** The CMRA we need. *) (** Monotone counter *)
Class counterG Σ := CounterG { counter_tokG :> inG Σ (authR mnatUR) }. Class mcounterG Σ := MCounterG { mcounter_inG :> inG Σ (authR mnatUR) }.
Definition counterΣ : gFunctors := #[GFunctor (constRF (authR mnatUR))]. Definition mcounterΣ : gFunctors := #[GFunctor (constRF (authR mnatUR))].
Instance subG_counterΣ {Σ} : subG counterΣ Σ counterG Σ. Instance subG_mcounterΣ {Σ} : subG mcounterΣ Σ mcounterG Σ.
Proof. intros [?%subG_inG _]%subG_inv. split; apply _. Qed. Proof. intros [?%subG_inG _]%subG_inv. split; apply _. Qed.
Section proof. Section mono_proof.
Context `{!heapG Σ, !counterG Σ} (N : namespace). Context `{!heapG Σ, !mcounterG Σ} (N : namespace).
Definition counter_inv (γ : gname) (l : loc) : iProp Σ := Definition mcounter_inv (γ : gname) (l : loc) : iProp Σ :=
( n, own γ ( (n : mnat)) l #n)%I. ( n, own γ ( (n : mnat)) l #n)%I.
Definition counter (l : loc) (n : nat) : iProp Σ := Definition mcounter (l : loc) (n : nat) : iProp Σ :=
( γ, heapN N heap_ctx ( γ, heapN N heap_ctx
inv N (counter_inv γ l) own γ ( (n : mnat)))%I. inv N (mcounter_inv γ l) own γ ( (n : mnat)))%I.
(** The main proofs. *) (** The main proofs. *)
Global Instance counter_persistent l n : PersistentP (counter l n). Global Instance mcounter_persistent l n : PersistentP (mcounter l n).
Proof. apply _. Qed. Proof. apply _. Qed.
Lemma newcounter_spec (R : iProp Σ) Φ : Lemma newcounter_mono_spec (R : iProp Σ) Φ :
heapN N heapN N
heap_ctx ( l, counter l 0 - Φ #l) WP newcounter #() {{ Φ }}. heap_ctx ( l, mcounter l 0 - Φ #l) WP newcounter #() {{ Φ }}.
Proof. Proof.
iIntros (?) "[#Hh HΦ]". rewrite /newcounter /=. wp_seq. wp_alloc l as "Hl". iIntros (?) "[#Hh HΦ]". rewrite /newcounter /=. wp_seq. wp_alloc l as "Hl".
iVs (own_alloc ( (O:mnat) (O:mnat))) as (γ) "[Hγ Hγ']"; first done. iVs (own_alloc ( (O:mnat) (O:mnat))) as (γ) "[Hγ Hγ']"; first done.
iVs (inv_alloc N _ (counter_inv γ l) with "[Hl Hγ]"). iVs (inv_alloc N _ (mcounter_inv γ l) with "[Hl Hγ]").
{ iNext. iExists 0%nat. by iFrame. } { iNext. iExists 0%nat. by iFrame. }
iVsIntro. iApply "HΦ". rewrite /counter; eauto 10. iVsIntro. iApply "HΦ". rewrite /mcounter; eauto 10.
Qed. Qed.
Lemma inc_spec l n (Φ : val iProp Σ) : Lemma inc_mono_spec l n (Φ : val iProp Σ) :
counter l n (counter l (S n) - Φ #()) WP inc #l {{ Φ }}. mcounter l n (mcounter l (S n) - Φ #()) WP inc #l {{ Φ }}.
Proof. Proof.
iIntros "[Hl HΦ]". iLöb as "IH". wp_rec. iIntros "[Hl HΦ]". iLöb as "IH". wp_rec.
iDestruct "Hl" as (γ) "(% & #? & #Hinv & Hγf)". iDestruct "Hl" as (γ) "(% & #? & #Hinv & Hγf)".
wp_bind (! _)%E. iInv N as (c) ">[Hγ Hl]" "Hclose". wp_bind (! _)%E. iInv N as (c) ">[Hγ Hl]" "Hclose".
wp_load. iVs ("Hclose" with "[Hl Hγ]") as "_"; [iNext; iExists c; by iFrame|]. wp_load. iVs ("Hclose" with "[Hl Hγ]") as "_"; [iNext; iExists c; by iFrame|].
iVsIntro. wp_let. wp_op. iVsIntro. wp_let. wp_op.
wp_bind (CAS _ _ _). iInv N as (c') ">[Hγ Hl]" "Hclose". wp_bind (CAS _ _ _). iInv N as (c') ">[Hγ Hl]" "Hclose".
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_valid_discrete_2.
iVs (own_update_2 with "[$Hγ $Hγf]") as "[Hγ Hγf]".
{ apply auth_update, (mnat_local_update _ _ (S c)); auto. }
wp_cas_suc. iVs ("Hclose" with "[Hl Hγ]") as "_".
{ iNext. iExists (S c). rewrite Nat2Z.inj_succ Z.add_1_l. by iFrame. }
iVsIntro. wp_if. iApply "HΦ"; iExists γ; repeat iSplit; eauto.
iApply (own_mono with "Hγf"). apply: auth_frag_mono.
by apply mnat_included, le_n_S.
- wp_cas_fail; first (by intros [= ?%Nat2Z.inj]).
iVs ("Hclose" with "[Hl Hγ]") as "_"; [iNext; iExists c'; by iFrame|].
iVsIntro. wp_if. iApply ("IH" with "[Hγf] HΦ").
rewrite {3}/mcounter; eauto 10.
Qed.
Lemma read_mono_spec l j (Φ : val iProp Σ) :
mcounter l j ( i, (j i)%nat mcounter l i - Φ #i)
WP read #l {{ Φ }}.
Proof.
iIntros "[Hc HΦ]". iDestruct "Hc" as (γ) "(% & #? & #Hinv & Hγf)".
rewrite /read /=. wp_let. iInv N as (c) ">[Hγ Hl]" "Hclose". wp_load.
iDestruct (own_valid_2 with "[$Hγ $Hγf]")
as %[?%mnat_included _]%auth_valid_discrete_2. as %[?%mnat_included _]%auth_valid_discrete_2.
iVs (own_update_2 with "[$Hγ $Hγf]") as "[Hγ Hγf]". iVs (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 _ _ c); auto. }
wp_cas_suc. iVs ("Hclose" with "[Hl Hγ]") as "_". iVs ("Hclose" with "[Hl Hγ]") as "_"; [iNext; iExists c; by iFrame|].
{ iNext. iExists (S c). rewrite Nat2Z.inj_succ Z.add_1_l. by iFrame. } iApply ("HΦ" with "[%]"); rewrite /mcounter; eauto 10.
iVsIntro. wp_if. iApply "HΦ"; iExists γ; repeat iSplit; eauto. Qed.
iApply (own_mono with "Hγf"). apply: auth_frag_mono. End mono_proof.
by apply mnat_included, le_n_S.
- wp_cas_fail; first (by intros [= ?%Nat2Z.inj]). (** Counter with contributions *)
iVs ("Hclose" with "[Hl Hγ]") as "_"; [iNext; iExists c'; by iFrame|]. Class ccounterG Σ :=
iVsIntro. wp_if. iApply ("IH" with "[Hγf] HΦ"). rewrite {3}/counter; eauto 10. CCounterG { ccounter_inG :> inG Σ (authR (optionUR (prodR fracR natR))) }.
Qed. Definition ccounterΣ : gFunctors :=
#[GFunctor (constRF (authR (optionUR (prodR fracR natR))))].
Lemma read_spec l j (Φ : val iProp Σ) :
counter l j ( i, (j i)%nat counter l i - Φ #i) Instance subG_ccounterΣ {Σ} : subG ccounterΣ Σ ccounterG Σ.
WP read #l {{ Φ }}. Proof. intros [?%subG_inG _]%subG_inv. split; apply _. Qed.
Proof.
iIntros "[Hc HΦ]". iDestruct "Hc" as (γ) "(% & #? & #Hinv & Hγf)". Section contrib_spec.
rewrite /read /=. wp_let. iInv N as (c) ">[Hγ Hl]" "Hclose". wp_load. Context `{!heapG Σ, !ccounterG Σ} (N : namespace).
iDestruct (own_valid_2 with "[$Hγ $Hγf]")
as %[?%mnat_included _]%auth_valid_discrete_2. Definition ccounter_inv (γ : gname) (l : loc) : iProp Σ :=
iVs (own_update_2 with "[$Hγ $Hγf]") as "[Hγ Hγf]". ( n, own γ ( Some (1%Qp, n)) l #n)%I.
{ apply auth_update, (mnat_local_update _ _ c); auto. }
iVs ("Hclose" with "[Hl Hγ]") as "_"; [iNext; iExists c; by iFrame|]. Definition ccounter_ctx (γ : gname) (l : loc) : iProp Σ :=
iApply ("HΦ" with "[%]"); rewrite /counter; eauto 10. (heapN N heap_ctx inv N (ccounter_inv γ l))%I.
Qed.
End proof. Definition ccounter (γ : gname) (q : frac) (n : nat) : iProp Σ :=
own γ ( Some (q, n)).
(** The main proofs. *)
Lemma ccounter_op γ q1 q2 n1 n2 :
ccounter γ (q1 + q2) (n1 + n2) ccounter γ q1 n1 ccounter γ q2 n2.
Proof. by rewrite /ccounter -own_op -auth_frag_op. Qed.
Lemma newcounter_contrib_spec (R : iProp Σ) Φ :
heapN N
heap_ctx ( γ l, ccounter_ctx γ l ccounter γ 1 0 - Φ #l)
WP newcounter #() {{ Φ }}.
Proof.
iIntros (?) "[#Hh HΦ]". rewrite /newcounter /=. wp_seq. wp_alloc l as "Hl".
iVs (own_alloc ( (Some (1%Qp, O%nat)) (Some (1%Qp, 0%nat))))
as (γ) "[Hγ Hγ']"; first done.
iVs (inv_alloc N _ (ccounter_inv γ l) with "[Hl Hγ]").
{ iNext. iExists 0%nat. by iFrame. }
iVsIntro. iApply "HΦ". rewrite /ccounter_ctx /ccounter; eauto 10.
Qed.
Lemma inc_contrib_spec γ l q n (Φ : val iProp Σ) :
ccounter_ctx γ l ccounter γ q n (ccounter γ q (S n) - Φ #())
WP inc #l {{ Φ }}.
Proof.
iIntros "(#(%&?&?) & Hγf & HΦ)". iLöb as "IH". wp_rec.
wp_bind (! _)%E. iInv N as (c) ">[Hγ Hl]" "Hclose".
wp_load. iVs ("Hclose" with "[Hl Hγ]") as "_"; [iNext; iExists c; by iFrame|].
iVsIntro. wp_let. wp_op.
wp_bind (CAS _ _ _). iInv N as (c') ">[Hγ Hl]" "Hclose".
destruct (decide (c' = c)) as [->|].
- iVs (own_update_2 with "[$Hγ $Hγf]") as "[Hγ Hγf]".
{ apply auth_update, option_local_update, prod_local_update_2.
apply (nat_local_update _ _ (S c) (S n)); omega. }
wp_cas_suc. iVs ("Hclose" with "[Hl Hγ]") as "_".
{ iNext. iExists (S c). rewrite Nat2Z.inj_succ Z.add_1_l. by iFrame. }
iVsIntro. wp_if. by iApply "HΦ".
- wp_cas_fail; first (by intros [= ?%Nat2Z.inj]).
iVs ("Hclose" with "[Hl Hγ]") as "_"; [iNext; iExists c'; by iFrame|].
iVsIntro. wp_if. by iApply ("IH" with "[Hγf] HΦ").
Qed.
Lemma read_contrib_spec γ l q n (Φ : val iProp Σ) :
ccounter_ctx γ l ccounter γ q n
( c, (n c)%nat ccounter γ q n - Φ #c)
WP read #l {{ Φ }}.
Proof.
iIntros "(#(%&?&?) & Hγf & HΦ)".
rewrite /read /=. wp_let. iInv N as (c) ">[Hγ Hl]" "Hclose". wp_load.
iDestruct (own_valid_2 with "[$Hγ $Hγf]")
as %[[? ?%nat_included]%Some_pair_included_total_2 _]%auth_valid_discrete_2.
iVs ("Hclose" with "[Hl Hγ]") as "_"; [iNext; iExists c; by iFrame|].
iApply ("HΦ" with "[%]"); rewrite /ccounter; eauto 10.
Qed.
Lemma read_contrib_spec_1 γ l n (Φ : val iProp Σ) :
ccounter_ctx γ l ccounter γ 1 n (ccounter γ 1 n - Φ #n)
WP read #l {{ Φ }}.
Proof.
iIntros "(#(%&?&?) & Hγf & HΦ)".
rewrite /read /=. wp_let. iInv N as (c) ">[Hγ Hl]" "Hclose". wp_load.
iDestruct (own_valid_2 with "[$Hγ $Hγf]") as %[Hn _]%auth_valid_discrete_2.
apply (Some_included_exclusive _) in Hn as [= ->]%leibniz_equiv; last done.
iVs ("Hclose" with "[Hl Hγ]") as "_"; [iNext; iExists c; by iFrame|].
by iApply "HΦ".
Qed.
End contrib_spec.
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