Commit 1cfdc584 authored by Dan Frumin's avatar Dan Frumin

Store locations in the locking heap

- Get rid of fractions in `env_inv`.
- Separate the concerns
parent e109af04
......@@ -62,10 +62,9 @@ Section a_wp.
set_Forall (λ v, l : loc, v = #l l preσ) X.
Definition env_inv (env : val) : iProp Σ :=
( (X : gset val) (σ : gmap loc lvl),
( (X : gset val) (σ : gmap loc (lvl*val)),
is_mset env X
full_locking_heap σ
([ map] l _ σ, v', l {1/2} v')
correct_locks X (locked_locs σ))%I.
Definition awp (e : expr)
......@@ -256,7 +255,7 @@ Section a_wp_run.
iIntros ([ev <-]) "HR Hwp". rewrite /awp /a_run /=. wp_let.
wp_bind (mset_create #()). iApply mset_create_spec; first done.
iNext. iIntros (env) "Henv". wp_let.
iMod (locking_heap_init ) as (?) "Hσ".
iMod locking_heap_init as (?) "Hσ".
pose (amg := AMonadG Σ _ _ _ _).
wp_apply (newlock_cancel_spec amonadN); first done.
iIntros (k γ') "[#Hlock Hunfl]". wp_let. rewrite- wp_fupd.
......
......@@ -92,24 +92,35 @@ Section proofs.
iApply awp_atomic_env.
iIntros (env) "Henv HR".
rewrite {2}/env_inv.
iDestruct "Henv" as (X σ) "(HX & Hσ & Hls & Hlocks)".
iDestruct "Henv" as (X σ) "(HX & Hσ & Hlocks)".
iDestruct "Hlocks" as %Hlocks.
iApply wp_fupd.
wp_let. wp_alloc l as "Hl".
iAssert ⌜σ !! l = None%I with "[Hl Hls]" as %Hl.
{ remember (σ !! l) as σl. destruct σl; simplify_eq; eauto.
iAssert ⌜σ !! l = None%I with "[Hl Hσ]" as %Hl.
{ remember (σ !! l) as σl. destruct σl as [[? ?]|]; simplify_eq; eauto.
iDestruct "Hσ" as "[_ Hls]".
iExFalso. rewrite (big_sepM_lookup _ σ l _); last eauto.
iDestruct "Hls" as (v') "Hl'".
by iDestruct (mapsto_valid_2 l with "Hl Hl'") as %[]. }
iDestruct "Hl" as "[Hl Hl']".
iMod (locking_heap_alloc σ l ULvl v with "Hl' Hσ") as "[Hσ Hl']"; eauto.
by iDestruct (mapsto_valid_2 l with "Hl Hls") as %[]. }
iMod (locking_heap_alloc σ l ULvl v with "Hl Hσ") as "[Hσ Hl']"; eauto.
iModIntro. iFrame "HR". iSplitR "H Hl'".
- iExists X,(<[l:=ULvl]>σ). iFrame. iSplit.
+ rewrite big_sepM_insert; eauto. iFrame. eauto.
+ iPureIntro. by rewrite locked_locs_alloc_unlocked.
- iExists X,(<[l:=(ULvl,v)]>σ). iFrame.
iPureIntro. by rewrite locked_locs_alloc_unlocked.
- iApply ("H" with "Hl'").
Qed.
(* DF TODO: move this somewhere else? *)
Lemma big_sepM_insert_overwrite `{Countable K, EqDecision K} {A : Type}
(Φ : K A iProp Σ) (m : gmap K A) i x x' :
m !! i = Some x
([ map] ky m, Φ k y)
Φ i x (Φ i x' - ([ map] ky <[i:=x']> m, Φ k y)).
Proof.
intros ?.
rewrite {1}big_sepM_delete //. iIntros "[$ ?]".
rewrite -insert_delete big_sepM_insert ?lookup_delete //.
eauto with iFrame.
Qed.
Lemma a_store_spec R Φ Ψ1 Ψ2 e1 e2 :
AWP e1 @ R {{ Ψ1 }} -
AWP e2 @ R {{ Ψ2 }} -
......@@ -127,7 +138,7 @@ Section proofs.
iApply awp_atomic_env.
iIntros (env) "Henv HR".
rewrite {2}/env_inv.
iDestruct "Henv" as (X σ) "(HX & Hσ & Hls & Hlocks)".
iDestruct "Henv" as (X σ) "(HX & Hσ & Hlocks)".
iDestruct "Hlocks" as %Hlocks.
iDestruct (locked_locs_unlocked with "Hl Hσ") as %Hl.
assert (#l X).
......@@ -137,26 +148,30 @@ Section proofs.
wp_apply (mset_add_spec with "HX"); first done.
iIntros "HX". wp_seq.
iDestruct (full_locking_heap_unlocked with "Hl Hσ") as %?.
iMod (locking_heap_change_lock _ _ ULvl LLvl with "Hσ Hl") as "[Hσ Hl]".
do 2 wp_proj. rewrite mapsto_eq /mapsto_def.
iDestruct "Hl" as (b') "(Hb' & Hv & Hl)".
rewrite (big_sepM_lookup_acc _ _ l ULvl); last done.
iDestruct "Hls" as "[Hl' Hls]".
iDestruct "Hl'" as (?) "Hl'".
rewrite Qp_mult_1_l.
iDestruct (mapsto_agree l (1/2) (1/2) with "Hl' Hv") as %->.
iCombine "Hv Hl'" as "Hv".
do 2 wp_proj.
iDestruct "Hσ" as "[Hσ Hls]".
rewrite {1}mapsto_eq /mapsto_def.
iDestruct "Hl" as (b' Hb%lvl_included) "Hl".
assert (b' = ULvl) as -> by (destruct b'; naive_solver).
rewrite (big_sepM_insert_overwrite _ _ l _ (ULvl, w2)) ?lookup_insert //.
iDestruct "Hls" as "[Hl' Hls] /=".
wp_store.
iDestruct "Hv" as "[Hv Hl']".
iSpecialize ("Hls" with "[Hl']"); eauto.
wp_proj. iFrame "HR". iSplitR "HΦ Hl Hv".
- iExists ({[#l]} X),(<[l:=LLvl]> σ). iFrame. iSplitL.
+ rewrite -big_sepM_insert_override; eauto.
iSpecialize ("Hls" with "Hl'").
iMod (own_update_2 with "Hσ Hl") as "[Hσ Hl]".
{ apply (auth_update _ _ (to_locking_heap (<[l:=(ULvl,w2)]>σ)) {[l := (1%Qp, ULvl, agree.to_agree w2)]}).
rewrite !to_locking_heap_insert.
eapply (gmap.singleton_local_update (to_locking_heap σ)); first by apply to_locking_heap_lookup_Some.
by apply exclusive_local_update. }
iCombine "Hσ Hls" as "Hσ".
iMod (locking_heap_change_lock _ _ ULvl LLvl with "Hσ [Hl]") as "[Hσ Hl]".
{ rewrite mapsto_eq /mapsto_def. eauto. }
wp_proj. iFrame "HR". iSplitR "HΦ Hl".
- iExists ({[#l]} X),(<[l:=(LLvl,w2)]> σ). iFrame. iSplitL.
+ rewrite /full_locking_heap insert_insert //.
+ (* TODO: a separate lemma somewhere *)
iPureIntro. rewrite locked_locs_lock.
revert Hlocks. rewrite /correct_locks /set_Forall. set_solver.
- iApply "HΦ". iFrame. iExists b'; iSplit; eauto.
iPureIntro. apply lvl_included. destruct b'; eauto.
- iApply "HΦ". iFrame.
Qed.
Lemma a_load_spec_exists_frac R Φ e :
......@@ -172,7 +187,7 @@ Section proofs.
iApply awp_atomic_env.
iIntros (env) "Henv HR".
rewrite {2}/env_inv.
iDestruct "Henv" as (X σ) "(HX & Hσ & Hls & Hlocks)".
iDestruct "Henv" as (X σ) "(HX & Hσ & Hlocks)".
iDestruct "Hlocks" as %Hlocks.
iDestruct (locked_locs_unlocked with "Hl Hσ") as %Hl.
assert (#l X).
......@@ -183,13 +198,17 @@ Section proofs.
wp_apply (mset_member_spec with "HX").
iIntros "Henv /=". case_decide; first by exfalso. simpl.
wp_op. iSplit; eauto. iNext. wp_seq.
iDestruct (full_locking_heap_unlocked with "Hl Hσ") as %Hσl.
rewrite mapsto_eq /mapsto_def.
iDestruct "Hl" as (b') "(% & Hv & Hl)".
wp_load.
iCombine "Hv Hl" as "Hv". iFrame "HR".
iSplitR "HΦ Hv".
iDestruct "Hl" as (b' Hb%lvl_included) "Hl".
assert (b' = ULvl) as -> by (destruct b'; naive_solver).
iDestruct "Hσ" as "[Hσ Hls]".
rewrite (big_sepM_lookup_acc _ _ l) //. iDestruct "Hls" as "[Hl' Hls] /=".
wp_load. iSpecialize ("Hls" with "Hl'").
iFrame "HR".
iSplitR "HΦ Hl".
- iExists X,σ. by iFrame.
- iApply "HΦ". iExists b'. iSplit; eauto.
- iApply "HΦ". eauto.
Qed.
Lemma a_load_spec R Φ q e :
......@@ -241,7 +260,7 @@ Section proofs.
iIntros (env) "Henv HR".
iApply wp_fupd.
rewrite {2}/env_inv.
iDestruct "Henv" as (X σ) "(HX & Hσ & Hls & Hlocks)".
iDestruct "Henv" as (X σ) "(HX & Hσ & Hlocks)".
iDestruct "Hlocks" as %Hlocks.
wp_let. iApply (mset_clear_spec with "HX").
iNext. iIntros "HX".
......@@ -255,9 +274,8 @@ Section proofs.
- iDestruct "Hus" as "[Hu Hus]".
iDestruct (full_locking_heap_present with "Hu Hσ") as %[z Hz].
iMod (locking_heap_unlock with "Hσ Hu") as "[Hσ Hu]".
iApply ("IH" with "Hus [HΦ Hu] Hσ [Hls] HR HX").
iApply ("IH" with "Hus [HΦ Hu] Hσ HR HX").
{ iIntros "Hus". iApply "HΦ". by iFrame. }
{ rewrite -big_sepM_insert_override; eauto. }
Qed.
Lemma a_sequence_spec R Φ (f e : expr) :
......@@ -316,7 +334,7 @@ Section proofs.
Qed.
Lemma a_while_spec' R Φ (c b: expr) `{Closed [] c} `{Closed [] b} :
awp c R (λ v, (v = #true
awp c R (λ v, (v = #true
awp b R (λ _, U (awp (a_while (λ:<>, c) (λ:<>, b))%E R Φ)))
(v = #false awp (a_seq #()) R Φ)) -
awp (a_while (λ:<>, c) (λ:<>, b))%E R Φ.
......
This diff is collapsed.
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