Commit 9e4642cf authored by Robbert Krebbers's avatar Robbert Krebbers
Browse files

Array hacking.

parent 87adc879
......@@ -61,31 +61,27 @@ Class amonadG (Σ : gFunctors) := AMonadG {
Section a_wp.
Context `{amonadG Σ}.
(* X ⊆ σ^{-1}(L) *)
Definition correct_locks (X : gset val) (preσ : gset loc) : Prop :=
set_Forall (λ v, l : loc, v = #l l preσ) X.
Definition env_inv (env : val) : iProp Σ :=
( (X : gset val) (σ : gmap loc (lvl*val)),
is_mset env X
full_locking_heap σ
correct_locks X (locked_locs σ))%I.
( (X : gset cloc) (σ : gmap cloc (lvl * val)),
X locked_locs σ
is_mset env X
full_locking_heap σ)%I.
Definition flock_resources (γ : flock_name) (I : gmap prop_id (iProp Σ * frac)) :=
([ map] i p I, flock_res γ i p.1 p.2)%I.
Definition awp (e : expr)
(R : iProp Σ) (Φ : val iProp Σ) : iProp Σ :=
tc_opaque (WP e {{ ev, (γ : flock_name) (env : val) (l : val) (I : gmap prop_id (iProp Σ * frac)),
is_flock amonadN γ l -
flock_resources γ I -
(([ map] p I, p.1) (env_inv env R)) -
WP ev env l {{ v, Φ v flock_resources γ I }}
tc_opaque (WP e {{ ev,
(γ : flock_name) (env : val) (l : val) (I : gmap prop_id (iProp Σ * frac)),
is_flock amonadN γ l -
flock_resources γ I -
([ map] p I, p.1) (env_inv env R) -
WP ev env l {{ v, Φ v flock_resources γ I }}
}})%I.
Global Instance elim_bupd_awp p e Φ :
ElimModal True p false (|==> P) P
(awp e R Φ) (awp e R Φ).
ElimModal True p false (|==> P) P (awp e R Φ) (awp e R Φ).
Proof.
iIntros (P R _) "[HP HA]".
rewrite /awp /tc_opaque /= bi.intuitionistically_if_elim.
......@@ -234,8 +230,8 @@ Section a_wp_rules.
Lemma awp_atomic_env (e : expr) (ev : val) R Φ :
IntoVal e ev
( env, env_inv env - R -
WP ev env {{ w, env_inv env R Φ w }}) -
AWP (a_atomic_env e) @ R {{ Φ }}.
WP ev env {{ w, (env_inv env R Φ w) }}) -
AWP a_atomic_env e @ R {{ Φ }}.
Proof.
iIntros (<-) "Hwp". rewrite /awp /a_atomic_env /=. wp_lam.
iIntros (γ env l I) "#Hlock Hres #Heq". do 2 wp_lam.
......@@ -255,7 +251,7 @@ Section a_wp_rules.
AWP e1 @ R {{ Ψ1 }} -
AWP e2 @ R {{ Ψ2 }} -
( w1 w2, Ψ1 w1 - Ψ2 w2 - Φ (w1,w2)%V) -
AWP (a_par e1 e2) @ R {{ Φ }}.
AWP e1 ||| e2 @ R {{ Φ }}.
Proof.
iIntros "Hwp1 Hwp2 HΦ". rewrite /a_par /awp /=.
wp_bind e1. iApply (wp_wand with "Hwp1").
......@@ -303,8 +299,8 @@ Section a_wp_run.
wp_apply (newlock_cancel_spec amonadN); first done.
iIntros (k γ') "#Hlock". rewrite- wp_fupd.
iMod (flock_res_single_alloc _ _ _ (env_inv env R)%I
with "Hlock [Henv Hσ $HR]") as (i) "[_ Hres]"; first done.
{ iNext. iExists , . iFrame. eauto. }
with "Hlock [Henv Hσ $HR]") as (i) "[_ Hres]"; first done.
{ iNext. iExists , . rewrite /locked_locs dom_empty_L. by iFrame. }
iSpecialize ("Hwp" $! amg).
iMod (wp_value_inv with "Hwp") as "Hwp".
wp_let. wp_bind (ev env k).
......
From iris.heap_lang Require Export proofmode notation.
From iris.heap_lang Require Import spin_lock assert par.
From iris.algebra Require Import frac auth.
From iris_c.lib Require Import locking_heap mset flock U.
From iris_c.lib Require Import locking_heap mset flock U list.
From iris_c.c_translation Require Import proofmode.
Notation "♯ l" := (a_ret (LitV l%Z%V)) (at level 8, format "♯ l").
Notation "♯ l" := (a_ret (Lit l%Z%V)) (at level 8, format "♯ l") : expr_scope.
Definition a_alloc : val := λ: "x",
Definition a_alloc : val := λ: "n" "x",
"v" ←ᶜ "x" ;;
a_atomic_env (λ: <>, ref "v").
a_atomic_env (λ: <>, lreplicate "n" "v").
Notation "'allocᶜ' e1" := (a_alloc e1%E) (at level 80) : expr_scope.
Definition a_store : val := λ: "x1" "x2",
"vv" ←ᶜ "x1" ||| "x2" ;;
a_atomic_env (λ: "env",
mset_add (Fst "vv") "env" ;;
Fst "vv" <- Snd "vv" ;;
Snd "vv"
let: "l" := Fst (Fst "vv") in
let: "i" := Snd (Fst "vv") in
let: "v" := Snd "vv" in
mset_add ("l", "i") "env" ;;
let: "ll" := !"l" in
"l" <- linsert "i" "v" "ll" ;;
"v"
).
Notation "e1 =ᶜ e2" := (a_store e1%E e2%E) (at level 80) : expr_scope.
Definition a_load : val := λ: "x",
"v" ←ᶜ "x";;
a_atomic_env (λ: "env",
assert: (mset_member "v" "env" = #false);;
!"v"
let: "l" := Fst "v" in
let: "i" := Snd "v" in
assert: (mset_member ("l", "i") "env" = #false);;
let: "ll" := !"l" in
llookup "i" "ll"
).
Notation "∗ᶜ e" :=
(a_load e)%E (at level 9, right associativity) : expr_scope.
......@@ -93,6 +100,7 @@ Definition a_invoke: val := λ: "f" "arg",
Section proofs.
Context `{amonadG Σ}.
(*
Lemma a_alloc_spec R Φ e :
AWP e @ R {{ v, ∀ l : loc, l ↦C v -∗ Φ #l }} -∗
AWP allocᶜ e @ R {{ Φ }}.
......@@ -119,26 +127,12 @@ Section proofs.
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 }} -
( v1 v2,
Ψ1 v1 - Ψ2 v2 - (l : loc) w,
v1 = #l l C w (l C[LLvl] v2 - Φ v2)) -
( v1 v2, Ψ1 v1 - Ψ2 v2 - w, v1 C w (v1 C[LLvl] v2 - Φ v2)) -
AWP e1 = e2 @ R {{ Φ }}.
Proof.
iIntros "H1 H2 HΦ".
......@@ -146,91 +140,51 @@ Section proofs.
awp_apply (a_wp_awp with "H2"); iIntros (v2) "H2". awp_lam.
iApply awp_bind. iApply (awp_par with "H1 H2").
iIntros "!>" (w1 w2) "H1 H2 !>". awp_lam.
iDestruct ("HΦ" with "H1 H2") as (l w ->) "[Hl HΦ]".
iDestruct ("HΦ" with "H1 H2") as (w) "[Hl HΦ]".
iApply awp_atomic_env.
iIntros (env) "Henv HR".
rewrite {2}/env_inv.
iDestruct "Henv" as (X σ) "(HX & Hσ & Hlocks)".
iDestruct "Hlocks" as %Hlocks.
iDestruct (locked_locs_unlocked with "Hl Hσ") as %Hl.
assert (#l X).
{ unfold correct_locks in *. intros Hx. apply Hl.
destruct (Hlocks _ Hx) as [l' [? Hl']]. by simplify_eq/=. }
wp_let. wp_proj.
wp_apply (mset_add_spec with "HX"); first done.
iIntros "HX". wp_seq.
iDestruct (full_locking_heap_unlocked with "Hl Hσ") as %?.
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.
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.
- by iApply "HΦ".
iIntros (env). iDestruct 1 as (X σ HX) "[Hlocks Hσ]". iIntros "HR".
iDestruct (locked_locs_unlocked with "Hl Hσ") as %Hw1.
iMod (locking_heap_store with "Hσ Hl") as (l i ll vs -> Hl Hi) "[Hl Hclose]".
wp_let. do 2 wp_proj; wp_let. do 2 wp_proj; wp_let. wp_proj; wp_let.
wp_apply (mset_add_spec with "[$]"); [set_solver|]; iIntros "Hlocks /="; wp_seq.
wp_load; wp_let.
wp_apply (linsert_spec with "[//]"); [eauto|]; iIntros (ll' Hl').
iApply wp_fupd. wp_store.
iMod ("Hclose" $! _ LLvl with "[//] Hl") as "[Hσ Hl]".
iIntros "!> !> {$HR}". iSplitL "Hlocks Hσ"; last by iApply "HΦ".
iExists ({[(#l, #i)%V]} X), _. iFrame "Hσ". rewrite locked_locs_lock.
iIntros "{$Hlocks} !%". set_solver.
Qed.
Lemma a_load_spec_exists_frac R Φ e :
AWP e @ R {{ v, (l : loc) (q : Qp) (w : val), v = #l l C{q} w (l C{q} w - Φ w) }} -
AWP e @ R {{ v, q w, v C{q} w (v C{q} w - Φ w) }} -
AWP ∗ᶜe @ R {{ Φ }}.
Proof.
iIntros "H".
awp_apply (a_wp_awp with "H"); iIntros (v) "H". awp_lam.
iApply awp_bind.
iApply (awp_wand with "H"). clear v.
iIntros (v). iDestruct 1 as (l q w) "(% & Hl & HΦ)". subst.
awp_lam.
iApply awp_atomic_env.
iIntros (env) "Henv HR".
rewrite {2}/env_inv.
iDestruct "Henv" as (X σ) "(HX & Hσ & Hlocks)".
iDestruct "Hlocks" as %Hlocks.
iDestruct (locked_locs_unlocked with "Hl Hσ") as %Hl.
assert (#l X).
{ unfold correct_locks in *. intros Hx. apply Hl.
destruct (Hlocks _ Hx) as [l' [? Hl']]. by simplify_eq/=. }
wp_lam. wp_apply wp_assert.
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' 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Φ". eauto.
iApply awp_bind. iApply (awp_wand with "H"). clear v.
iIntros (v). iDestruct 1 as (q w) "[Hl HΦ]". awp_lam.
iApply awp_atomic_env. iIntros (env) "Henv HR".
iDestruct "Henv" as (X σ HX) "[Hlocks Hσ]".
iDestruct (locked_locs_unlocked with "Hl Hσ") as %Hv.
iMod (locking_heap_load with "Hσ Hl") as (l i ll vs -> Hl Hi) "[Hl Hclose]".
wp_let. wp_proj; wp_let. wp_proj; wp_let.
wp_apply wp_assert. wp_apply (mset_member_spec with "Hlocks"); iIntros "Hlocks /=".
rewrite bool_decide_false; last set_solver.
wp_op. iSplit; first done. iNext; wp_seq.
wp_load; wp_let. wp_apply (llookup_spec with "[//]"); [done|]; iIntros "_".
iDestruct ("Hclose" with "Hl") as "[Hσ Hl]".
iIntros "!> {$HR}". iSplitL "Hlocks Hσ"; last by iApply "HΦ".
iExists X, _. by iFrame.
Qed.
Lemma a_load_spec R Φ q e :
AWP e @ R {{ v, (l : loc) (w : val), v = #l l C{q} w (l C{q} w - Φ w) }} -
AWP e @ R {{ v, w, v C{q} w (v C{q} w - Φ w) }} -
AWP ∗ᶜe @ R {{ Φ }}.
Proof.
iIntros "H".
iApply a_load_spec_exists_frac.
iIntros "H". iApply a_load_spec_exists_frac.
awp_apply (awp_wand with "H").
iIntros (v) "H". iDestruct "H" as (l w ->) "[H1 H2]".
eauto with iFrame.
iIntros (v). iDestruct 1 as (w) "[H1 H2]"; eauto with iFrame.
Qed.
Lemma a_un_op_spec R Φ e op:
......@@ -293,33 +247,30 @@ Section proofs.
Lemma a_pre_bin_op_spec R Φ Ψ1 Ψ2 e1 e2 op :
AWP e1 @ R {{ Ψ1 }} - AWP e2 @ R {{ Ψ2 }} -
( v1 v2, Ψ1 v1 - Ψ2 v2 - R -
l v w, l C v v1 = #l
bin_op_eval op v v2 = Some w
(l C[LLvl] w - R Φ v)) -
v w, v1 C v
bin_op_eval op v v2 = Some w
(v1 C[LLvl] w - R Φ v)) -
AWP a_pre_bin_op op e1 e2 @ R {{ Φ }}.
Proof.
iIntros "He1 He2 HΦ". rewrite /a_pre_bin_op.
awp_apply (a_wp_awp with "He1"); iIntros (a1) "Ha1". awp_lam.
awp_apply (a_wp_awp with "He2"); iIntros (a2) "Ha2". awp_lam.
iApply awp_bind. iApply (awp_par with "Ha1 Ha2"). iNext.
iIntros (v1 v2) "Hv1 Hv2". iNext. awp_let.
iIntros (v1 v2) "Hv1 Hv2 !>". awp_let.
iApply awp_atomic. iNext.
iIntros "R". iDestruct ("HΦ" with "Hv1 Hv2 R") as (l v w) "(Hl & % & % & HΦ)".
iIntros "R". iDestruct ("HΦ" with "Hv1 Hv2 R") as (v w) "(Hl & % & HΦ)".
simplify_eq/=. iExists True%I. rewrite left_id. awp_lam.
iApply awp_bind. awp_proj. iApply a_load_spec. iApply awp_ret. wp_value_head.
iExists l, v; iFrame. iSplit; eauto.
iExists v; iFrame.
iIntros "Hl". awp_let. iApply awp_bind.
iApply (a_store_spec _ _ (λ v', v' = #l)%I
(λ v', v' = w)%I
with "[] [] [-]").
iApply (a_store_spec _ _
(λ v', v' = v1)%I (λ v', v' = w)%I with "[] [] [-]").
- awp_proj. iApply awp_ret; by wp_value_head.
- iApply (a_bin_op_spec _ _ (λ v', v' = v)%I
(λ v', v' = v2)%I);
- iApply (a_bin_op_spec _ _ (λ v', v' = v)%I (λ v', v' = v2)%I);
try (try awp_proj; iApply awp_ret; by wp_value_head).
iNext. iIntros (? ? -> ->). eauto.
- iNext. iIntros (? ? -> ->).
iExists _,_; iFrame. iSplit; eauto.
iIntros "?". awp_seq. iApply awp_ret; wp_value_head.
iExists _; iFrame. iIntros "?". awp_seq. iApply awp_ret; wp_value_head.
iIntros "_". by iApply "HΦ".
Qed.
......@@ -328,26 +279,19 @@ Section proofs.
AWP (a_seq #()) @ R {{ Φ }}.
Proof.
iIntros "HΦ". rewrite /a_seq. awp_lam.
iApply awp_atomic_env.
iIntros (env) "Henv HR".
iApply wp_fupd.
rewrite {2}/env_inv.
iDestruct "Henv" as (X σ) "(HX & Hσ & Hlocks)".
iDestruct "Hlocks" as %Hlocks.
wp_lam. iApply (mset_clear_spec with "HX").
iNext. iIntros "HX".
iApply awp_atomic_env. iIntros (env) "Henv $". iApply wp_fupd.
iDestruct "Henv" as (X σ _) "[Hlocks Hσ]".
wp_lam. wp_apply (mset_clear_spec with "Hlocks"); iIntros "Hlocks".
iDestruct "HΦ" as (us) "[Hus HΦ]".
clear Hlocks.
iInduction us as [|[ul [uq uv]] us] "IH" forall (σ); simpl.
- iModIntro. iFrame "HR". iSplitR "HΦ".
+ iExists , σ. iFrame. iPureIntro.
rewrite /correct_locks /set_Forall. set_solver.
- iModIntro. iSplitR "HΦ".
+ iExists , σ. by iFrame.
+ by iApply "HΦ".
- 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σ HR HX").
{ iIntros "Hus". iApply "HΦ". by iFrame. }
iApply ("IH" with "Hus [HΦ Hu] Hσ Hlocks").
iIntros "Hus". iApply "HΦ". by iFrame.
Qed.
Lemma a_sequence_spec R Φ (f e : expr) :
......
......@@ -8,7 +8,7 @@ Section U.
(** * Unlocking modality *)
Definition U (P : iProp Σ) : iProp Σ :=
( ls : list (loc * (frac * val)),
( ls : list (cloc * (frac * val)),
([ list] x ls, x.1 C[LLvl]{x.2.1} x.2.2)
(([ list] x ls, x.1 C{x.2.1} x.2.2) - P))%I.
......
......@@ -70,7 +70,7 @@ Lemma ltail_spec hd vs v :
{{{ is_list hd (v :: vs) }}} ltail hd {{{ hd', RET hd'; is_list hd' vs }}}.
Proof. iIntros (Φ (hd'&->&?)) "HΦ". repeat wp_pure _. by iApply "HΦ". Qed.
Lemma llookup_spec_spec i hd vs v :
Lemma llookup_spec i hd vs v :
vs !! i = Some v
{{{ is_list hd vs }}} llookup #i hd {{{ RET v; True }}}.
Proof.
......@@ -82,7 +82,7 @@ Proof.
wp_op. rewrite Nat2Z.inj_succ -Z.add_1_l Z.add_simpl_l. by iApply "IH".
Qed.
Lemma linsert_spec_spec i hd vs v :
Lemma linsert_spec i hd vs v :
is_Some (vs !! i)
{{{ is_list hd vs }}} linsert #i v hd {{{ hd', RET hd'; is_list hd' (<[i:=v]> vs) }}}.
Proof.
......
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