Commit df4574f2 authored by Robbert Krebbers's avatar Robbert Krebbers

Iris Proofmode.

parent 631c8260
......@@ -79,7 +79,6 @@ program_logic/saved_one_shot.v
program_logic/auth.v
program_logic/sts.v
program_logic/namespaces.v
program_logic/tactics.v
heap_lang/lang.v
heap_lang/tactics.v
heap_lang/wp_tactics.v
......@@ -96,7 +95,20 @@ heap_lang/lib/barrier/specification.v
heap_lang/lib/barrier/protocol.v
heap_lang/lib/barrier/proof.v
heap_lang/lib/barrier/client.v
heap_lang/proofmode.v
tests/heap_lang.v
tests/program_logic.v
tests/one_shot.v
tests/joining_existentials.v
tests/proofmode.v
proofmode/coq_tactics.v
proofmode/pviewshifts.v
proofmode/environments.v
proofmode/intro_patterns.v
proofmode/spec_patterns.v
proofmode/tactics.v
proofmode/notation.v
proofmode/invariants.v
proofmode/weakestpre.v
proofmode/ghost_ownership.v
proofmode/sts.v
......@@ -974,19 +974,6 @@ Lemma later_wand P Q : ▷ (P -★ Q) ⊢ (▷ P -★ ▷ Q).
Proof. apply wand_intro_r;rewrite -later_sep; apply later_mono,wand_elim_l. Qed.
Lemma later_iff P Q : (P Q) ( P Q).
Proof. by rewrite /uPred_iff later_and !later_impl. Qed.
Lemma löb_strong P Q : (P Q) Q P Q.
Proof.
intros Hlöb. apply impl_entails. rewrite -(löb (P Q)).
apply entails_impl, impl_intro_l. rewrite -{2}Hlöb.
apply and_intro; first by eauto.
by rewrite {1}(later_intro P) later_impl impl_elim_r.
Qed.
Lemma löb_strong_sep P Q : (P (P - Q)) Q P Q.
Proof.
move/wand_intro_l=>Hlöb. apply impl_entails.
rewrite -[(_ _)%I]always_elim. apply löb_strong.
by rewrite left_id -always_wand_impl -always_later Hlöb.
Qed.
(* Own *)
Lemma ownM_op (a1 a2 : M) :
......
......@@ -248,50 +248,3 @@ Ltac strip_later :=
intros_revert ltac:(
etrans; [apply: strip_later_r|];
etrans; [|apply: strip_later_l]; apply later_mono).
(** Transforms a goal of the form ∀ ..., ?0... → ?1 ⊢ ?2
into True ⊢ ∀..., ■?0... → ?1 → ?2, applies tac, and
the moves all the assumptions back. *)
(* TODO: this name may be a big too general *)
Ltac revert_all :=
lazymatch goal with
| |- _, _ =>
let H := fresh in intro H; revert_all;
(* TODO: Really, we should distinguish based on whether this is a
dependent function type or not. Right now, we distinguish based
on the sort of the argument, which is suboptimal. *)
first [ apply (const_intro_impl _ _ _ H); clear H
| revert H; apply forall_elim']
| |- _ _ => apply impl_entails
end.
(** This starts on a goal of the form ∀ ..., ?0... → ?1 ⊢ ?2.
It applies löb where all the Coq assumptions have been turned into logical
assumptions, then moves all the Coq assumptions back out to the context,
applies [tac] on the goal (now of the form _ ⊢ _), and then reverts the
Coq assumption so that we end up with the same shape as where we started,
but with an additional assumption ★-ed to the context *)
Ltac löb tac :=
revert_all;
(* Add a box *)
etrans; last (eapply always_elim; reflexivity);
(* We now have a goal for the form True ⊢ P, with the "original" conclusion
being locked. *)
apply löb_strong; etransitivity;
first (apply equiv_entails, left_id, _; reflexivity);
apply: always_intro;
(* Now introduce again all the things that we reverted, and at the bottom,
do the work *)
let rec go :=
lazymatch goal with
| |- _ ( _, _) =>
apply forall_intro; let H := fresh in intro H; go; revert H
| |- _ ( _ _) =>
apply impl_intro_l, const_elim_l; let H := fresh in intro H; go; revert H
(* This is the "bottom" of the goal, where we see the impl introduced
by uPred_revert_all as well as the ▷ from löb_strong and the □ we added. *)
| |- ?R (?L _) => apply impl_intro_l;
trans (L R)%I;
[eapply equiv_entails, always_and_sep_r, _; reflexivity | tac]
end
in go.
From iris.heap_lang.lib.barrier Require Import proof.
From iris.heap_lang Require Import par.
From iris.program_logic Require Import auth sts saved_prop hoare ownership.
From iris.heap_lang Require Import proofmode.
Import uPred.
Definition worker (n : Z) : val :=
......@@ -15,63 +16,44 @@ Section client.
Context {Σ : gFunctors} `{!heapG Σ, !barrierG Σ, !spawnG Σ} (heapN N : namespace).
Local Notation iProp := (iPropG heap_lang Σ).
Definition y_inv q y : iProp :=
( f : val, y {q} f n : Z, WP f #n {{ λ v, v = #(n + 42) }})%I.
Definition y_inv (q : Qp) (l : loc) : iProp :=
( f : val, l {q} f n : Z, WP f #n {{ λ v, v = #(n + 42) }})%I.
Lemma y_inv_split q y :
y_inv q y (y_inv (q/2) y y_inv (q/2) y).
Lemma y_inv_split q l : y_inv q l (y_inv (q/2) l y_inv (q/2) l).
Proof.
rewrite /y_inv. apply exist_elim=>f.
rewrite -!(exist_intro f). rewrite heap_mapsto_op_split.
ecancel [y {_} _; y {_} _]%I. by rewrite [X in X _]always_sep_dup.
iIntros "Hl"; iDestruct "Hl" as {f} "[[Hl1 Hl2] #Hf]".
iSplitL "Hl1"; iExists f; by iSplitL; try iAlways.
Qed.
Lemma worker_safe q (n : Z) (b y : loc) :
(heap_ctx heapN recv heapN N b (y_inv q y))
WP worker n (%b) (%y) {{ λ _, True }}.
WP worker n (%b) (%y) {{ λ _, True }}.
Proof.
rewrite /worker. wp_lam. wp_let. ewp apply wait_spec.
rewrite comm. apply sep_mono_r. apply wand_intro_l.
rewrite sep_exist_r. apply exist_elim=>f. wp_seq.
(* TODO these parenthesis are rather surprising. *)
(ewp apply: (wp_load heapN _ _ q f)); eauto with I.
strip_later. (* hu, shouldn't it do that? *)
rewrite -assoc. apply sep_mono_r. apply wand_intro_l.
rewrite always_elim (forall_elim n) sep_elim_r sep_elim_l.
apply wp_mono=>?. eauto with I.
iIntros "[#Hh Hrecv]". wp_lam. wp_let.
wp_apply wait_spec; iFrame "Hrecv".
iIntros "Hy"; iDestruct "Hy" as {f} "[Hy #Hf]".
wp_seq. wp_load.
iApply wp_wand_r; iSplitR; [iApply "Hf"|by iIntros {v} "_"].
Qed.
Lemma client_safe :
heapN N heap_ctx heapN WP client {{ λ _, True }}.
Lemma client_safe : heapN N heap_ctx heapN WP client {{ λ _, True }}.
Proof.
intros ?. rewrite /client.
(ewp eapply wp_alloc); eauto with I. strip_later. apply forall_intro=>y.
apply wand_intro_l. wp_let.
ewp eapply (newbarrier_spec heapN N (y_inv 1 y)); last done.
rewrite comm. rewrite {1}[heap_ctx _]always_sep_dup -!assoc.
apply sep_mono_r. apply forall_intro=>b. apply wand_intro_l.
wp_let. (ewp eapply (wp_par heapN N (λ _, True%I) (λ _, True%I))); eauto.
rewrite 2!{1}[heap_ctx _]always_sep_dup !assoc [(_ heap_ctx _)%I]comm.
ecancel [heap_ctx _]. sep_split right: []; last first.
{ do 2 apply forall_intro=>_. apply wand_intro_l.
eauto using later_intro with I. }
sep_split left: [send heapN _ _ _; heap_ctx _; y _]%I.
iIntros {?} "#Hh"; rewrite /client. wp_alloc y as "Hy". wp_let.
wp_apply (newbarrier_spec heapN N (y_inv 1 y)); first done.
iFrame "Hh". iIntros {l} "[Hr Hs]". wp_let.
iApply (wp_par heapN N (λ _, True%I) (λ _, True%I)); first done.
iFrame "Hh". iSplitL "Hy Hs".
- (* The original thread, the sender. *)
(ewp eapply wp_store); eauto with I. strip_later.
ecancel [y _]%I. apply wand_intro_l.
wp_seq. rewrite -signal_spec right_id assoc sep_elim_l comm.
apply sep_mono_r. rewrite /y_inv -(exist_intro (λ: "z", '"z" + #42)%V).
apply sep_intro_True_r; first done. apply: always_intro.
apply forall_intro=>n. wp_let. wp_op. by apply const_intro.
wp_store. wp_seq. iApply signal_spec; iFrame "Hs"; iSplit; [|done].
iExists _; iSplitL; [done|]. iAlways; iIntros {n}. wp_let. by wp_op.
- (* The two spawned threads, the waiters. *)
rewrite recv_mono; last exact: y_inv_split.
rewrite (recv_split _ _ ) // pvs_frame_r. apply wp_strip_pvs.
(ewp eapply (wp_par heapN N (λ _, True%I) (λ _, True%I))); eauto.
do 2 rewrite {1}[heap_ctx _]always_sep_dup.
ecancel [heap_ctx _]. rewrite !assoc. sep_split right: []; last first.
{ do 2 apply forall_intro=>_. apply wand_intro_l.
eauto using later_intro with I. }
sep_split left: [recv heapN _ _ _; heap_ctx _]%I; by rewrite -worker_safe comm.
iSplitL; [|iIntros {_ _} "_"; by iNext].
iDestruct recv_weaken "[] Hr" as "Hr".
{ iIntros "?". by iApply y_inv_split "-". }
iPvs recv_split "Hr" as "[H1 H2]"; first done.
iApply (wp_par heapN N (λ _, True%I) (λ _, True%I)); eauto.
iFrame "Hh"; iSplitL "H1"; [|iSplitL "H2"; [|iIntros {_ _} "_"; by iNext]];
iApply worker_safe; by iSplit.
Qed.
End client.
......@@ -81,11 +63,9 @@ Section ClosedProofs.
Lemma client_safe_closed σ : {{ ownP σ : iProp }} client {{ λ v, True }}.
Proof.
apply ht_alt. rewrite (heap_alloc (nroot .@ "Barrier")); last done.
apply wp_strip_pvs, exist_elim=> ?. rewrite and_elim_l.
rewrite -(client_safe (nroot .@ "Barrier") (nroot .@ "Heap")) //.
(* This, too, should be automated. *)
by apply ndot_ne_disjoint.
iIntros "! Hσ".
iPvs (heap_alloc (nroot .@ "Barrier")) "Hσ" as {h} "[#Hh _]"; first done.
iApply (client_safe (nroot .@ "Barrier") (nroot .@ "Heap")); auto with ndisj.
Qed.
Print Assumptions client_safe_closed.
......
This diff is collapsed.
From iris.program_logic Require Export hoare.
From iris.heap_lang.lib.barrier Require Export barrier.
From iris.heap_lang.lib.barrier Require Import proof.
From iris.heap_lang Require Import proofmode.
Import uPred.
Section spec.
......@@ -22,14 +23,11 @@ Proof.
intros HN.
exists (λ l, CofeMor (recv heapN N l)), (λ l, CofeMor (send heapN N l)).
split_and?; simpl.
- intros P. apply: always_intro. apply impl_intro_r.
rewrite -(newbarrier_spec heapN N P) // always_and_sep_r.
apply sep_mono_r, forall_intro=>l; apply wand_intro_l.
by rewrite right_id -(exist_intro l) const_equiv // left_id.
- intros l P. apply ht_alt. by rewrite -signal_spec right_id.
- intros l P. apply ht_alt.
by rewrite -(wait_spec heapN N l P) wand_diag right_id.
- intros l P Q. apply vs_alt. rewrite -(recv_split heapN N N l P Q) //.
- intros l P Q. apply recv_weaken.
- iIntros {P} "#? ! _". iApply (newbarrier_spec _ _ P); first done.
iSplit; [done|]; iIntros {l} "?"; iExists l; by iSplit.
- iIntros {l P} "! [Hl HP]". by iApply signal_spec; iFrame "Hl HP".
- iIntros {l P} "! Hl". iApply wait_spec; iFrame "Hl". by iIntros "?".
- iIntros {l P Q} "! Hl". by iApply recv_split.
- apply recv_weaken.
Qed.
End spec.
From iris.heap_lang Require Export heap spawn.
From iris.heap_lang Require Import wp_tactics notation.
From iris.heap_lang Require Import proofmode notation.
Import uPred.
Definition par : val :=
......@@ -25,15 +25,12 @@ Lemma par_spec (Ψ1 Ψ2 : val → iProp) e (f1 f2 : val) (Φ : val → iProp) :
v1 v2, Ψ1 v1 Ψ2 v2 - Φ (v1,v2)%V)
WP par e {{ Φ }}.
Proof.
intros. rewrite /par. ewp (by eapply wp_value). wp_let. wp_proj.
ewp (eapply spawn_spec; wp_done).
apply sep_mono_r, sep_mono_r.
apply forall_intro=>h. apply wand_intro_l. wp_let. wp_proj.
wp_focus (f2 _). rewrite wp_frame_r wp_frame_l. apply wp_mono=>v2. wp_let.
ewp (by eapply join_spec).
apply sep_mono_r, forall_intro=>v1; apply wand_intro_l.
rewrite (forall_elim v1) (forall_elim v2). rewrite assoc wand_elim_r.
wp_let. apply wp_value; wp_done.
iIntros {??} "(#Hh&Hf1&Hf2&HΦ)". wp_value. wp_let. wp_proj.
wp_apply spawn_spec; try wp_done. iFrame "Hf1 Hh".
iIntros {l} "Hl". wp_let. wp_proj. wp_focus (f2 _).
iApply wp_wand_l; iFrame "Hf2"; iIntros {v} "H2". wp_let.
wp_apply join_spec; iFrame "Hl". iIntros {w} "H1".
iSpecialize "HΦ" "-"; first by iSplitL "H1". wp_let. by iPvsIntro.
Qed.
Lemma wp_par (Ψ1 Ψ2 : val iProp) (e1 e2 : expr []) (Φ : val iProp) :
......@@ -42,6 +39,7 @@ Lemma wp_par (Ψ1 Ψ2 : val → iProp) (e1 e2 : expr []) (Φ : val → iProp) :
v1 v2, Ψ1 v1 Ψ2 v2 - Φ (v1,v2)%V)
WP ParV e1 e2 {{ Φ }}.
Proof.
intros. rewrite -par_spec //. repeat apply sep_mono; done || by wp_seq.
iIntros {?} "(#Hh&H1&H2&H)". iApply par_spec; auto.
iFrame "Hh H". iSplitL "H1"; by wp_let.
Qed.
End proof.
From iris.program_logic Require Export global_functor.
From iris.heap_lang Require Export heap.
From iris.heap_lang Require Import wp_tactics notation.
From iris.proofmode Require Import invariants ghost_ownership.
From iris.heap_lang Require Import proofmode notation.
Import uPred.
Definition spawn : val :=
......@@ -33,12 +34,15 @@ Context (heapN N : namespace).
Local Notation iProp := (iPropG heap_lang Σ).
Definition spawn_inv (γ : gname) (l : loc) (Ψ : val iProp) : iProp :=
( lv, l lv (lv = InjLV #0 v, lv = InjRV v (Ψ v own γ (Excl ()))))%I.
( lv, l lv (lv = InjLV #0
v, lv = InjRV v (Ψ v own γ (Excl ()))))%I.
Definition join_handle (l : loc) (Ψ : val iProp) : iProp :=
( (heapN N) γ, heap_ctx heapN own γ (Excl ())
inv N (spawn_inv γ l Ψ))%I.
Typeclasses Opaque join_handle.
Global Instance spawn_inv_ne n γ l :
Proper (pointwise_relation val (dist n) ==> dist n) (spawn_inv γ l).
Proof. solve_proper. Qed.
......@@ -53,65 +57,36 @@ Lemma spawn_spec (Ψ : val → iProp) e (f : val) (Φ : val → iProp) :
(heap_ctx heapN WP f #() {{ Ψ }} l, join_handle l Ψ - Φ (%l))
WP spawn e {{ Φ }}.
Proof.
intros Hval Hdisj. rewrite /spawn. ewp (by eapply wp_value). wp_let.
wp eapply wp_alloc; eauto with I.
apply forall_intro=>l. apply wand_intro_l. wp_let.
rewrite (forall_elim l). eapply sep_elim_True_l.
{ by eapply (own_alloc (Excl ())). }
rewrite !pvs_frame_r. eapply wp_strip_pvs. rewrite !sep_exist_r.
apply exist_elim=>γ.
(* TODO: Figure out a better way to say "I want to establish ▷ spawn_inv". *)
trans (heap_ctx heapN WP f #() {{ Ψ }} (join_handle l Ψ - Φ (%l)%V)
own γ (Excl ()) (spawn_inv γ l Ψ))%I.
{ ecancel [ WP _ {{ _ }}; _ - _; heap_ctx _; own _ _]%I.
rewrite -later_intro /spawn_inv -(exist_intro (InjLV #0)).
cancel [l InjLV #0]%I. by apply or_intro_l', const_intro. }
rewrite (inv_alloc N) // !pvs_frame_l. eapply wp_strip_pvs.
ewp eapply wp_fork. rewrite [heap_ctx _]always_sep_dup [inv _ _]always_sep_dup.
sep_split left: [_ - _; inv _ _; own _ _; heap_ctx _]%I.
- wp_seq. rewrite -pvs_intro. eapply wand_apply_l; [done..|].
rewrite /join_handle. rewrite const_equiv // left_id -(exist_intro γ).
solve_sep_entails.
- wp_focus (f _). rewrite wp_frame_r wp_frame_l.
rewrite (of_to_val e) //. apply wp_mono=>v.
eapply (inv_fsa (wp_fsa _)) with (N0:=N);
rewrite /= ?to_of_val; eauto with I ndisj.
apply wand_intro_l. rewrite /spawn_inv {1}later_exist !sep_exist_r.
apply exist_elim=>lv. rewrite later_sep.
eapply wp_store; rewrite /= ?to_of_val; eauto with I ndisj.
cancel [ (l lv)]%I. strip_later. apply wand_intro_l.
rewrite right_id -later_intro -{2}[( _, _ _ _)%I](exist_intro (InjRV v)).
ecancel [l _]%I. apply or_intro_r'. rewrite sep_elim_r sep_elim_r sep_elim_l.
rewrite -(exist_intro v). rewrite const_equiv // left_id. apply or_intro_l.
iIntros {<-%of_to_val ?} "(#Hh&Hf&HΦ)". rewrite /spawn.
wp_let; wp_alloc l as "Hl"; wp_let.
iPvs (own_alloc (Excl ())) as {γ} "Hγ"; first done.
iPvs (inv_alloc N _ (spawn_inv γ l Ψ)) "[Hl]" as "#?"; first done.
{ iNext. iExists (InjLV #0). iFrame "Hl". by iLeft. }
wp_apply wp_fork. iSplitR "Hf".
- wp_seq. iPvsIntro. iApply "HΦ"; rewrite /join_handle. iSplit; first done.
iExists γ. iFrame "Hγ"; by iSplit.
- wp_focus (f _). iApply wp_wand_l; iFrame "Hf"; iIntros {v} "Hv".
iInv N as "Hinv"; first wp_done; iDestruct "Hinv" as {v'} "[Hl _]".
wp_store. iSplit; [iNext|done].
iExists (InjRV v); iFrame "Hl"; iRight; iExists v; iSplit; [done|by iLeft].
Qed.
Lemma join_spec (Ψ : val iProp) l (Φ : val iProp) :
(join_handle l Ψ v, Ψ v - Φ v)
WP join (%l) {{ Φ }}.
(join_handle l Ψ v, Ψ v - Φ v) WP join (%l) {{ Φ }}.
Proof.
wp_rec. wp_focus (! _)%E.
rewrite {1}/join_handle sep_exist_l !sep_exist_r. apply exist_elim=>γ.
rewrite -!assoc. apply const_elim_sep_l=>Hdisj.
eapply (inv_fsa (wp_fsa _)) with (N0:=N); simpl; eauto with I ndisj.
apply wand_intro_l. rewrite /spawn_inv {1}later_exist !sep_exist_r.
apply exist_elim=>lv.
wp eapply wp_load; eauto with I ndisj. cancel [l lv]%I.
apply wand_intro_l. rewrite -later_intro -[X in _ (X _)](exist_intro lv).
cancel [l lv]%I. rewrite sep_or_r. apply or_elim.
- (* Case 1 : nothing sent yet, we wait. *)
rewrite -or_intro_l. apply const_elim_sep_l=>-> {lv}.
rewrite (const_equiv (_ = _)) // left_id. wp_case.
wp_seq. rewrite -always_wand_impl always_elim.
rewrite !assoc. eapply wand_apply_r'; first done.
rewrite -(exist_intro γ) const_equiv //. solve_sep_entails.
- rewrite [(_ _)%I]sep_elim_l -or_intro_r !sep_exist_r. apply exist_mono=>v.
rewrite -!assoc. apply const_elim_sep_l=>->{lv}. rewrite const_equiv // left_id.
rewrite sep_or_r. apply or_elim; last first.
{ (* contradiction: we have the token twice. *)
rewrite [(heap_ctx _ _)%I]sep_elim_r !assoc. rewrite -own_op own_valid_l.
rewrite -!assoc discrete_valid. apply const_elim_sep_l=>-[]. }
rewrite -or_intro_r. ecancel [own _ _].
wp_case. wp_let. ewp (eapply wp_value; wp_done).
rewrite (forall_elim v). rewrite !assoc. eapply wand_apply_r'; eauto with I.
rewrite /join_handle; iIntros "[[% H] Hv]"; iDestruct "H" as {γ} "(#?&Hγ&#?)".
iLöb "Hγ Hv" as "IH". wp_rec. wp_focus (! _)%E.
iInv N as "Hinv"; iDestruct "Hinv" as {v} "[Hl Hinv]".
wp_load. iDestruct "Hinv" as "[%|Hinv]"; subst.
- iSplitL "Hl"; [iNext; iExists _; iFrame "Hl"; by iLeft|].
wp_case. wp_seq. iApply "IH" "Hγ Hv".
- iDestruct "Hinv" as {v'} "[% [HΨ|Hγ']]"; subst.
+ iSplitL "Hl Hγ".
{ iNext. iExists _; iFrame "Hl"; iRight.
iExists _; iSplit; [done|by iRight]. }
wp_case. wp_let. iPvsIntro. by iApply "Hv".
+ iCombine "Hγ" "Hγ'" as "Hγ". by iDestruct own_valid "Hγ" as "%".
Qed.
End proof.
Typeclasses Opaque join_handle.
From iris.proofmode Require Import coq_tactics.
From iris.proofmode Require Export weakestpre.
From iris.heap_lang Require Export wp_tactics heap.
Import uPred.
Ltac strip_later ::= iNext.
Section heap.
Context {Σ : gFunctors} `{heapG Σ}.
Implicit Types N : namespace.
Implicit Types P Q : iPropG heap_lang Σ.
Implicit Types Φ : val iPropG heap_lang Σ.
Implicit Types Δ : envs (iResR heap_lang (globalF Σ)).
Global Instance sep_destruct_mapsto l q v :
SepDestruct false (l {q} v) (l {q/2} v) (l {q/2} v).
Proof. by rewrite /SepDestruct heap_mapsto_op_split. Qed.
Lemma tac_wp_alloc Δ Δ' N E j e v Φ :
to_val e = Some v
Δ heap_ctx N nclose N E
StripLaterEnvs Δ Δ'
( l, Δ'',
envs_app false (Esnoc Enil j (l v)) Δ' = Some Δ'' Δ'' Φ (LocV l))
Δ WP Alloc e @ E {{ Φ }}.
Proof.
intros ???? HΔ; eapply wp_alloc; eauto.
rewrite strip_later_env_sound; apply later_mono, forall_intro=> l.
destruct (HΔ l) as (Δ''&?&HΔ'). rewrite envs_app_sound //; simpl.
by rewrite right_id HΔ'.
Qed.
Lemma tac_wp_load Δ Δ' N E i l q v Φ :
Δ heap_ctx N nclose N E
StripLaterEnvs Δ Δ'
envs_lookup i Δ' = Some (false, l {q} v)%I
Δ' Φ v
Δ WP Load (Loc l) @ E {{ Φ }}.
Proof.
intros. eapply wp_load; eauto.
rewrite strip_later_env_sound -later_sep envs_lookup_split //; simpl.
by apply later_mono, sep_mono_r, wand_mono.
Qed.
Lemma tac_wp_store Δ Δ' Δ'' N E i l v e v' Φ :
to_val e = Some v'
Δ heap_ctx N nclose N E
StripLaterEnvs Δ Δ'
envs_lookup i Δ' = Some (false, l v)%I
envs_simple_replace i false (Esnoc Enil i (l v')) Δ' = Some Δ''
Δ'' Φ (LitV LitUnit) Δ WP Store (Loc l) e @ E {{ Φ }}.
Proof.
intros. eapply wp_store; eauto.
rewrite strip_later_env_sound -later_sep envs_simple_replace_sound //; simpl.
rewrite right_id. by apply later_mono, sep_mono_r, wand_mono.
Qed.
Lemma tac_wp_cas_fail Δ Δ' N E i l q v e1 v1 e2 v2 Φ :
to_val e1 = Some v1 to_val e2 = Some v2
Δ heap_ctx N nclose N E
StripLaterEnvs Δ Δ'
envs_lookup i Δ' = Some (false, l {q} v)%I v v1
Δ' Φ (LitV (LitBool false))
Δ WP CAS (Loc l) e1 e2 @ E {{ Φ }}.
Proof.
intros. eapply wp_cas_fail; eauto.
rewrite strip_later_env_sound -later_sep envs_lookup_split //; simpl.
by apply later_mono, sep_mono_r, wand_mono.
Qed.
Lemma tac_wp_cas_suc Δ Δ' Δ'' N E i l e1 v1 e2 v2 Φ :
to_val e1 = Some v1 to_val e2 = Some v2
Δ heap_ctx N nclose N E
StripLaterEnvs Δ Δ'
envs_lookup i Δ' = Some (false, l v1)%I
envs_simple_replace i false (Esnoc Enil i (l v2)) Δ' = Some Δ''
Δ'' Φ (LitV (LitBool true)) Δ WP CAS (Loc l) e1 e2 @ E {{ Φ }}.
Proof.
intros. eapply wp_cas_suc; eauto.
rewrite strip_later_env_sound -later_sep envs_simple_replace_sound //; simpl.
rewrite right_id. by apply later_mono, sep_mono_r, wand_mono.
Qed.
End heap.
Tactic Notation "wp_apply" open_constr(lem) :=
match goal with
| |- _ wp ?E ?e ?Q => reshape_expr e ltac:(fun K e' =>
wp_bind K; iApply lem; try iNext)
end.
Tactic Notation "wp_apply" open_constr(lem) constr(Hs) :=
match goal with
| |- _ wp ?E ?e ?Q => reshape_expr e ltac:(fun K e' =>
wp_bind K; iApply lem Hs; try iNext)
end.
Tactic Notation "wp_alloc" ident(l) "as" constr(H) :=
match goal with
| |- _ wp ?E ?e ?Q => reshape_expr e ltac:(fun K e' =>
match eval hnf in e' with
| Alloc ?e =>
wp_bind K; eapply tac_wp_alloc with _ _ H _;
[wp_done || fail 2 "wp_alloc:" e "not a value"
|iAssumption || fail 2 "wp_alloc: cannot find heap_ctx"
|done || eauto with ndisj
|apply _
|intros l; eexists; split;
[env_cbv; reflexivity || fail 2 "wp_alloc:" H "not fresh"
|wp_finish]]
end)
end.
Tactic Notation "wp_alloc" ident(l) := let H := iFresh in wp_alloc l as H.
Tactic Notation "wp_load" :=
match goal with
| |- _ wp ?E ?e ?Q => reshape_expr e ltac:(fun K e' =>
match eval hnf in e' with
| Load (Loc ?l) =>
wp_bind K; eapply tac_wp_load;
[iAssumption || fail 2 "wp_load: cannot find heap_ctx"
|done || eauto with ndisj
|apply _
|iAssumptionCore || fail 2 "wp_cas_fail: cannot find" l "↦ ?"
|wp_finish]
end)
end.
Tactic Notation "wp_store" :=
match goal with
| |- _ wp ?E ?e ?Q => reshape_expr e ltac:(fun K e' =>
match eval hnf in e' with
| Store ?l ?e =>
wp_bind K; eapply tac_wp_store;
[wp_done || fail 2 "wp_store:" e "not a value"
|iAssumption || fail 2 "wp_store: cannot find heap_ctx"
|done || eauto with ndisj
|apply _
|iAssumptionCore || fail 2 "wp_store: cannot find" l "↦ ?"
|env_cbv; reflexivity
|wp_finish]
end)
end.
Tactic Notation "wp_cas_fail" :=
match goal with
| |- _ wp ?E ?e ?Q => reshape_expr e ltac:(fun K e' =>
match eval hnf in e' with
| CAS (Loc ?l) ?e1 ?e2 =>
wp_bind K; eapply tac_wp_cas_fail;
[wp_done || fail 2 "wp_cas_fail:" e1 "not a value"
|wp_done || fail 2 "wp_cas_fail:" e2 "not a value"