Ticket lock refinement (almost) from the HOCAP-like counter specs

_CoqProject

@@ -45,6 +45,7 @@ theories/examples/generative.v
 theories/examples/Y.v
 theories/examples/FAI.v
 theories/examples/hospec/modular_counter.v
+theories/examples/hospec/ticket_lock_refinement.v
 theories/tests/typetest.v
 theories/tests/ghosttp.v
 theories/tests/tactics.v

theories/examples/counter.v

@@ -22,6 +22,9 @@ Definition FG_increment : val := rec: "inc" "v" :=
   then "c"
   else "inc" "v".
 
+Definition wkincr : val := λ: "l",
+  "l" <- !"l" + #1.
+
 Definition FG_counter : val := λ: <>,
   let: "x" := ref #0 in
   ((λ: <>, FG_increment "x"), counter_read "x").

theories/examples/hospec/modular_counter.v

@@ -2,7 +2,7 @@ From iris.proofmode Require Import tactics.
 From iris.algebra Require Import frac agree.
 From iris.base_logic.lib Require Import invariants viewshifts.
 From iris_logrel Require Export logrel.
-From iris_logrel.examples Require Import counter.
+From iris_logrel.examples Require Export counter.
 
 Definition cntCmra : cmraT := (prodR fracR (agreeR natC)).
 
@@ -196,6 +196,60 @@ Section cnt_spec.
     by iApply bin_log_related_nat.
   Qed.
 
+  Theorem read_l (γ : gname) (E : coPset) (ℓ : loc) Δ Γ K t τ:
+    ↑(N .@ "internal") ## E →
+    Cnt ℓ γ -∗
+    (∀ (n : nat),
+       γ ⤇½ n ={⊤∖ ↑(N .@ "internal"), ⊤∖↑(N .@ "internal")∖E}=∗
+       γ ⤇½ n ∗ {⊤∖E;Δ;Γ} ⊨ fill K #n ≤log≤ t : τ) -∗
+    {Δ;Γ} ⊨ fill K (! #ℓ) ≤log≤ t : τ.
+  Proof.
+    iIntros (?) "#Hcnt Hupd".
+    rel_load_l_atomic.
+    iMod (inv_open_strong with "Hcnt") as "[HH Hcl]"; first done.
+    iDestruct "HH" as (m') "[>Hl >Hown]".
+    iModIntro. iExists _; iFrame. iNext. iIntros "Hl".
+    iMod ("Hupd" with "Hown") as "[Hown Hlog]".
+    iMod ("Hcl" with "[Hl Hown]") as "_".
+    { iNext. iExists _. iFrame. }
+    assert (⊤ ∖ ↑N.@"internal" ∖ E
+            = ((⊤ ∖ E) ∖ ↑N.@"internal" : coPset)) as -> by set_solver.
+    rewrite -union_difference_L; last set_solver.
+    by iApply "Hlog".
+  Qed.
+
+  Theorem wkincr_l (γ : gname) (E : coPset) (ℓ : loc) (n : nat) (q : Qp) Δ Γ K t τ:
+    ↑(N .@"internal") ## E →
+    Cnt ℓ γ -∗
+    γ ⤇[q] n -∗
+    (γ ⤇½ n ∗ γ ⤇[q] n ={⊤∖ ↑(N .@ "internal"), ⊤∖↑(N .@ "internal")∖E}=∗ γ ⤇½ (n+1) ∗ γ ⤇[q] (n+1)) -∗
+    (γ ⤇[q] (n+1) -∗ {⊤∖E;Δ;Γ} ⊨ fill K #() ≤log≤ t : τ) -∗
+    {Δ;Γ} ⊨ fill K (wkincr #ℓ) ≤log≤ t : τ.
+  Proof.
+    iIntros (?) "#Hcnt Hγ Hupd H".
+    unlock wkincr. rel_rec_l.
+    rel_load_l_atomic.
+    iInv (N  .@ "internal") as (n') "[>Hl >Hown]" "Hcl".
+    iDestruct (makeElem_eq with "Hγ Hown") as %<-.
+    iModIntro. iExists _; iFrame. iNext. iIntros "Hl".
+    iMod ("Hcl" with "[Hl Hown]") as "_".
+    { iNext. iExists _. iFrame. }
+    rel_op_l.
+    rel_store_l_atomic.
+    iMod (inv_open_strong with "Hcnt") as "[HH Hcl]"; first solve_ndisj.
+    iDestruct "HH" as (m) "[>Hl >Hown]".
+    iDestruct (makeElem_eq with "Hγ Hown") as %<-.
+    iModIntro. iExists _; iFrame.
+    iNext. iIntros "Hl".
+    iMod ("Hupd" with "[$Hown $Hγ]") as "[Hown Hγ]".
+    assert (⊤ ∖ ↑N.@"internal" ∖ E
+            = ((⊤ ∖ E) ∖ ↑N.@"internal" : coPset)) as -> by set_solver.
+    iMod ("Hcl" with "[Hl Hown]") as "_".
+    { iNext. iExists _. iFrame. }
+    rewrite -union_difference_L; last set_solver.
+    by iApply "H".
+  Qed.
+
   (** Proving the refinement with the WP rule doesn't really work out that well: *)
   Theorem incr_spec (γ : gname) (P : iProp Σ) (Q : nat → iProp Σ) (ℓ : loc):
     □(∀ (n : nat), γ ⤇½ n ∗ P  ={⊤ ∖ ↑(N .@ "internal")}=∗ γ ⤇½ (n+1) ∗ Q n) ⊢

theories/examples/ticket_lock.v

@@ -16,8 +16,6 @@ Definition acquire : val := λ: "lk",
   let: "n" := FG_increment (Snd "lk") in
   wait_loop "n" "lk".
 
-Definition wkincr : val := λ: "l",
-  "l" <- !"l" + #1.
 Definition release : val := λ: "lk", wkincr (Fst "lk").
 
 Definition LockType : type := ref TNat × ref TNat.