Commit bb4669b4 authored by Dan Frumin's avatar Dan Frumin
Browse files

Refinement proof with HOCAP specs.

parent 48090e44
......@@ -104,19 +104,6 @@ Section cnt_spec.
Qed.
(** We are going to make use of an alternative invariant opening rule: *)
Lemma inv_open_cow (E E' : coPset) M P :
M E M E'
inv M P ={E,E∖↑M}= P ( P ={E'∖↑M,E'}= True).
Proof.
iIntros (? ?) "#Hinv".
iMod (inv_acc_strong E M with "Hinv") as "[HP Hcl]"; first done.
iFrame. iIntros "!> HP".
iMod ("Hcl" $! E' M with "HP") as "_".
rewrite -union_difference_L; eauto.
Qed.
(** This specification for the increment function allows us to
1) derive the "standard" lifting of unary HOCAP specification
(by picking E = ∅)
......@@ -155,4 +142,117 @@ Section cnt_spec.
rewrite -union_difference_L; last set_solver.
done.
Qed.
Lemma cnt_read_l E c γ K e A :
E ## N
Cnt c γ -
( n : nat, cnt_auth γ n ={∖↑N, ∖↑NE}=
cnt_auth γ n REL fill K (of_val #n) << e @ (E): A) -
REL fill K (counter_read c) << e : A.
Proof.
iIntros (?).
iDestruct 1 as (l ->) "#Hcnt". iIntros "Hvs".
rel_rec_l. rel_load_l_atomic.
iMod (inv_acc_strong with "Hcnt") as "[>H Hcl]"; first by solve_ndisj.
iDestruct "H" as (n) "[Hl Ha]". iModIntro.
iExists #n. iFrame "Hl"; iIntros "!> Hl".
iMod ("Hvs" with "Ha") as "[Ha Href]".
iMod ("Hcl" with "[Hl Ha]") as "_".
{ iNext. iExists _; by iFrame. }
assert ( N E = E N) as -> by set_solver.
rewrite -union_difference_L; last set_solver.
done.
Qed.
End cnt_spec.
Section refinement.
Context `{!cnt_hocapG Σ, !relocG Σ}.
(** We are going to make use of an alternative invariant opening rule: *)
Lemma inv_open_cow (E E' : coPset) M P :
M E M E'
inv M P ={E,E∖↑M}= P ( P ={E'∖↑M,E'}= True).
Proof.
iIntros (? ?) "#Hinv".
iMod (inv_acc_strong E M with "Hinv") as "[HP Hcl]"; first done.
iFrame. iIntros "!> HP".
iMod ("Hcl" $! E' M with "HP") as "_".
rewrite -union_difference_L; eauto.
Qed.
Definition N:=nroot.@"cnt".
Definition N2:=nroot.@"cntr".
Lemma incr_refinement c γ lk l :
Cnt N c γ -
inv N2 ( m, lock.is_locked_r lk false cnt γ 1 m l ↦ₛ #m)%I -
REL FG_increment c << CG_increment #l lk : interp TNat [].
Proof.
iIntros "#HCnt #HI".
rel_apply_l (cnt_increment_l _ (N2) with "HCnt"); first by solve_ndisj.
iIntros (n) "Ha".
iMod (inv_open_cow _ with "HI") as "[H Hcl]"; try solve_ndisj.
iDestruct "H" as (m) ">(Hlk & Hc & Hl)".
iDestruct (cnt_agree_2 with "Ha Hc") as %<-.
iMod (cnt_update (n+1) with "Ha Hc") as "[Ha Hc]".
iModIntro. iFrame "Ha".
rel_apply_r (CG_increment_r with "Hl Hlk").
iIntros "Hl Hlk".
iMod ("Hcl" with "[-]") as "_".
{ iNext. iExists (n+1); try iFrame.
assert (Z.of_nat (n + 1)%nat = Z.of_nat n + 1)%Z as -> by lia.
done. }
rel_values.
Qed.
Lemma read_refinement c γ lk l :
Cnt N c γ -
inv N2 ( m, lock.is_locked_r lk false cnt γ 1 m l ↦ₛ #m)%I -
REL counter_read c << counter_read #l : interp TNat [].
Proof.
iIntros "#HCnt #HI".
rel_apply_l (cnt_read_l _ (N2) with "HCnt"); first by solve_ndisj.
iIntros (n) "Ha".
iMod (inv_open_cow _ with "HI") as "[H Hcl]"; try solve_ndisj.
iDestruct "H" as (m) ">(Hlk & Hc & Hl)".
iDestruct (cnt_agree_2 with "Ha Hc") as %<-.
iModIntro. iFrame "Ha".
rel_apply_r (counter_read_r with "Hl"). iIntros "Hl".
iMod ("Hcl" with "[-]") as "_".
{ iNext. iExists _; iFrame. }
rel_values.
Qed.
Lemma FG_CG_counter_refinement :
REL FG_counter << CG_counter : () (() lrel_int) * (() lrel_int).
Proof.
unfold FG_counter, CG_counter.
iApply refines_arrow_val.
iAlways. iIntros (? ?) "_"; simplify_eq/=.
rel_rec_l. rel_rec_r.
rel_apply_r lock.refines_newlock_r; auto.
iIntros (lk) "Hlk".
repeat rel_pure_r.
rel_alloc_r c' as "Hcnt'".
rel_alloc_l c as "Hcnt". simpl.
iMod (Cnt_alloc N _ 0%nat with "Hcnt") as (γ) "[#HCnt Hc]".
(* establishing the invariant *)
iMod (inv_alloc N2 _ ( m, lock.is_locked_r lk false cnt γ 1 m c' ↦ₛ #m)%I
with "[-]") as "#Hinv".
{ iNext. iExists 0%nat. by iFrame. }
(* TODO: here we have to do /exactly/ 4 steps.
The next step will reduce `(Val v1, Val v2)` to `Val (v1, v2)`,
and the compatibility rule wouldn't be applicable *)
do 4 rel_pure_r. do 4 rel_pure_l.
iApply refines_pair .
- iApply refines_arrow_val.
iAlways. iIntros (? ?) "_". rel_seq_l; rel_seq_r.
iApply (incr_refinement with "HCnt Hinv").
- iApply refines_arrow_val.
iAlways. iIntros (? ?) "_". rel_seq_l; rel_seq_r.
iApply (read_refinement with "HCnt Hinv").
Qed.
End refinement.
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