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

Array hacking.

parent 87adc879
...@@ -61,31 +61,27 @@ Class amonadG (Σ : gFunctors) := AMonadG { ...@@ -61,31 +61,27 @@ Class amonadG (Σ : gFunctors) := AMonadG {
Section a_wp. Section a_wp.
Context `{amonadG Σ}. 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 Σ := Definition env_inv (env : val) : iProp Σ :=
( (X : gset val) (σ : gmap loc (lvl*val)), ( (X : gset cloc) (σ : gmap cloc (lvl * val)),
is_mset env X X locked_locs σ
full_locking_heap σ is_mset env X
correct_locks X (locked_locs σ))%I. full_locking_heap σ)%I.
Definition flock_resources (γ : flock_name) (I : gmap prop_id (iProp Σ * frac)) := Definition flock_resources (γ : flock_name) (I : gmap prop_id (iProp Σ * frac)) :=
([ map] i p I, flock_res γ i p.1 p.2)%I. ([ map] i p I, flock_res γ i p.1 p.2)%I.
Definition awp (e : expr) Definition awp (e : expr)
(R : iProp Σ) (Φ : val iProp Σ) : iProp Σ := (R : iProp Σ) (Φ : val iProp Σ) : iProp Σ :=
tc_opaque (WP e {{ ev, (γ : flock_name) (env : val) (l : val) (I : gmap prop_id (iProp Σ * frac)), tc_opaque (WP e {{ ev,
is_flock amonadN γ l - (γ : flock_name) (env : val) (l : val) (I : gmap prop_id (iProp Σ * frac)),
flock_resources γ I - is_flock amonadN γ l -
(([ map] p I, p.1) (env_inv env R)) - flock_resources γ I -
WP ev env l {{ v, Φ v flock_resources γ I }} ([ map] p I, p.1) (env_inv env R) -
WP ev env l {{ v, Φ v flock_resources γ I }}
}})%I. }})%I.
Global Instance elim_bupd_awp p e Φ : Global Instance elim_bupd_awp p e Φ :
ElimModal True p false (|==> P) P ElimModal True p false (|==> P) P (awp e R Φ) (awp e R Φ).
(awp e R Φ) (awp e R Φ).
Proof. Proof.
iIntros (P R _) "[HP HA]". iIntros (P R _) "[HP HA]".
rewrite /awp /tc_opaque /= bi.intuitionistically_if_elim. rewrite /awp /tc_opaque /= bi.intuitionistically_if_elim.
...@@ -234,8 +230,8 @@ Section a_wp_rules. ...@@ -234,8 +230,8 @@ Section a_wp_rules.
Lemma awp_atomic_env (e : expr) (ev : val) R Φ : Lemma awp_atomic_env (e : expr) (ev : val) R Φ :
IntoVal e ev IntoVal e ev
( env, env_inv env - R - ( env, env_inv env - R -
WP ev env {{ w, env_inv env R Φ w }}) - WP ev env {{ w, (env_inv env R Φ w) }}) -
AWP (a_atomic_env e) @ R {{ Φ }}. AWP a_atomic_env e @ R {{ Φ }}.
Proof. Proof.
iIntros (<-) "Hwp". rewrite /awp /a_atomic_env /=. wp_lam. iIntros (<-) "Hwp". rewrite /awp /a_atomic_env /=. wp_lam.
iIntros (γ env l I) "#Hlock Hres #Heq". do 2 wp_lam. iIntros (γ env l I) "#Hlock Hres #Heq". do 2 wp_lam.
...@@ -255,7 +251,7 @@ Section a_wp_rules. ...@@ -255,7 +251,7 @@ Section a_wp_rules.
AWP e1 @ R {{ Ψ1 }} - AWP e1 @ R {{ Ψ1 }} -
AWP e2 @ R {{ Ψ2 }} - AWP e2 @ R {{ Ψ2 }} -
( w1 w2, Ψ1 w1 - Ψ2 w2 - Φ (w1,w2)%V) - ( w1 w2, Ψ1 w1 - Ψ2 w2 - Φ (w1,w2)%V) -
AWP (a_par e1 e2) @ R {{ Φ }}. AWP e1 ||| e2 @ R {{ Φ }}.
Proof. Proof.
iIntros "Hwp1 Hwp2 HΦ". rewrite /a_par /awp /=. iIntros "Hwp1 Hwp2 HΦ". rewrite /a_par /awp /=.
wp_bind e1. iApply (wp_wand with "Hwp1"). wp_bind e1. iApply (wp_wand with "Hwp1").
...@@ -303,8 +299,8 @@ Section a_wp_run. ...@@ -303,8 +299,8 @@ Section a_wp_run.
wp_apply (newlock_cancel_spec amonadN); first done. wp_apply (newlock_cancel_spec amonadN); first done.
iIntros (k γ') "#Hlock". rewrite- wp_fupd. iIntros (k γ') "#Hlock". rewrite- wp_fupd.
iMod (flock_res_single_alloc _ _ _ (env_inv env R)%I iMod (flock_res_single_alloc _ _ _ (env_inv env R)%I
with "Hlock [Henv Hσ $HR]") as (i) "[_ Hres]"; first done. with "Hlock [Henv Hσ $HR]") as (i) "[_ Hres]"; first done.
{ iNext. iExists , . iFrame. eauto. } { iNext. iExists , . rewrite /locked_locs dom_empty_L. by iFrame. }
iSpecialize ("Hwp" $! amg). iSpecialize ("Hwp" $! amg).
iMod (wp_value_inv with "Hwp") as "Hwp". iMod (wp_value_inv with "Hwp") as "Hwp".
wp_let. wp_bind (ev env k). wp_let. wp_bind (ev env k).
......
This diff is collapsed.
...@@ -8,7 +8,7 @@ Section U. ...@@ -8,7 +8,7 @@ Section U.
(** * Unlocking modality *) (** * Unlocking modality *)
Definition U (P : iProp Σ) : iProp Σ := 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[LLvl]{x.2.1} x.2.2)
(([ list] x ls, x.1 C{x.2.1} x.2.2) - P))%I. (([ list] x ls, x.1 C{x.2.1} x.2.2) - P))%I.
......
...@@ -70,7 +70,7 @@ Lemma ltail_spec hd vs v : ...@@ -70,7 +70,7 @@ Lemma ltail_spec hd vs v :
{{{ is_list hd (v :: vs) }}} ltail hd {{{ hd', RET hd'; is_list hd' vs }}}. {{{ 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. 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 vs !! i = Some v
{{{ is_list hd vs }}} llookup #i hd {{{ RET v; True }}}. {{{ is_list hd vs }}} llookup #i hd {{{ RET v; True }}}.
Proof. Proof.
...@@ -82,7 +82,7 @@ Proof. ...@@ -82,7 +82,7 @@ Proof.
wp_op. rewrite Nat2Z.inj_succ -Z.add_1_l Z.add_simpl_l. by iApply "IH". wp_op. rewrite Nat2Z.inj_succ -Z.add_1_l Z.add_simpl_l. by iApply "IH".
Qed. Qed.
Lemma linsert_spec_spec i hd vs v : Lemma linsert_spec i hd vs v :
is_Some (vs !! i) is_Some (vs !! i)
{{{ is_list hd vs }}} linsert #i v hd {{{ hd', RET hd'; is_list hd' (<[i:=v]> vs) }}}. {{{ is_list hd vs }}} linsert #i v hd {{{ hd', RET hd'; is_list hd' (<[i:=v]> vs) }}}.
Proof. 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