Commit 9105d328 authored by Dan Frumin's avatar Dan Frumin

Strengthen some rules.

This commits makes some λMC rules atomic, in the sense that the user
can use the shared resources for the duration of the rule.
parent b85484c9
...@@ -267,15 +267,16 @@ Section proofs. ...@@ -267,15 +267,16 @@ Section proofs.
Qed. Qed.
Lemma cwp_free R Φ e : Lemma cwp_free R Φ e :
CWP e @ R {{ v, cl ws, v = cloc_to_val cl CWP e @ R {{ v, R ={}= cl ws, v = cloc_to_val cl
block_info cl true (length ws) cl C ws Φ #() }} - block_info cl true (length ws) cl C ws R Φ #() }} -
CWP free(e) @ R {{ Φ }}. CWP free(e) @ R {{ Φ }}.
Proof. Proof.
iIntros "H". iIntros "H".
cwp_apply (cwp_wp with "H"); iIntros (v) "H". cwp_lam. cwp_pures. cwp_apply (cwp_wp with "H"); iIntros (v) "H". cwp_lam. cwp_pures.
iApply cwp_bind. iApply (cwp_wand with "H"). clear v. iApply cwp_bind. iApply (cwp_wand with "H"). clear v.
iIntros (v). iDestruct 1 as (cl ws ->) "(Hinfo & Hcl & HΦ)". cwp_pures. iIntros (v) "H". cwp_pures.
iApply cwp_atomic_env. iIntros (env) "Henv HR". wp_pures. iApply cwp_atomic_env. iIntros (env) "Henv HR". wp_pures.
iMod ("H" with "HR") as (cl ws ->) "(Hinfo & Hcl & $ & HΦ)". cwp_pures.
rewrite cloc_to_val_eq. wp_pures. rewrite cloc_to_val_eq. wp_pures.
iDestruct "Henv" as (X σ HX) "[Hlocks Hσ]". iDestruct "Henv" as (X σ HX) "[Hlocks Hσ]".
iAssert i : nat, is_Some (ws !! i) (cl + i) locked_locs σ⌝%I as %Hlocked. iAssert i : nat, is_Some (ws !! i) (cl + i) locked_locs σ⌝%I as %Hlocked.
...@@ -302,7 +303,7 @@ Section proofs. ...@@ -302,7 +303,7 @@ Section proofs.
wp_op. iSplit; first done. iNext; wp_pures. wp_op. iSplit; first done. iNext; wp_pures.
iApply ("IH" with "[%] Hlocks HΨ"). lia. } iApply ("IH" with "[%] Hlocks HΨ"). lia. }
wp_apply ("Hcheck" with "[//]"); iIntros "Hlock". wp_pures. wp_store. wp_apply ("Hcheck" with "[//]"); iIntros "Hlock". wp_pures. wp_store.
iIntros "!> {$HΦ $HR}". iExists X, _. iIntros "!> {$HΦ}". iExists X, _.
iFrame "Hlock". iSplit; last by iApply "Hclose". iFrame "Hlock". iSplit; last by iApply "Hclose".
iPureIntro; intros w Hw. destruct (HX _ Hw) as (cl'&Hcl&Hin). iPureIntro; intros w Hw. destruct (HX _ Hw) as (cl'&Hcl&Hin).
exists cl'; split; first done. apply locked_locs_free_heap; first done. exists cl'; split; first done. apply locked_locs_free_heap; first done.
...@@ -315,8 +316,8 @@ Section proofs. ...@@ -315,8 +316,8 @@ Section proofs.
Lemma cwp_store R Φ Ψ1 Ψ2 e1 e2 : Lemma cwp_store R Φ Ψ1 Ψ2 e1 e2 :
CWP e1 @ R {{ Ψ1 }} - CWP e1 @ R {{ Ψ1 }} -
CWP e2 @ R {{ Ψ2 }} - CWP e2 @ R {{ Ψ2 }} -
( v1 v2, Ψ1 v1 - Ψ2 v2 - cl w, ( v1 v2, Ψ1 v1 - Ψ2 v2 - R ={}= cl w,
v1 = cloc_to_val cl cl C w (cl C[LLvl] v2 - Φ v2)) - v1 = cloc_to_val cl cl C w (cl C[LLvl] v2 ={}= R Φ v2)) -
CWP e1 = e2 @ R {{ Φ }}. CWP e1 = e2 @ R {{ Φ }}.
Proof. Proof.
iIntros "H1 H2 HΦ". iIntros "H1 H2 HΦ".
...@@ -325,9 +326,9 @@ Section proofs. ...@@ -325,9 +326,9 @@ Section proofs.
cwp_lam. cwp_pures. cwp_lam. cwp_pures.
iApply cwp_bind. iApply (cwp_par with "H1 H2"). iApply cwp_bind. iApply (cwp_par with "H1 H2").
iIntros "!>" (w1 w2) "H1 H2 !>". cwp_pures. iIntros "!>" (w1 w2) "H1 H2 !>". cwp_pures.
iDestruct ("HΦ" with "H1 H2") as (cl w ->) "[Hl HΦ]".
iApply cwp_atomic_env. iApply cwp_atomic_env.
iIntros (env). iDestruct 1 as (X σ HX) "[Hlocks Hσ]". iIntros "HR". iIntros (env). iDestruct 1 as (X σ HX) "[Hlocks Hσ]". iIntros "HR".
iMod ("HΦ" with "H1 H2 HR") as (cl w ->) "[Hl HΦ]".
iDestruct (full_locking_heap_unlocked with "Hl Hσ") as %Hw1. iDestruct (full_locking_heap_unlocked with "Hl Hσ") as %Hw1.
iDestruct (mapsto_offset_non_neg with "Hl") as %?. iDestruct (mapsto_offset_non_neg with "Hl") as %?.
assert ((#(cloc_base cl), #(cloc_offset cl))%V X) as HclX. assert ((#(cloc_base cl), #(cloc_offset cl))%V X) as HclX.
...@@ -341,22 +342,24 @@ Section proofs. ...@@ -341,22 +342,24 @@ Section proofs.
wp_apply (linsert_spec with "[//]"); [eauto|]. iIntros (ll' Hl'). wp_apply (linsert_spec with "[//]"); [eauto|]. iIntros (ll' Hl').
iApply wp_fupd. wp_store. iApply wp_fupd. wp_store.
iMod ("Hclose" $! _ LLvl with "[//] Hl") as "[Hσ Hl]". iMod ("Hclose" $! _ LLvl with "[//] Hl") as "[Hσ Hl]".
iIntros "!> !> {$HR}". iSplitL "Hlocks Hσ"; last by iApply "HΦ". iMod ("HΦ" with "Hl") as "HΦ".
iIntros "!> !>". iSplitL "Hlocks Hσ"; last by iApply "HΦ".
iExists ({[(#(cloc_base cl), #(cloc_offset cl))%V]} X), _. iExists ({[(#(cloc_base cl), #(cloc_offset cl))%V]} X), _.
iFrame "Hσ Hlocks". iPureIntro. rewrite locked_locs_lock. set_solver. iFrame "Hσ Hlocks". iPureIntro. rewrite locked_locs_lock. set_solver.
Qed. Qed.
Lemma cwp_load_exists_frac R Φ e : Lemma cwp_load_exists_frac R Φ e :
CWP e @ R {{ v, cl q w, v = cloc_to_val cl CWP e @ R {{ v, R ={}= cl q w, v = cloc_to_val cl
cl C{q} w (cl C{q} w - Φ w) }} - cl C{q} w (cl C{q} w ={}= R Φ w) }} -
CWP ∗ᶜe @ R {{ Φ }}. CWP ∗ᶜe @ R {{ Φ }}.
Proof. Proof.
iIntros "H". iIntros "H".
cwp_apply (cwp_wp with "H"); iIntros (v) "H". cwp_lam. cwp_pures. cwp_apply (cwp_wp with "H"); iIntros (v) "H". cwp_lam. cwp_pures.
iApply cwp_bind. iApply (cwp_wand with "H"). clear v. iApply cwp_bind. iApply (cwp_wand with "H"). clear v.
iIntros (v). iDestruct 1 as (cl q w ->) "[Hl HΦ]". cwp_pures. iIntros (v) "H". cwp_pures.
iDestruct (mapsto_offset_non_neg with "Hl") as %?.
iApply cwp_atomic_env. iIntros (env) "Henv HR". iApply cwp_atomic_env. iIntros (env) "Henv HR".
iMod ("H" with "HR") as (cl q w ->) "[Hl HΦ]".
iDestruct (mapsto_offset_non_neg with "Hl") as %?.
iDestruct "Henv" as (X σ HX) "[Hlocks Hσ]". iDestruct "Henv" as (X σ HX) "[Hlocks Hσ]".
iDestruct (full_locking_heap_unlocked with "Hl Hσ") as %Hv. iDestruct (full_locking_heap_unlocked with "Hl Hσ") as %Hv.
assert ((#(cloc_base cl), #(cloc_offset cl))%V X) as HclX. assert ((#(cloc_base cl), #(cloc_offset cl))%V X) as HclX.
...@@ -368,20 +371,22 @@ Section proofs. ...@@ -368,20 +371,22 @@ Section proofs.
wp_op. iSplit; first done. iNext; wp_seq. wp_op. iSplit; first done. iNext; wp_seq.
wp_load; wp_match. wp_load; wp_match.
iEval (rewrite -(Z2Nat.id (cloc_offset cl)) //). iEval (rewrite -(Z2Nat.id (cloc_offset cl)) //).
iApply wp_fupd.
wp_apply (llookup_spec with "[//]"); [done|]; iIntros "_". wp_apply (llookup_spec with "[//]"); [done|]; iIntros "_".
iDestruct ("Hclose" with "Hl") as "[Hσ Hl]". iDestruct ("Hclose" with "Hl") as "[Hσ Hl]".
iIntros "!> {$HR}". iSplitL "Hlocks Hσ"; last by iApply "HΦ". iMod ("HΦ" with "Hl") as "[$ $]".
iExists X, _. by iFrame. iIntros "!> !>". iExists X, _. by iFrame.
Qed. Qed.
Lemma cwp_load R Φ q e : Lemma cwp_load R Φ q e :
CWP e @ R {{ v, cl w, v = cloc_to_val cl CWP e @ R {{ v, R ={}= cl w, v = cloc_to_val cl
cl C{q} w (cl C{q} w - Φ w) }} - cl C{q} w (cl C{q} w ={}= R Φ w) }} -
CWP ∗ᶜe @ R {{ Φ }}. CWP ∗ᶜe @ R {{ Φ }}.
Proof. Proof.
iIntros "H". iApply cwp_load_exists_frac. iIntros "H". iApply cwp_load_exists_frac.
cwp_apply (cwp_wand with "H"). cwp_apply (cwp_wand with "H").
iIntros (v). iDestruct 1 as (cl w ->) "[H1 H2]"; eauto with iFrame. iIntros (v). iIntros "H HR".
iMod ("H" with "HR") as (cl w ->) "[H1 H2]". eauto 100 with iFrame.
Qed. Qed.
(** Helper lemma *) (** Helper lemma *)
...@@ -656,8 +661,8 @@ Section proofs. ...@@ -656,8 +661,8 @@ Section proofs.
iIntros (v1 v2) "Hv1 Hv2 !>". cwp_pures. iIntros (v1 v2) "Hv1 Hv2 !>". cwp_pures.
iDestruct ("HΦ" with "Hv1 Hv2") as (cl v w ->) "(Hl & % & HΦ)". iDestruct ("HΦ" with "Hv1 Hv2") as (cl v w ->) "(Hl & % & HΦ)".
iApply cwp_bind. iApply cwp_load. iApply cwp_ret. iApply wp_value. iApply cwp_bind. iApply cwp_load. iApply cwp_ret. iApply wp_value.
iExists cl, v; iFrame. iSplit; first done. iIntros "HR !>". iExists cl, v; iFrame. iSplit; first done.
iIntros "Hl". cwp_pures. iApply cwp_bind. iIntros "Hl !>". cwp_pures. iApply cwp_bind.
iApply (cwp_store _ _ iApply (cwp_store _ _
(λ v', v' = cloc_to_val cl)%I (λ v', v' = w)%I with "[] [] [-]"). (λ v', v' = cloc_to_val cl)%I (λ v', v' = w)%I with "[] [] [-]").
- cwp_proj. iApply cwp_ret; by wp_value_head. - cwp_proj. iApply cwp_ret; by wp_value_head.
...@@ -665,8 +670,8 @@ Section proofs. ...@@ -665,8 +670,8 @@ Section proofs.
try (try cwp_proj; iApply cwp_ret; by wp_value_head). try (try cwp_proj; iApply cwp_ret; by wp_value_head).
iIntros (? ? -> ->); eauto. iIntros (? ? -> ->); eauto.
- iIntros (? ? -> ->). - iIntros (? ? -> ->).
iExists _, _; iFrame. iSplit; first done. iIntros "HR !>". iExists _, _; iFrame. iSplit; first done.
iIntros "?". cwp_seq. iApply cwp_ret; iApply wp_value. by iApply "HΦ". iIntros "? !>". cwp_seq. iApply cwp_ret; iApply wp_value. by iApply "HΦ".
Qed. Qed.
End proofs. End proofs.
......
...@@ -226,8 +226,8 @@ Section forward_spec. ...@@ -226,8 +226,8 @@ Section forward_spec.
iApply (denv_stack_interp_wand with "H"); iIntros "[H1 H2]". iApply (denv_stack_interp_wand with "H"); iIntros "[H1 H2]".
iApply cwp_load. iApply (cwp_wand with "H1"); iIntros (v1) "[-> Hm]". iApply cwp_load. iApply (cwp_wand with "H1"); iIntros (v1) "[-> Hm]".
iDestruct ("H2" with "Hm") as "[Hm2 Hi]". iDestruct ("H2" with "Hm") as "[Hm2 Hi]".
iExists _, _. iFrame "Hi". iSplit; first by eauto. iIntros "$ !>". iExists _, _. iFrame "Hi". iSplit; first by eauto.
iIntros "Hi"; iSplit; first done. iIntros "Hi !>"; iSplit; first done.
iApply denv_insert_interp; eauto with iFrame. iApply denv_insert_interp; eauto with iFrame.
- (* assign *) - (* assign *)
destruct (forward_aux _ _ _ _) as [[[ms1 mNew1] dv1]|] eqn:?; simplify_eq /=. destruct (forward_aux _ _ _ _) as [[[ms1 mNew1] dv1]|] eqn:?; simplify_eq /=.
...@@ -244,8 +244,8 @@ Section forward_spec. ...@@ -244,8 +244,8 @@ Section forward_spec.
iIntros (v1 v2) "[-> Hm1] [-> Hm2]". iIntros (v1 v2) "[-> Hm1] [-> Hm2]".
iDestruct ("H" with "[Hm1 Hm2]") as "[Hm Hi]". iDestruct ("H" with "[Hm1 Hm2]") as "[Hm Hi]".
{ iApply denv_merge_interp; eauto with iFrame. } { iApply denv_merge_interp; eauto with iFrame. }
iExists _, _. iFrame "Hi". iSplit; first by eauto. iIntros "$ !>". iExists _, _. iFrame "Hi". iSplit; first by eauto.
iIntros "Hi"; iSplit; first done. iIntros "Hi !>"; iSplit; first done.
iApply denv_insert_interp; eauto 10 with iFrame. iApply denv_insert_interp; eauto 10 with iFrame.
- (* bin op *) - (* bin op *)
destruct (forward_aux _ _ ms _) as [[[ms1 mNew1] dv1]|] eqn:?; simplify_eq /=. destruct (forward_aux _ _ ms _) as [[[ms1 mNew1] dv1]|] eqn:?; simplify_eq /=.
......
...@@ -514,7 +514,7 @@ Section vcg_spec. ...@@ -514,7 +514,7 @@ Section vcg_spec.
{ iApply ("IH" with "[] [] Hm H"); eauto. } { iApply ("IH" with "[] [] Hm H"); eauto. }
iIntros (v) "H"; iDestruct "H" as (E' dv m' -> ???) "[Hm H]". iIntros (v) "H"; iDestruct "H" as (E' dv m' -> ???) "[Hm H]".
iDestruct (vcg_load_correct with "Hm H") as (cl q w ?) "[Hi H]"; eauto. iDestruct (vcg_load_correct with "Hm H") as (cl q w ?) "[Hi H]"; eauto.
iExists _, _, _; iSplit; first done. iIntros "{$Hi} Hi". iIntros "$ !>". iExists _, _, _; iSplit; first done. iIntros "{$Hi} Hi".
by iApply vcg_continuation_mono; last by iApply "H". by iApply vcg_continuation_mono; last by iApply "H".
- (* assign *) - (* assign *)
destruct (forward _ _ m _) as [[[m' mNew] dv1]|] eqn:?; last first. destruct (forward _ _ m _) as [[[m' mNew] dv1]|] eqn:?; last first.
...@@ -528,7 +528,7 @@ Section vcg_spec. ...@@ -528,7 +528,7 @@ Section vcg_spec.
eauto using denv_wf_mono, dval_wf_mono. eauto using denv_wf_mono, dval_wf_mono.
{ iApply denv_merge_interp; eauto using denv_wf_mono. { iApply denv_merge_interp; eauto using denv_wf_mono.
iFrame "Hm''". iApply (denv_interp_mono with "HmNew"); eauto. } iFrame "Hm''". iApply (denv_interp_mono with "HmNew"); eauto. }
iExists _, _; iSplit; first done. iIntros "{$Hi} Hi". iIntros "$ !>". iExists _, _; iSplit; first done. iIntros "{$Hi} Hi !>".
rewrite (dval_interp_mono E E'); eauto. rewrite (dval_interp_mono E E'); eauto.
by iApply vcg_continuation_mono; last by iApply "H". by iApply vcg_continuation_mono; last by iApply "H".
+ iDestruct (forward_correct with "Hm") as "[Hm' H1]"; eauto. + iDestruct (forward_correct with "Hm") as "[Hm' H1]"; eauto.
...@@ -540,7 +540,7 @@ Section vcg_spec. ...@@ -540,7 +540,7 @@ Section vcg_spec.
{ iApply denv_merge_interp; eauto using denv_wf_mono. { iApply denv_merge_interp; eauto using denv_wf_mono.
iFrame "Hm''". iApply (denv_interp_mono with "HmNew"); eauto. } iFrame "Hm''". iApply (denv_interp_mono with "HmNew"); eauto. }
rewrite (dval_interp_mono E E'); eauto. rewrite (dval_interp_mono E E'); eauto.
iExists _, _; iSplit; first done. iIntros "{$Hi} Hi". iIntros "$ !>". iExists _, _; iSplit; first done. iIntros "{$Hi} Hi !>".
by iApply vcg_continuation_mono; last by iApply "H". by iApply vcg_continuation_mono; last by iApply "H".
- (* bin op *) - (* bin op *)
destruct (forward _ _ m _) as [[[m' mNew] dv1]|] eqn:?; last first. destruct (forward _ _ m _) as [[[m' mNew] dv1]|] eqn:?; last first.
......
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