Commit bc89b4bd authored by Dan Frumin's avatar Dan Frumin

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

parent 4a665ad0
Pipeline #9446 failed with stage
in 6 minutes and 11 seconds
......@@ -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
......
......@@ -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").
......
......@@ -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)
......
This diff is collapsed.
......@@ -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.
......
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