Iris Proofmode.

_CoqProject

@@ -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

algebra/upred.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) :

algebra/upred_tactics.v

@@ -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.

heap_lang/lib/barrier/client.v

 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.

heap_lang/lib/barrier/specification.v

 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.

heap_lang/lib/par.v

 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.

heap_lang/lib/spawn.v

 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.

heap_lang/proofmode.v

+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"
+         |iAssumption || fail 2 "wp_cas_fail: cannot find heap_ctx"
+         |done || eauto with ndisj
+         |apply _
+         |iAssumptionCore || fail 2 "wp_cas_fail: cannot find" l "↦ ?"
+         |try discriminate
+         |wp_finish]
+    end)
+  end.
+
+Tactic Notation "wp_cas_suc" :=
+  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_suc;
+         [wp_done || fail 2 "wp_cas_suc:" e1 "not a value"
+         |wp_done || fail 2 "wp_cas_suc:" e1 "not a value"
+         |iAssumption || fail 2 "wp_cas_suc: cannot find heap_ctx"
+         |done || eauto with ndisj
+         |apply _
+         |iAssumptionCore || fail 2 "wp_cas_suc: cannot find" l "↦ ?"
+         |env_cbv; reflexivity
+         |wp_finish]
+    end)
+  end.

heap_lang/wp_tactics.v

@@ -9,33 +9,37 @@ Ltac wp_bind K :=
   | _ => etrans; [|fast_by apply (wp_bind K)]; simpl
   end.
 
-Ltac wp_finish :=
-  intros_revert ltac:(
-    try strip_later;
-    match goal with
-    | |- _ ⊢ wp _ _ _ =>
-      etrans; [|eapply wp_value_pvs; fast_done]; lazy beta;
-      (* sometimes, we will have to do a final view shift, so only apply
-      pvs_intro if we obtain a consecutive wp *)
-      try (etrans; [|apply pvs_intro];