iris/program_logic/ectx_lifting.v

+(** Some derived lemmas for ectx-based languages *)
+From iris.proofmode Require Import proofmode.
+From iris.program_logic Require Export ectx_language weakestpre lifting.
+From iris.prelude Require Import options.
+
+Section wp.
+Context {Λ : ectxLanguage} `{!irisGS_gen hlc Λ Σ} {Hinh : Inhabited (state Λ)}.
+Implicit Types s : stuckness.
+Implicit Types P : iProp Σ.
+Implicit Types Φ : val Λ → iProp Σ.
+Implicit Types v : val Λ.
+Implicit Types e : expr Λ.
+Local Hint Resolve base_prim_reducible base_reducible_prim_step : core.
+Local Definition reducible_not_val_inhabitant e := reducible_not_val e inhabitant.
+Local Hint Resolve reducible_not_val_inhabitant : core.
+Local Hint Resolve base_stuck_stuck : core.
+
+Lemma wp_lift_base_step_fupd {s E Φ} e1 :
+  to_val e1 = None →
+  (∀ σ1 ns κ κs nt, state_interp σ1 ns (κ ++ κs) nt ={E,∅}=∗
+    ⌜base_reducible e1 σ1⌝ ∗
+    ∀ e2 σ2 efs, ⌜base_step e1 σ1 κ e2 σ2 efs⌝ -∗ £ 1 ={∅}=∗ ▷ |={∅,E}=>
+      state_interp σ2 (S ns) κs (length efs + nt) ∗
+      WP e2 @ s; E {{ Φ }} ∗
+      [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ fork_post }})
+  ⊢ WP e1 @ s; E {{ Φ }}.
+Proof.
+  iIntros (?) "H". iApply wp_lift_step_fupd=>//. iIntros (σ1 ns κ κs nt) "Hσ".
+  iMod ("H" with "Hσ") as "[% H]"; iModIntro.
+  iSplit; first by destruct s; eauto. iIntros (e2 σ2 efs ?).
+  iApply "H"; eauto.
+Qed.
+
+Lemma wp_lift_base_step {s E Φ} e1 :
+  to_val e1 = None →
+  (∀ σ1 ns κ κs nt, state_interp σ1 ns (κ ++ κs) nt ={E,∅}=∗
+    ⌜base_reducible e1 σ1⌝ ∗
+    ▷ ∀ e2 σ2 efs, ⌜base_step e1 σ1 κ e2 σ2 efs⌝ -∗ £ 1 ={∅,E}=∗
+      state_interp σ2 (S ns) κs (length efs + nt) ∗
+      WP e2 @ s; E {{ Φ }} ∗
+      [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ fork_post }})
+  ⊢ WP e1 @ s; E {{ Φ }}.
+Proof.
+  iIntros (?) "H". iApply wp_lift_base_step_fupd; [done|]. iIntros (?????) "?".
+  iMod ("H" with "[$]") as "[$ H]". iIntros "!>" (e2 σ2 efs ?) "Hcred !> !>". by iApply "H".
+Qed.
+
+Lemma wp_lift_base_stuck E Φ e :
+  to_val e = None →
+  sub_redexes_are_values e →
+  (∀ σ ns κs nt, state_interp σ ns κs nt ={E,∅}=∗ ⌜base_stuck e σ⌝)
+  ⊢ WP e @ E ?{{ Φ }}.
+Proof.
+  iIntros (??) "H". iApply wp_lift_stuck; first done.
+  iIntros (σ ns κs nt) "Hσ". iMod ("H" with "Hσ") as "%". by auto.
+Qed.
+
+Lemma wp_lift_pure_base_stuck E Φ e :
+  to_val e = None →
+  sub_redexes_are_values e →
+  (∀ σ, base_stuck e σ) →
+  ⊢ WP e @ E ?{{ Φ }}.
+Proof using Hinh.
+  iIntros (?? Hstuck). iApply wp_lift_base_stuck; [done|done|].
+  iIntros (σ ns κs nt) "_". iApply fupd_mask_intro; by auto with set_solver.
+Qed.
+
+Lemma wp_lift_atomic_base_step_fupd {s E1 E2 Φ} e1 :
+  to_val e1 = None →
+  (∀ σ1 ns κ κs nt, state_interp σ1 ns (κ ++ κs) nt ={E1}=∗
+    ⌜base_reducible e1 σ1⌝ ∗
+    ∀ e2 σ2 efs, ⌜base_step e1 σ1 κ e2 σ2 efs⌝ -∗ £ 1 ={E1}[E2]▷=∗
+      state_interp σ2 (S ns) κs (length efs + nt) ∗
+      from_option Φ False (to_val e2) ∗
+      [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ fork_post }})
+  ⊢ WP e1 @ s; E1 {{ Φ }}.
+Proof.
+  iIntros (?) "H". iApply wp_lift_atomic_step_fupd; [done|].
+  iIntros (σ1 ns κ κs nt) "Hσ1". iMod ("H" with "Hσ1") as "[% H]"; iModIntro.
+  iSplit; first by destruct s; auto. iIntros (e2 σ2 efs Hstep).
+  iApply "H"; eauto.
+Qed.
+
+Lemma wp_lift_atomic_base_step {s E Φ} e1 :
+  to_val e1 = None →
+  (∀ σ1 ns κ κs nt, state_interp σ1 ns (κ ++ κs) nt ={E}=∗
+    ⌜base_reducible e1 σ1⌝ ∗
+    ▷ ∀ e2 σ2 efs, ⌜base_step e1 σ1 κ e2 σ2 efs⌝ -∗ £ 1 ={E}=∗
+      state_interp σ2 (S ns) κs (length efs + nt) ∗
+      from_option Φ False (to_val e2) ∗
+      [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ fork_post }})
+  ⊢ WP e1 @ s; E {{ Φ }}.
+Proof.
+  iIntros (?) "H". iApply wp_lift_atomic_step; eauto.
+  iIntros (σ1 ns κ κs nt) "Hσ1". iMod ("H" with "Hσ1") as "[% H]"; iModIntro.
+  iSplit; first by destruct s; auto. iNext. iIntros (e2 σ2 efs Hstep).
+  iApply "H"; eauto.
+Qed.
+
+Lemma wp_lift_atomic_base_step_no_fork_fupd {s E1 E2 Φ} e1 :
+  to_val e1 = None →
+  (∀ σ1 ns κ κs nt, state_interp σ1 ns (κ ++ κs) nt ={E1}=∗
+    ⌜base_reducible e1 σ1⌝ ∗
+    ∀ e2 σ2 efs, ⌜base_step e1 σ1 κ e2 σ2 efs⌝ -∗ £ 1 ={E1}[E2]▷=∗
+      ⌜efs = []⌝ ∗ state_interp σ2 (S ns) κs nt ∗ from_option Φ False (to_val e2))
+  ⊢ WP e1 @ s; E1 {{ Φ }}.
+Proof.
+  iIntros (?) "H". iApply wp_lift_atomic_base_step_fupd; [done|].
+  iIntros (σ1 ns κ κs nt) "Hσ1". iMod ("H" $! σ1 with "Hσ1") as "[$ H]"; iModIntro.
+  iIntros (v2 σ2 efs Hstep) "Hcred".
+  iMod ("H" $! v2 σ2 efs with "[# //] Hcred") as "H".
+  iIntros "!> !>". iMod "H" as "(-> & ? & ?) /=". by iFrame.
+Qed.
+
+Lemma wp_lift_atomic_base_step_no_fork {s E Φ} e1 :
+  to_val e1 = None →
+  (∀ σ1 ns κ κs nt, state_interp σ1 ns (κ ++ κs) nt ={E}=∗
+    ⌜base_reducible e1 σ1⌝ ∗
+    ▷ ∀ e2 σ2 efs, ⌜base_step e1 σ1 κ e2 σ2 efs⌝ -∗ £ 1 ={E}=∗
+      ⌜efs = []⌝ ∗ state_interp σ2 (S ns) κs nt ∗ from_option Φ False (to_val e2))
+  ⊢ WP e1 @ s; E {{ Φ }}.
+Proof.
+  iIntros (?) "H". iApply wp_lift_atomic_base_step; eauto.
+  iIntros (σ1 ns κ κs nt) "Hσ1". iMod ("H" $! σ1 with "Hσ1") as "[$ H]"; iModIntro.
+  iNext; iIntros (v2 σ2 efs Hstep) "Hcred".
+  iMod ("H" $! v2 σ2 efs with "[//] Hcred") as "(-> & ? & ?) /=". by iFrame.
+Qed.
+
+Lemma wp_lift_pure_det_base_step_no_fork {s E E' Φ} e1 e2 :
+  to_val e1 = None →
+  (∀ σ1, base_reducible e1 σ1) →
+  (∀ σ1 κ e2' σ2 efs',
+    base_step e1 σ1 κ e2' σ2 efs' → κ = [] ∧ σ2 = σ1 ∧ e2' = e2 ∧ efs' = []) →
+  (|={E}[E']▷=> £ 1 -∗ WP e2 @ s; E {{ Φ }}) ⊢ WP e1 @ s; E {{ Φ }}.
+Proof using Hinh.
+  intros. rewrite -(wp_lift_pure_det_step_no_fork e1 e2); eauto.
+  destruct s; by auto.
+Qed.
+
+Lemma wp_lift_pure_det_base_step_no_fork' {s E Φ} e1 e2 :
+  to_val e1 = None →
+  (∀ σ1, base_reducible e1 σ1) →
+  (∀ σ1 κ e2' σ2 efs',
+    base_step e1 σ1 κ e2' σ2 efs' → κ = [] ∧ σ2 = σ1 ∧ e2' = e2 ∧ efs' = []) →
+  ▷ (£ 1 -∗ WP e2 @ s; E {{ Φ }}) ⊢ WP e1 @ s; E {{ Φ }}.
+Proof using Hinh.
+  intros. rewrite -[(WP e1 @ s; _ {{ _ }})%I]wp_lift_pure_det_base_step_no_fork //.
+  rewrite -step_fupd_intro //.
+Qed.
+End wp.

iris/program_logic/ectxi_language.v

+(** An axiomatization of languages based on evaluation context items, including
+    a proof that these are instances of general ectx-based languages. *)
+From iris.prelude Require Export prelude.
+From iris.program_logic Require Import language ectx_language.
+From iris.prelude Require Import options.
+
+(** TAKE CARE: When you define an [ectxiLanguage] canonical structure for your
+language, you need to also define a corresponding [language] and [ectxLanguage]
+canonical structure for canonical structure inference to work properly. You
+should use the coercion [EctxLanguageOfEctxi] and [LanguageOfEctx] for that, and
+not [ectxi_lang] and [ectxi_lang_ectx], otherwise the canonical projections will
+not point to the right terms.
+
+A full concrete example of setting up your language can be found in [heap_lang].
+Below you can find the relevant parts:
+
+  Module heap_lang.
+    (* Your language definition *)
+
+    Lemma heap_lang_mixin : EctxiLanguageMixin of_val to_val fill_item base_step.
+    Proof. (* ... *) Qed.
+  End heap_lang.
+
+  Canonical Structure heap_ectxi_lang := EctxiLanguage heap_lang.heap_lang_mixin.
+  Canonical Structure heap_ectx_lang := EctxLanguageOfEctxi heap_ectxi_lang.
+  Canonical Structure heap_lang := LanguageOfEctx heap_ectx_lang.
+*)
+
+Section ectxi_language_mixin.
+  Context {expr val ectx_item state observation : Type}.
+  Context (of_val : val → expr).
+  Context (to_val : expr → option val).
+  Context (fill_item : ectx_item → expr → expr).
+  Context (base_step : expr → state → list observation → expr → state → list expr → Prop).
+
+  Record EctxiLanguageMixin := {
+    mixin_to_of_val v : to_val (of_val v) = Some v;
+    mixin_of_to_val e v : to_val e = Some v → of_val v = e;
+    mixin_val_stuck e1 σ1 κ e2 σ2 efs : base_step e1 σ1 κ e2 σ2 efs → to_val e1 = None;
+
+    mixin_fill_item_val Ki e : is_Some (to_val (fill_item Ki e)) → is_Some (to_val e);
+    (** [fill_item] is always injective on the expression for a fixed
+        context. *)
+    mixin_fill_item_inj Ki : Inj (=) (=) (fill_item Ki);
+    (** [fill_item] with (potentially different) non-value expressions is
+        injective on the context. *)
+    mixin_fill_item_no_val_inj Ki1 Ki2 e1 e2 :
+      to_val e1 = None → to_val e2 = None →
+      fill_item Ki1 e1 = fill_item Ki2 e2 → Ki1 = Ki2;
+
+    (** If [fill_item Ki e] takes a base step, then [e] is a value (unlike for
+        [ectx_language], an empty context is impossible here).  In other words,
+        if [e] is not a value then wrapping it in a context does not add new
+        base redex positions. *)
+    mixin_base_ctx_step_val Ki e σ1 κ e2 σ2 efs :
+      base_step (fill_item Ki e) σ1 κ e2 σ2 efs → is_Some (to_val e);
+  }.
+End ectxi_language_mixin.
+
+Structure ectxiLanguage := EctxiLanguage {
+  expr : Type;
+  val : Type;
+  ectx_item : Type;
+  state : Type;
+  observation : Type;
+
+  of_val : val → expr;
+  to_val : expr → option val;
+  fill_item : ectx_item → expr → expr;
+  base_step : expr → state → list observation → expr → state → list expr → Prop;
+
+  ectxi_language_mixin :
+    EctxiLanguageMixin of_val to_val fill_item base_step
+}.
+
+Bind Scope expr_scope with expr.
+Bind Scope val_scope with val.
+
+Global Arguments EctxiLanguage {_ _ _ _ _ _ _ _ _} _.
+Global Arguments of_val {_} _.
+Global Arguments to_val {_} _.
+Global Arguments fill_item {_} _ _.
+Global Arguments base_step {_} _ _ _ _ _ _.
+
+Section ectxi_language.
+  Context {Λ : ectxiLanguage}.
+  Implicit Types (e : expr Λ) (Ki : ectx_item Λ).
+  Notation ectx := (list (ectx_item Λ)).
+
+  (* Only project stuff out of the mixin that is not also in ectxLanguage *)
+  Global Instance fill_item_inj Ki : Inj (=) (=) (fill_item Ki).
+  Proof. apply ectxi_language_mixin. Qed.
+  Lemma fill_item_val Ki e : is_Some (to_val (fill_item Ki e)) → is_Some (to_val e).
+  Proof. apply ectxi_language_mixin. Qed.
+  Lemma fill_item_no_val_inj Ki1 Ki2 e1 e2 :
+    to_val e1 = None → to_val e2 = None →
+    fill_item Ki1 e1 = fill_item Ki2 e2 → Ki1 = Ki2.
+  Proof. apply ectxi_language_mixin. Qed.
+  Lemma base_ctx_step_val Ki e σ1 κ e2 σ2 efs :
+    base_step (fill_item Ki e) σ1 κ e2 σ2 efs → is_Some (to_val e).
+  Proof. apply ectxi_language_mixin. Qed.
+
+  Definition fill (K : ectx) (e : expr Λ) : expr Λ := foldl (flip fill_item) e K.
+
+  Lemma fill_app (K1 K2 : ectx) e : fill (K1 ++ K2) e = fill K2 (fill K1 e).
+  Proof. apply foldl_app. Qed.
+
+  Definition ectxi_lang_ectx_mixin :
+    EctxLanguageMixin of_val to_val [] (flip (++)) fill base_step.
+  Proof.
+    assert (fill_val : ∀ K e, is_Some (to_val (fill K e)) → is_Some (to_val e)).
+    { intros K. induction K as [|Ki K IH]=> e //=. by intros ?%IH%fill_item_val. }
+    assert (fill_not_val : ∀ K e, to_val e = None → to_val (fill K e) = None).
+    { intros K e. rewrite !eq_None_not_Some. eauto. }
+    split.
+    - apply ectxi_language_mixin.
+    - apply ectxi_language_mixin.
+    - apply ectxi_language_mixin.
+    - done.
+    - intros K1 K2 e. by rewrite /fill /= foldl_app.
+    - intros K; induction K as [|Ki K IH]; rewrite /Inj; naive_solver.
+    - done.
+    - intros K K' e1 κ e1' σ1 e2 σ2 efs Hfill Hred Hstep; revert K' Hfill.
+      induction K as [|Ki K IH] using rev_ind=> /= K' Hfill; eauto using app_nil_r.
+      destruct K' as [|Ki' K' _] using @rev_ind; simplify_eq/=.
+      { rewrite fill_app in Hstep. apply base_ctx_step_val in Hstep.
+        apply fill_val in Hstep. by apply not_eq_None_Some in Hstep. }
+      rewrite !fill_app /= in Hfill.
+      assert (Ki = Ki') as ->.
+      { eapply fill_item_no_val_inj, Hfill; eauto using val_base_stuck.
+        apply fill_not_val. revert Hstep. apply ectxi_language_mixin. }
+      simplify_eq. destruct (IH K') as [K'' ->]; auto.
+      exists K''. by rewrite assoc.
+    - intros K e1 σ1 κ e2 σ2 efs.
+      destruct K as [|Ki K _] using rev_ind; simpl; first by auto.
+      rewrite fill_app /=.
+      intros ?%base_ctx_step_val; eauto using fill_val.
+  Qed.
+
+  Canonical Structure ectxi_lang_ectx := EctxLanguage ectxi_lang_ectx_mixin.
+  Canonical Structure ectxi_lang := LanguageOfEctx ectxi_lang_ectx.
+
+  Lemma fill_not_val K e : to_val e = None → to_val (fill K e) = None.
+  Proof. rewrite !eq_None_not_Some. eauto using fill_val. Qed.
+
+  Lemma ectxi_language_sub_redexes_are_values e :
+    (∀ Ki e', e = fill_item Ki e' → is_Some (to_val e')) →
+    sub_redexes_are_values e.
+  Proof.
+    intros Hsub K e' ->. destruct K as [|Ki K _] using @rev_ind=> //=.
+    intros []%eq_None_not_Some. eapply fill_val, Hsub. by rewrite /= fill_app.
+  Qed.
+
+  Global Instance ectxi_lang_ctx_item Ki : LanguageCtx (fill_item Ki).
+  Proof. change (LanguageCtx (fill [Ki])). apply _. Qed.
+End ectxi_language.
+
+Global Arguments ectxi_lang_ectx : clear implicits.
+Global Arguments ectxi_lang : clear implicits.
+Coercion ectxi_lang_ectx : ectxiLanguage >-> ectxLanguage.
+Coercion ectxi_lang : ectxiLanguage >-> language.
+
+Definition EctxLanguageOfEctxi (Λ : ectxiLanguage) : ectxLanguage :=
+  let '@EctxiLanguage E V C St K of_val to_val fill base mix := Λ in
+  @EctxLanguage E V (list C) St K of_val to_val _ _ _ _
+    (@ectxi_lang_ectx_mixin (@EctxiLanguage E V C St K of_val to_val fill base mix)).
+
+Global Arguments EctxLanguageOfEctxi : simpl never.

iris/program_logic/language.v

+From iris.algebra Require Export ofe.
+From iris.bi Require Export weakestpre.
+From iris.prelude Require Import options.
+
+Section language_mixin.
+  Context {expr val state observation : Type}.
+  Context (of_val : val → expr).
+  Context (to_val : expr → option val).
+  (** We annotate the reduction relation with observations [κ], which we will
+     use in the definition of weakest preconditions to predict future
+     observations and assert correctness of the predictions. *)
+  Context (prim_step : expr → state → list observation → expr → state → list expr → Prop).
+
+  Record LanguageMixin := {
+    mixin_to_of_val v : to_val (of_val v) = Some v;
+    mixin_of_to_val e v : to_val e = Some v → of_val v = e;
+    mixin_val_stuck e σ κ e' σ' efs : prim_step e σ κ e' σ' efs → to_val e = None
+  }.
+End language_mixin.
+
+Structure language := Language {
+  expr : Type;
+  val : Type;
+  state : Type;
+  observation : Type;
+  of_val : val → expr;
+  to_val : expr → option val;
+  prim_step : expr → state → list observation → expr → state → list expr → Prop;
+  language_mixin : LanguageMixin of_val to_val prim_step
+}.
+
+Bind Scope expr_scope with expr.
+Bind Scope val_scope with val.
+
+Global Arguments Language {_ _ _ _ _ _ _} _.
+Global Arguments of_val {_} _.
+Global Arguments to_val {_} _.
+Global Arguments prim_step {_} _ _ _ _ _ _.
+
+Canonical Structure stateO Λ := leibnizO (state Λ).
+Canonical Structure valO Λ := leibnizO (val Λ).
+Canonical Structure exprO Λ := leibnizO (expr Λ).
+
+Definition cfg (Λ : language) := (list (expr Λ) * state Λ)%type.
+
+Class LanguageCtx {Λ : language} (K : expr Λ → expr Λ) := {
+  fill_not_val e :
+    to_val e = None → to_val (K e) = None;
+  fill_step e1 σ1 κ e2 σ2 efs :
+    prim_step e1 σ1 κ e2 σ2 efs →
+    prim_step (K e1) σ1 κ (K e2) σ2 efs;
+  fill_step_inv e1' σ1 κ e2 σ2 efs :
+    to_val e1' = None → prim_step (K e1') σ1 κ e2 σ2 efs →
+    ∃ e2', e2 = K e2' ∧ prim_step e1' σ1 κ e2' σ2 efs
+}.
+
+Global Instance language_ctx_id Λ : LanguageCtx (@id (expr Λ)).
+Proof. constructor; naive_solver. Qed.
+
+Inductive atomicity := StronglyAtomic | WeaklyAtomic.
+
+Definition stuckness_to_atomicity (s : stuckness) : atomicity :=
+  if s is MaybeStuck then StronglyAtomic else WeaklyAtomic.
+
+Section language.
+  Context {Λ : language}.
+  Implicit Types v : val Λ.
+  Implicit Types e : expr Λ.
+
+  Lemma to_of_val v : to_val (of_val v) = Some v.
+  Proof. apply language_mixin. Qed.
+  Lemma of_to_val e v : to_val e = Some v → of_val v = e.
+  Proof. apply language_mixin. Qed.
+  Lemma val_stuck e σ κ e' σ' efs : prim_step e σ κ e' σ' efs → to_val e = None.
+  Proof. apply language_mixin. Qed.
+
+  Definition reducible (e : expr Λ) (σ : state Λ) :=
+    ∃ κ e' σ' efs, prim_step e σ κ e' σ' efs.
+  (* Total WP only permits reductions without observations *)
+  Definition reducible_no_obs (e : expr Λ) (σ : state Λ) :=
+    ∃ e' σ' efs, prim_step e σ [] e' σ' efs.
+  Definition irreducible (e : expr Λ) (σ : state Λ) :=
+    ∀ κ e' σ' efs, ¬prim_step e σ κ e' σ' efs.
+  Definition stuck (e : expr Λ) (σ : state Λ) :=
+    to_val e = None ∧ irreducible e σ.
+  Definition not_stuck (e : expr Λ) (σ : state Λ) :=
+    is_Some (to_val e) ∨ reducible e σ.
+
+  (* [Atomic WeaklyAtomic]: This (weak) form of atomicity is enough to open
+     invariants when WP ensures safety, i.e., programs never can get stuck.  We
+     have an example in lambdaRust of an expression that is atomic in this
+     sense, but not in the stronger sense defined below, and we have to be able
+     to open invariants around that expression.  See `CasStuckS` in
+     [lambdaRust](https://gitlab.mpi-sws.org/FP/LambdaRust-coq/blob/master/theories/lang/lang.v).
+
+     [Atomic StronglyAtomic]: To open invariants with a WP that does not ensure
+     safety, we need a stronger form of atomicity.  With the above definition,
+     in case `e` reduces to a stuck non-value, there is no proof that the
+     invariants have been established again. *)
+  Class Atomic (a : atomicity) (e : expr Λ) : Prop :=
+    atomic σ e' κ σ' efs :
+      prim_step e σ κ e' σ' efs →
+      if a is WeaklyAtomic then irreducible e' σ' else is_Some (to_val e').
+
+  Inductive step (ρ1 : cfg Λ) (κ : list (observation Λ)) (ρ2 : cfg Λ) : Prop :=
+    | step_atomic e1 σ1 e2 σ2 efs t1 t2 :
+       ρ1 = (t1 ++ e1 :: t2, σ1) →
+       ρ2 = (t1 ++ e2 :: t2 ++ efs, σ2) →
+       prim_step e1 σ1 κ e2 σ2 efs →
+       step ρ1 κ ρ2.
+  Local Hint Constructors step : core.
+
+  Inductive nsteps : nat → cfg Λ → list (observation Λ) → cfg Λ → Prop :=
+    | nsteps_refl ρ :
+       nsteps 0 ρ [] ρ
+    | nsteps_l n ρ1 ρ2 ρ3 κ κs :
+       step ρ1 κ ρ2 →
+       nsteps n ρ2 κs ρ3 →
+       nsteps (S n) ρ1 (κ ++ κs) ρ3.
+  Local Hint Constructors nsteps : core.
+
+  Definition erased_step (ρ1 ρ2 : cfg Λ) := ∃ κ, step ρ1 κ ρ2.
+
+  (** [rtc erased_step] and [nsteps] encode the same thing, just packaged
+      in a different way. *)
+  Lemma erased_steps_nsteps ρ1 ρ2 :
+    rtc erased_step ρ1 ρ2 ↔ ∃ n κs, nsteps n ρ1 κs ρ2.
+  Proof.
+    split.
+    - induction 1; firstorder eauto. (* FIXME: [naive_solver eauto] should be able to handle this *)
+    - intros (n & κs & Hsteps). unfold erased_step.
+      induction Hsteps; eauto using rtc_refl, rtc_l.
+  Qed.
+
+  Lemma of_to_val_flip v e : of_val v = e → to_val e = Some v.
+  Proof. intros <-. by rewrite to_of_val. Qed.
+
+  Lemma not_reducible e σ : ¬reducible e σ ↔ irreducible e σ.
+  Proof. unfold reducible, irreducible. naive_solver. Qed.
+  Lemma reducible_not_val e σ : reducible e σ → to_val e = None.
+  Proof. intros (?&?&?&?&?); eauto using val_stuck. Qed.
+  Lemma reducible_no_obs_reducible e σ : reducible_no_obs e σ → reducible e σ.
+  Proof. intros (?&?&?&?); eexists; eauto. Qed.
+  Lemma val_irreducible e σ : is_Some (to_val e) → irreducible e σ.
+  Proof. intros [??] ???? ?%val_stuck. by destruct (to_val e). Qed.
+  Global Instance of_val_inj : Inj (=) (=) (@of_val Λ).
+  Proof. by intros v v' Hv; apply (inj Some); rewrite -!to_of_val Hv. Qed.
+  Lemma not_not_stuck e σ : ¬not_stuck e σ ↔ stuck e σ.
+  Proof.
+    rewrite /stuck /not_stuck -not_eq_None_Some -not_reducible.
+    destruct (decide (to_val e = None)); naive_solver.
+  Qed.
+
+  Lemma strongly_atomic_atomic e a :
+    Atomic StronglyAtomic e → Atomic a e.
+  Proof. unfold Atomic. destruct a; eauto using val_irreducible. Qed.
+
+  Lemma reducible_fill `{!@LanguageCtx Λ K} e σ :
+    reducible e σ → reducible (K e) σ.
+  Proof. unfold reducible in *. naive_solver eauto using fill_step. Qed.
+  Lemma reducible_fill_inv `{!@LanguageCtx Λ K} e σ :
+    to_val e = None → reducible (K e) σ → reducible e σ.
+  Proof.
+    intros ? (e'&σ'&k&efs&Hstep); unfold reducible.
+    apply fill_step_inv in Hstep as (e2' & _ & Hstep); eauto.
+  Qed.
+  Lemma reducible_no_obs_fill `{!@LanguageCtx Λ K} e σ :
+    reducible_no_obs e σ → reducible_no_obs (K e) σ.
+  Proof. unfold reducible_no_obs in *. naive_solver eauto using fill_step. Qed.
+  Lemma reducible_no_obs_fill_inv `{!@LanguageCtx Λ K} e σ :
+    to_val e = None → reducible_no_obs (K e) σ → reducible_no_obs e σ.
+  Proof.
+    intros ? (e'&σ'&efs&Hstep); unfold reducible_no_obs.
+    apply fill_step_inv in Hstep as (e2' & _ & Hstep); eauto.
+  Qed.
+  Lemma irreducible_fill `{!@LanguageCtx Λ K} e σ :
+    to_val e = None → irreducible e σ → irreducible (K e) σ.
+  Proof. rewrite -!not_reducible. naive_solver eauto using reducible_fill_inv. Qed.
+  Lemma irreducible_fill_inv `{!@LanguageCtx Λ K} e σ :
+    irreducible (K e) σ → irreducible e σ.
+  Proof. rewrite -!not_reducible. naive_solver eauto using reducible_fill. Qed.
+
+  Lemma not_stuck_fill_inv K `{!@LanguageCtx Λ K} e σ :
+    not_stuck (K e) σ → not_stuck e σ.
+  Proof.
+    rewrite /not_stuck -!not_eq_None_Some. intros [?|?].
+    - auto using fill_not_val.
+    - destruct (decide (to_val e = None)); eauto using reducible_fill_inv.
+  Qed.
+
+  Lemma stuck_fill `{!@LanguageCtx Λ K} e σ :
+    stuck e σ → stuck (K e) σ.
+  Proof. rewrite -!not_not_stuck. eauto using not_stuck_fill_inv. Qed.
+
+  Lemma step_Permutation (t1 t1' t2 : list (expr Λ)) κ σ1 σ2 :
+    t1 ≡ₚ t1' → step (t1,σ1) κ (t2,σ2) → ∃ t2', t2 ≡ₚ t2' ∧ step (t1',σ1) κ (t2',σ2).
+  Proof.
+    intros Ht [e1 σ1' e2 σ2' efs tl tr ?? Hstep]; simplify_eq/=.
+    move: Ht; rewrite -Permutation_middle (symmetry_iff (≡ₚ)).
+    intros (tl'&tr'&->&Ht)%Permutation_cons_inv_r.
+    exists (tl' ++ e2 :: tr' ++ efs); split; [|by econstructor].
+    by rewrite -!Permutation_middle !assoc_L Ht.
+  Qed.
+
+  Lemma step_insert i t2 σ2 e κ e' σ3 efs :
+    t2 !! i = Some e →
+    prim_step e σ2 κ e' σ3 efs →
+    step (t2, σ2) κ (<[i:=e']>t2 ++ efs, σ3).
+  Proof.
+    intros.
+    edestruct (elem_of_list_split_length t2) as (t21&t22&?&?);
+      first (by eauto using elem_of_list_lookup_2); simplify_eq.
+    econstructor; eauto.
+    by rewrite insert_app_r_alt // Nat.sub_diag /= -assoc_L.
+  Qed.
+
+  Lemma erased_step_Permutation (t1 t1' t2 : list (expr Λ)) σ1 σ2 :
+    t1 ≡ₚ t1' → erased_step (t1,σ1) (t2,σ2) → ∃ t2', t2 ≡ₚ t2' ∧ erased_step (t1',σ1) (t2',σ2).
+  Proof.
+    intros Heq [? Hs]. pose proof (step_Permutation _ _ _ _ _ _ Heq Hs). firstorder.
+     (* FIXME: [naive_solver] should be able to handle this *)
+  Qed.
+
+  Record pure_step (e1 e2 : expr Λ) := {
+    pure_step_safe σ1 : reducible_no_obs e1 σ1;
+    pure_step_det σ1 κ e2' σ2 efs :
+      prim_step e1 σ1 κ e2' σ2 efs → κ = [] ∧ σ2 = σ1 ∧ e2' = e2 ∧ efs = []
+  }.
+
+  Notation pure_steps_tp := (Forall2 (rtc pure_step)).
+
+  (* TODO: Exclude the case of [n=0], either here, or in [wp_pure] to avoid it
+  succeeding when it did not actually do anything. *)
+  Class PureExec (φ : Prop) (n : nat) (e1 e2 : expr Λ) :=
+    pure_exec : φ → relations.nsteps pure_step n e1 e2.
+
+  Lemma pure_step_ctx K `{!@LanguageCtx Λ K} e1 e2 :
+    pure_step e1 e2 →
+    pure_step (K e1) (K e2).
+  Proof.
+    intros [Hred Hstep]. split.
+    - unfold reducible_no_obs in *. naive_solver eauto using fill_step.
+    - intros σ1 κ e2' σ2 efs Hpstep.
+      destruct (fill_step_inv e1 σ1 κ e2' σ2 efs) as (e2'' & -> & ?); [|exact Hpstep|].
+      + destruct (Hred σ1) as (? & ? & ? & ?); eauto using val_stuck.
+      + edestruct (Hstep σ1 κ e2'' σ2 efs) as (? & -> & -> & ->); auto.
+  Qed.
+
+  Lemma pure_step_nsteps_ctx K `{!@LanguageCtx Λ K} n e1 e2 :
+    relations.nsteps pure_step n e1 e2 →
+    relations.nsteps pure_step n (K e1) (K e2).
+  Proof. eauto using nsteps_congruence, pure_step_ctx. Qed.
+
+  Lemma rtc_pure_step_ctx K `{!@LanguageCtx Λ K} e1 e2 :
+    rtc pure_step e1 e2 → rtc pure_step (K e1) (K e2).
+  Proof. eauto using rtc_congruence, pure_step_ctx. Qed.
+
+  (* We do not make this an instance because it is awfully general. *)
+  Lemma pure_exec_ctx K `{!@LanguageCtx Λ K} φ n e1 e2 :
+    PureExec φ n e1 e2 →
+    PureExec φ n (K e1) (K e2).
+  Proof. rewrite /PureExec; eauto using pure_step_nsteps_ctx. Qed.
+
+  (* This is a family of frequent assumptions for PureExec *)
+  Class IntoVal (e : expr Λ) (v : val Λ) :=
+    into_val : of_val v = e.
+
+  Class AsVal (e : expr Λ) := as_val : ∃ v, of_val v = e.
+  (* There is no instance [IntoVal → AsVal] as often one can solve [AsVal] more
+  efficiently since no witness has to be computed. *)
+  Global Instance as_vals_of_val vs : TCForall AsVal (of_val <$> vs).
+  Proof.
+    apply TCForall_Forall, Forall_fmap, Forall_true=> v.
+    rewrite /AsVal /=; eauto.
+  Qed.
+
+  Lemma as_val_is_Some e :
+    (∃ v, of_val v = e) → is_Some (to_val e).
+  Proof. intros [v <-]. rewrite to_of_val. eauto. Qed.
+
+  Lemma prim_step_not_stuck e σ κ e' σ' efs :
+    prim_step e σ κ e' σ' efs → not_stuck e σ.
+  Proof. rewrite /not_stuck /reducible. eauto 10. Qed.
+
+  Lemma rtc_pure_step_val `{!Inhabited (state Λ)} v e :
+    rtc pure_step (of_val v) e → to_val e = Some v.
+  Proof.
+    intros ?; rewrite <- to_of_val.
+    f_equal; symmetry; eapply rtc_nf; first done.
+    intros [e' [Hstep _]].
+    destruct (Hstep inhabitant) as (?&?&?&Hval%val_stuck).
+    by rewrite to_of_val in Hval.
+  Qed.
+
+  (** Let thread pools [t1] and [t3] be such that each thread in [t1] makes
+   (zero or more) pure steps to the corresponding thread in [t3]. Furthermore,
+   let [t2] be a thread pool such that [t1] under state [σ1] makes a (single)
+   step to thread pool [t2] and state [σ2]. In this situation, either the step
+   from [t1] to [t2] corresponds to one of the pure steps between [t1] and [t3],
+   or, there is an [i] such that [i]th thread does not participate in the
+   pure steps between [t1] and [t3] and [t2] corresponds to taking a step in
+   the [i]th thread starting from [t1]. *)
+  Lemma erased_step_pure_step_tp t1 σ1 t2 σ2 t3 :
+    erased_step (t1, σ1) (t2, σ2) →
+    pure_steps_tp t1 t3 →
+    (σ1 = σ2 ∧ pure_steps_tp t2 t3) ∨
+    (∃ i e efs e' κ,
+      t1 !! i = Some e ∧ t3 !! i = Some e ∧
+      t2 = <[i:=e']>t1 ++ efs ∧
+      prim_step e σ1 κ e' σ2 efs).
+  Proof.
+    intros [κ [e σ e' σ' efs t11 t12 ?? Hstep]] Hps; simplify_eq/=.
+    apply Forall2_app_inv_l in Hps
+      as (t31&?&Hpsteps&(e''&t32&Hps&?&->)%Forall2_cons_inv_l&->).
+    destruct Hps as [e|e1 e2 e3 [_ Hprs]].
+    - right.
+      exists (length t11), e, efs, e', κ; split_and!; last done.
+      + by rewrite lookup_app_r // Nat.sub_diag.
+      + apply Forall2_length in Hpsteps.
+        by rewrite lookup_app_r Hpsteps // Nat.sub_diag.
+      + by rewrite insert_app_r_alt // Nat.sub_diag /= -assoc_L.
+    - edestruct Hprs as (?&?&?&?); first done; simplify_eq.
+      left; split; first done.
+      rewrite right_id_L.
+      eauto using Forall2_app.
+  Qed.
+
+End language.
+
+Global Hint Mode PureExec + - - ! - : typeclass_instances.
+
+Global Arguments step_atomic {Λ ρ1 κ ρ2}.
+
+Notation pure_steps_tp := (Forall2 (rtc pure_step)).

iris/program_logic/lifting.v

+(** The "lifting lemmas" in this file serve to lift the rules of the operational
+semantics to the program logic. *)
+
+From iris.proofmode Require Import proofmode.
+From iris.program_logic Require Export weakestpre.
+From iris.prelude Require Import options.
+
+Section lifting.
+Context `{!irisGS_gen hlc Λ Σ}.
+Implicit Types s : stuckness.
+Implicit Types v : val Λ.
+Implicit Types e : expr Λ.
+Implicit Types σ : state Λ.
+Implicit Types P Q : iProp Σ.
+Implicit Types Φ : val Λ → iProp Σ.
+
+Local Hint Resolve reducible_no_obs_reducible : core.
+
+Lemma wp_lift_step_fupdN s E Φ e1 :
+  to_val e1 = None →
+  (∀ σ1 ns κ κs nt, state_interp σ1 ns (κ ++ κs) nt ={E,∅}=∗
+    ⌜if s is NotStuck then reducible e1 σ1 else True⌝ ∗
+    ∀ e2 σ2 efs, ⌜prim_step e1 σ1 κ e2 σ2 efs⌝ -∗
+      £ (S $ num_laters_per_step ns)
+      ={∅}▷=∗^(S $ num_laters_per_step ns) |={∅,E}=>
+      state_interp σ2 (S ns) κs (length efs + nt) ∗
+      WP e2 @ s; E {{ Φ }} ∗
+      [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ fork_post }})
+  ⊢ WP e1 @ s; E {{ Φ }}.
+Proof. by rewrite wp_unfold /wp_pre=>->. Qed.
+
+Lemma wp_lift_step_fupd s E Φ e1 :
+  to_val e1 = None →
+  (∀ σ1 ns κ κs nt, state_interp σ1 ns (κ ++ κs) nt ={E,∅}=∗
+    ⌜if s is NotStuck then reducible e1 σ1 else True⌝ ∗
+    ∀ e2 σ2 efs, ⌜prim_step e1 σ1 κ e2 σ2 efs⌝ -∗ £ 1 ={∅}=∗ ▷ |={∅,E}=>
+      state_interp σ2 (S ns) κs (length efs + nt) ∗
+      WP e2 @ s; E {{ Φ }} ∗
+      [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ fork_post }})
+  ⊢ WP e1 @ s; E {{ Φ }}.
+Proof.
+  iIntros (?) "Hwp". rewrite -wp_lift_step_fupdN; [|done].
+  iIntros (?????) "Hσ". iMod ("Hwp" with "Hσ") as "($ & Hwp)".
+  iIntros "!>" (??? ?) "Hcred".
+  iPoseProof (lc_weaken 1 with "Hcred") as "Hcred"; first lia.
+  simpl. rewrite -step_fupdN_intro; [|done]. rewrite -bi.laterN_intro.
+  iMod ("Hwp" with "[//] Hcred") as "Hwp".
+  iApply step_fupd_intro; done.
+Qed.
+
+Lemma wp_lift_stuck E Φ e :
+  to_val e = None →
+  (∀ σ ns κs nt, state_interp σ ns κs nt ={E,∅}=∗ ⌜stuck e σ⌝)
+  ⊢ WP e @ E ?{{ Φ }}.
+Proof.
+  rewrite wp_unfold /wp_pre=>->. iIntros "H" (σ1 ns κ κs nt) "Hσ".
+  iMod ("H" with "Hσ") as %[? Hirr]. iModIntro. iSplit; first done.
+  iIntros (e2 σ2 efs ?). by case: (Hirr κ e2 σ2 efs).
+Qed.
+
+(** Derived lifting lemmas. *)
+Lemma wp_lift_step s E Φ e1 :
+  to_val e1 = None →
+  (∀ σ1 ns κ κs nt, state_interp σ1 ns (κ ++ κs) nt ={E,∅}=∗
+    ⌜if s is NotStuck then reducible e1 σ1 else True⌝ ∗
+    ▷ ∀ e2 σ2 efs, ⌜prim_step e1 σ1 κ e2 σ2 efs⌝ -∗ £ 1 ={∅,E}=∗
+      state_interp σ2 (S ns) κs (length efs + nt) ∗
+      WP e2 @ s; E {{ Φ }} ∗
+      [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ fork_post }})
+  ⊢ WP e1 @ s; E {{ Φ }}.
+Proof.
+  iIntros (?) "H". iApply wp_lift_step_fupd; [done|]. iIntros (?????) "Hσ".
+  iMod ("H" with "Hσ") as "[$ H]". iIntros "!> * % Hcred !> !>". by iApply "H".
+Qed.
+
+Lemma wp_lift_pure_step_no_fork `{!Inhabited (state Λ)} s E E' Φ e1 :
+  (∀ σ1, if s is NotStuck then reducible e1 σ1 else to_val e1 = None) →
+  (∀ κ σ1 e2 σ2 efs, prim_step e1 σ1 κ e2 σ2 efs → κ = [] ∧ σ2 = σ1 ∧ efs = []) →
+  (|={E}[E']▷=> ∀ κ e2 efs σ, ⌜prim_step e1 σ κ e2 σ efs⌝ -∗ £ 1 -∗ WP e2 @ s; E {{ Φ }})
+  ⊢ WP e1 @ s; E {{ Φ }}.
+Proof.
+  iIntros (Hsafe Hstep) "H". iApply wp_lift_step.
+  { specialize (Hsafe inhabitant). destruct s; eauto using reducible_not_val. }
+  iIntros (σ1 ns κ κs nt) "Hσ". iMod "H".
+  iApply fupd_mask_intro; first set_solver. iIntros "Hclose". iSplit.
+  { iPureIntro. destruct s; done. }
+  iNext. iIntros (e2 σ2 efs ?) "Hcred".
+  destruct (Hstep κ σ1 e2 σ2 efs) as (-> & <- & ->); auto.
+  iMod (state_interp_mono with "Hσ") as "$".
+  iMod "Hclose" as "_". iMod "H". iModIntro.
+  by iDestruct ("H" with "[//] Hcred") as "$".
+Qed.
+
+Lemma wp_lift_pure_stuck `{!Inhabited (state Λ)} E Φ e :
+  (∀ σ, stuck e σ) →
+  True ⊢ WP e @ E ?{{ Φ }}.
+Proof.
+  iIntros (Hstuck) "_". iApply wp_lift_stuck.
+  - destruct(to_val e) as [v|] eqn:He; last done.
+    rewrite -He. by case: (Hstuck inhabitant).
+  - iIntros (σ ns κs nt) "_". iApply fupd_mask_intro; auto with set_solver.
+Qed.
+
+(* Atomic steps don't need any mask-changing business here, one can
+   use the generic lemmas here. *)
+Lemma wp_lift_atomic_step_fupd {s E1 E2 Φ} e1 :
+  to_val e1 = None →
+  (∀ σ1 ns κ κs nt, state_interp σ1 ns (κ ++ κs) nt ={E1}=∗
+    ⌜if s is NotStuck then reducible e1 σ1 else True⌝ ∗
+    ∀ e2 σ2 efs, ⌜prim_step e1 σ1 κ e2 σ2 efs⌝ -∗ £ 1 ={E1}[E2]▷=∗
+      state_interp σ2 (S ns) κs (length efs + nt) ∗
+      from_option Φ False (to_val e2) ∗
+      [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ fork_post }})
+  ⊢ WP e1 @ s; E1 {{ Φ }}.
+Proof.
+  iIntros (?) "H".
+  iApply (wp_lift_step_fupd s E1 _ e1)=>//; iIntros (σ1 ns κ κs nt) "Hσ1".
+  iMod ("H" $! σ1 with "Hσ1") as "[$ H]".
+  iApply fupd_mask_intro; first set_solver.
+  iIntros "Hclose" (e2 σ2 efs ?) "Hcred". iMod "Hclose" as "_".
+  iMod ("H" $! e2 σ2 efs with "[#] Hcred") as "H"; [done|].
+  iApply fupd_mask_intro; first set_solver. iIntros "Hclose !>".
+  iMod "Hclose" as "_". iMod "H" as "($ & HQ & $)".
+  destruct (to_val e2) eqn:?; last by iExFalso.
+  iApply wp_value; last done. by apply of_to_val.
+Qed.
+
+Lemma wp_lift_atomic_step {s E Φ} e1 :
+  to_val e1 = None →
+  (∀ σ1 ns κ κs nt, state_interp σ1 ns (κ ++ κs) nt ={E}=∗
+    ⌜if s is NotStuck then reducible e1 σ1 else True⌝ ∗
+    ▷ ∀ e2 σ2 efs, ⌜prim_step e1 σ1 κ e2 σ2 efs⌝ -∗ £ 1 ={E}=∗
+      state_interp σ2 (S ns) κs (length efs + nt) ∗
+      from_option Φ False (to_val e2) ∗
+      [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ fork_post }})
+  ⊢ WP e1 @ s; E {{ Φ }}.
+Proof.
+  iIntros (?) "H". iApply wp_lift_atomic_step_fupd; [done|].
+  iIntros (?????) "?". iMod ("H" with "[$]") as "[$ H]".
+  iIntros "!> *". iIntros (Hstep) "Hcred !> !>".
+  by iApply "H".
+Qed.
+
+Lemma wp_lift_pure_det_step_no_fork `{!Inhabited (state Λ)} {s E E' Φ} e1 e2 :
+  (∀ σ1, if s is NotStuck then reducible e1 σ1 else to_val e1 = None) →
+  (∀ σ1 κ e2' σ2 efs', prim_step e1 σ1 κ e2' σ2 efs' →
+    κ = [] ∧ σ2 = σ1 ∧ e2' = e2 ∧ efs' = []) →
+  (|={E}[E']▷=> £ 1 -∗ WP e2 @ s; E {{ Φ }}) ⊢ WP e1 @ s; E {{ Φ }}.
+Proof.
+  iIntros (? Hpuredet) "H". iApply (wp_lift_pure_step_no_fork s E E'); try done.
+  { naive_solver. }
+  iApply (step_fupd_wand with "H"); iIntros "H".
+  iIntros (κ e' efs' σ (_&?&->&?)%Hpuredet); auto.
+Qed.
+
+Lemma wp_pure_step_fupd `{!Inhabited (state Λ)} s E E' e1 e2 φ n Φ :
+  PureExec φ n e1 e2 →
+  φ →
+  (|={E}[E']▷=>^n £ n -∗ WP e2 @ s; E {{ Φ }}) ⊢ WP e1 @ s; E {{ Φ }}.
+Proof.
+  iIntros (Hexec Hφ) "Hwp". specialize (Hexec Hφ).
+  iInduction Hexec as [e|n e1 e2 e3 [Hsafe ?] ? IH]; simpl.
+  { iMod lc_zero as "Hz". by iApply "Hwp". }
+  iApply wp_lift_pure_det_step_no_fork.
+  - intros σ. specialize (Hsafe σ). destruct s; eauto using reducible_not_val.
+  - done.
+  - iApply (step_fupd_wand with "Hwp").
+    iIntros "Hwp Hone". iApply "IH".
+    iApply (step_fupdN_wand with "Hwp").
+    iIntros "Hwp Hc". iApply ("Hwp" with "[Hone Hc]").
+    rewrite (lc_succ n). iFrame.
+Qed.
+
+Lemma wp_pure_step_later `{!Inhabited (state Λ)} s E e1 e2 φ n Φ :
+  PureExec φ n e1 e2 →
+  φ →
+  ▷^n (£ n -∗ WP e2 @ s; E {{ Φ }}) ⊢ WP e1 @ s; E {{ Φ }}.
+Proof.
+  intros Hexec ?. rewrite -wp_pure_step_fupd //. clear Hexec.
+  enough (∀ P, ▷^n P ⊢ |={E}▷=>^n P) as Hwp by apply Hwp. intros ?.
+  induction n as [|n IH]; by rewrite //= -step_fupd_intro // IH.
+Qed.
+End lifting.

iris/program_logic/ownp.v

+From iris.algebra Require Import lib.excl_auth.
+From iris.proofmode Require Import proofmode classes.
+From iris.program_logic Require Export weakestpre.
+From iris.program_logic Require Import lifting adequacy.
+From iris.program_logic Require ectx_language.
+From iris.prelude Require Import options.
+
+(**
+This module provides an interface to handling ownership of the global state that
+works more like Iris 2.0 did.  The state interpretation (in WP) is fixed to be
+authoritative ownership of the entire state (using the [excl] RA).  Users can
+then put the corresponding fragment into an invariant on their own to establish
+a more interesting notion of ownership, such as the standard heap with disjoint
+union.
+*)
+
+Class ownPGS (Λ : language) (Σ : gFunctors) := OwnPGS {
+  ownP_invG : invGS Σ;
+  #[local] ownP_inG :: inG Σ (excl_authR (stateO Λ));
+  ownP_name : gname;
+}.
+
+Global Instance ownPG_irisGS `{!ownPGS Λ Σ} : irisGS Λ Σ := {
+  iris_invGS := ownP_invG;
+  state_interp σ _ κs _ := own ownP_name (●E σ)%I;
+  fork_post _ := True%I;
+  num_laters_per_step _ := 0;
+  state_interp_mono _ _ _ _ := fupd_intro _ _
+}.
+Global Opaque iris_invGS.
+
+Definition ownPΣ (Λ : language) : gFunctors :=
+  #[invΣ;
+    GFunctor (excl_authR (stateO Λ))].
+
+Class ownPGpreS (Λ : language) (Σ : gFunctors) : Set := {
+  #[global] ownPPre_invG :: invGpreS Σ;
+  #[local] ownPPre_state_inG :: inG Σ (excl_authR (stateO Λ))
+}.
+
+Global Instance subG_ownPΣ {Λ Σ} : subG (ownPΣ Λ) Σ → ownPGpreS Λ Σ.
+Proof. solve_inG. Qed.
+
+(** Ownership *)
+Definition ownP `{!ownPGS Λ Σ} (σ : state Λ) : iProp Σ :=
+  own ownP_name (◯E σ).
+Global Typeclasses Opaque ownP.
+Global Instance: Params (@ownP) 3 := {}.
+
+(* Adequacy *)
+Theorem ownP_adequacy Σ `{!ownPGpreS Λ Σ} s e σ φ :
+  (∀ `{!ownPGS Λ Σ}, ownP σ ⊢ WP e @ s; ⊤ {{ v, ⌜φ v⌝ }}) →
+  adequate s e σ (λ v _, φ v).
+Proof.
+  intros Hwp. apply (wp_adequacy Σ _).
+  iIntros (? κs).
+  iMod (own_alloc (●E σ ⋅ ◯E σ)) as (γσ) "[Hσ Hσf]";
+    first by apply excl_auth_valid.
+  iModIntro. iExists (λ σ κs, own γσ (●E σ))%I, (λ _, True%I).
+  iFrame "Hσ".
+  iApply (Hwp (OwnPGS _ _ _ _ γσ)). rewrite /ownP. iFrame.
+Qed.
+
+Theorem ownP_invariance Σ `{!ownPGpreS Λ Σ} s e σ1 t2 σ2 φ :
+  (∀ `{!ownPGS Λ Σ},
+      ownP σ1 ={⊤}=∗ WP e @ s; ⊤ {{ _, True }} ∗
+      |={⊤,∅}=> ∃ σ', ownP σ' ∧ ⌜φ σ'⌝) →
+  rtc erased_step ([e], σ1) (t2, σ2) →
+  φ σ2.
+Proof.
+  intros Hwp Hsteps. eapply (wp_invariance Σ Λ s e σ1 t2 σ2 _)=> //.
+  iIntros (? κs).
+  iMod (own_alloc (●E σ1 ⋅ ◯E σ1)) as (γσ) "[Hσ Hσf]";
+    first by apply auth_both_valid_discrete.
+  iExists (λ σ κs' _, own γσ (●E σ))%I, (λ _, True%I).
+  iFrame "Hσ".
+  iMod (Hwp (OwnPGS _ _ _ _ γσ) with "[Hσf]") as "[$ H]";
+    first by rewrite /ownP; iFrame.
+  iIntros "!> Hσ". iExists ∅. iMod "H" as (σ2') "[Hσf %]". rewrite /ownP.
+  iCombine "Hσ Hσf"
+    gives %[Hp%Excl_included _]%auth_both_valid_discrete; simplify_eq; auto.
+Qed.
+
+
+(** Lifting *)
+(** All lifting lemmas defined here discard later credits.*)
+Section lifting.
+  Context `{!ownPGS Λ Σ}.
+  Implicit Types s : stuckness.
+  Implicit Types e : expr Λ.
+  Implicit Types Φ : val Λ → iProp Σ.
+
+  Lemma ownP_eq σ1 ns σ2 κs nt :
+    state_interp σ1 ns κs nt -∗ ownP σ2 -∗ ⌜σ1 = σ2⌝.
+  Proof.
+    iIntros "Hσ● Hσ◯". rewrite /ownP.
+    by iCombine "Hσ● Hσ◯"
+      gives %[->%Excl_included _]%auth_both_valid_discrete.
+  Qed.
+  Lemma ownP_state_twice σ1 σ2 : ownP σ1 ∗ ownP σ2 ⊢ False.
+  Proof.
+    rewrite /ownP -own_op own_valid. by iIntros (?%excl_auth_frag_op_valid).
+  Qed.
+  Global Instance ownP_timeless σ : Timeless (@ownP Λ Σ _ σ).
+  Proof. rewrite /ownP; apply _. Qed.
+
+  Lemma ownP_lift_step s E Φ e1 :
+    (|={E,∅}=> ∃ σ1, ⌜if s is NotStuck then reducible e1 σ1 else to_val e1 = None⌝ ∗
+      ▷ ownP σ1 ∗
+      ▷ ∀ κ e2 σ2 efs, ⌜prim_step e1 σ1 κ e2 σ2 efs⌝ -∗
+      ownP σ2
+            ={∅,E}=∗ WP e2 @ s; E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }})
+    ⊢ WP e1 @ s; E {{ Φ }}.
+  Proof.
+    iIntros "H". destruct (to_val e1) as [v|] eqn:EQe1.
+    - apply of_to_val in EQe1 as <-. iApply fupd_wp.
+      iMod "H" as (σ1) "[Hred _]"; iDestruct "Hred" as %Hred.
+      destruct s; last done. apply reducible_not_val in Hred.
+      move: Hred; by rewrite to_of_val.
+    - iApply wp_lift_step; [done|]; iIntros (σ1 ns κ κs nt) "Hσκs".
+      iMod "H" as (σ1' ?) "[>Hσf H]".
+      iDestruct (ownP_eq with "Hσκs Hσf") as %<-.
+      iModIntro; iSplit; [by destruct s|]; iNext; iIntros (e2 σ2 efs Hstep) "Hcred".
+      iDestruct "Hσκs" as "Hσ". rewrite /ownP.
+      iMod (own_update_2 with "Hσ Hσf") as "[Hσ Hσf]".
+      { apply excl_auth_update. }
+      iFrame "Hσ". iApply ("H" with "[]"); eauto with iFrame.
+  Qed.
+
+  Lemma ownP_lift_stuck E Φ e :
+    (|={E,∅}=> ∃ σ, ⌜stuck e σ⌝ ∗ ▷ (ownP σ))
+    ⊢ WP e @ E ?{{ Φ }}.
+  Proof.
+    iIntros "H". destruct (to_val e) as [v|] eqn:EQe.
+    - apply of_to_val in EQe as <-. iApply fupd_wp.
+      iMod "H" as (σ1) "[H _]". iDestruct "H" as %[Hnv _]. exfalso.
+      by rewrite to_of_val in Hnv.
+    - iApply wp_lift_stuck; [done|]. iIntros (σ1 ns κs nt) "Hσ".
+      iMod "H" as (σ1') "(% & >Hσf)".
+      by iDestruct (ownP_eq with "Hσ Hσf") as %->.
+  Qed.
+
+  Lemma ownP_lift_pure_step `{!Inhabited (state Λ)} s E Φ e1 :
+    (∀ σ1, if s is NotStuck then reducible e1 σ1 else to_val e1 = None) →
+    (∀ σ1 κ e2 σ2 efs, prim_step e1 σ1 κ e2 σ2 efs → κ = [] ∧ σ2 = σ1) →
+    (▷ ∀ κ e2 efs σ, ⌜prim_step e1 σ κ e2 σ efs⌝ →
+      WP e2 @ s; E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }})
+    ⊢ WP e1 @ s; E {{ Φ }}.
+  Proof.
+    iIntros (Hsafe Hstep) "H"; iApply wp_lift_step.
+    { specialize (Hsafe inhabitant). destruct s; last done.
+      by eapply reducible_not_val. }
+    iIntros (σ1 ns κ κs nt) "Hσ". iApply fupd_mask_intro; first set_solver.
+    iIntros "Hclose". iSplit; [by destruct s|]; iNext; iIntros (e2 σ2 efs ?) "Hcred".
+    destruct (Hstep σ1 κ e2 σ2 efs); auto; subst.
+    by iMod "Hclose"; iModIntro; iFrame; iApply "H".
+  Qed.
+
+  (** Derived lifting lemmas. *)
+  Lemma ownP_lift_atomic_step {s E Φ} e1 σ1 :
+    (if s is NotStuck then reducible e1 σ1 else to_val e1 = None) →
+    (▷ (ownP σ1) ∗
+       ▷ ∀ κ e2 σ2 efs, ⌜prim_step e1 σ1 κ e2 σ2 efs⌝ -∗
+         ownP σ2 -∗
+      from_option Φ False (to_val e2) ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }})
+    ⊢ WP e1 @ s; E {{ Φ }}.
+  Proof.
+    iIntros (?) "[Hσ H]"; iApply ownP_lift_step.
+    iApply fupd_mask_intro; first set_solver.
+    iIntros "Hclose". iExists σ1; iFrame; iSplit; first by destruct s.
+    iNext; iIntros (κ e2 σ2 efs ?) "Hσ".
+    iDestruct ("H" $! κ e2 σ2 efs with "[] [Hσ]") as "[HΦ $]"; [by eauto..|].
+    destruct (to_val e2) eqn:?; last by iExFalso.
+    iMod "Hclose"; iApply wp_value; last done. by apply of_to_val.
+  Qed.
+
+  Lemma ownP_lift_atomic_det_step {s E Φ e1} σ1 v2 σ2 efs :
+    (if s is NotStuck then reducible e1 σ1 else to_val e1 = None) →
+    (∀ κ' e2' σ2' efs', prim_step e1 σ1 κ' e2' σ2' efs' →
+                     σ2' = σ2 ∧ to_val e2' = Some v2 ∧ efs' = efs) →
+    ▷ (ownP σ1) ∗ ▷ (ownP σ2 -∗
+      Φ v2 ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }})
+    ⊢ WP e1 @ s; E {{ Φ }}.
+  Proof.
+    iIntros (? Hdet) "[Hσ1 Hσ2]"; iApply ownP_lift_atomic_step; try done.
+    iFrame; iNext; iIntros (κ' e2' σ2' efs' ?) "Hσ2'".
+    edestruct (Hdet κ') as (<-&Hval&<-); first done. rewrite Hval.
+    iApply ("Hσ2" with "Hσ2'").
+  Qed.
+
+  Lemma ownP_lift_atomic_det_step_no_fork {s E e1} σ1 v2 σ2 :
+    (if s is NotStuck then reducible e1 σ1 else to_val e1 = None) →
+    (∀ κ' e2' σ2' efs', prim_step e1 σ1 κ' e2' σ2' efs' →
+      σ2' = σ2 ∧ to_val e2' = Some v2 ∧ efs' = []) →
+    {{{ ▷ (ownP σ1) }}} e1 @ s; E {{{ RET v2; ownP σ2 }}}.
+  Proof.
+    intros. rewrite -(ownP_lift_atomic_det_step σ1 v2 σ2 []); [|done..].
+    rewrite big_sepL_nil right_id. iIntros "Hs Hs'".
+    iSplitL "Hs"; first by iFrame. iModIntro. iIntros "Hσ2". iApply "Hs'". iFrame.
+  Qed.
+
+  Lemma ownP_lift_pure_det_step_no_fork `{!Inhabited (state Λ)} {s E Φ} e1 e2 :
+    (∀ σ1, if s is NotStuck then reducible e1 σ1 else to_val e1 = None) →
+    (∀ σ1 κ e2' σ2 efs', prim_step e1 σ1 κ e2' σ2 efs' → κ = [] ∧ σ2 = σ1 ∧ e2' = e2 ∧ efs' = []) →
+    ▷ WP e2 @ s; E {{ Φ }} ⊢ WP e1 @ s; E {{ Φ }}.
+  Proof.
+    intros. rewrite -(wp_lift_pure_det_step_no_fork e1 e2) //.
+    iIntros "Hwp". iApply step_fupd_intro; first done. iNext. by iIntros "_".
+  Qed.
+End lifting.
+
+Section ectx_lifting.
+  Import ectx_language.
+  Context {Λ : ectxLanguage} `{!ownPGS Λ Σ} {Hinh : Inhabited (state Λ)}.
+  Implicit Types s : stuckness.
+  Implicit Types Φ : val Λ → iProp Σ.
+  Implicit Types e : expr Λ.
+  Local Hint Resolve base_prim_reducible base_reducible_prim_step : core.
+  Local Definition reducible_not_val_inhabitant e := reducible_not_val e inhabitant.
+  Local Hint Resolve reducible_not_val_inhabitant : core.
+  Local Hint Resolve base_stuck_stuck : core.
+
+  Lemma ownP_lift_base_step s E Φ e1 :
+    (|={E,∅}=> ∃ σ1, ⌜base_reducible e1 σ1⌝ ∗ ▷ (ownP σ1) ∗
+            ▷ ∀ κ e2 σ2 efs, ⌜base_step e1 σ1 κ e2 σ2 efs⌝ -∗
+            ownP σ2
+            ={∅,E}=∗ WP e2 @ s; E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }})
+    ⊢ WP e1 @ s; E {{ Φ }}.
+  Proof.
+    iIntros "H". iApply ownP_lift_step.
+    iMod "H" as (σ1 ?) "[>Hσ1 Hwp]". iModIntro. iExists σ1. iSplit.
+    { destruct s; try by eauto using reducible_not_val. }
+    iFrame. iNext. iIntros (κ e2 σ2 efs ?) "Hσ2".
+    iApply ("Hwp" with "[] Hσ2"); eauto.
+  Qed.
+
+  Lemma ownP_lift_base_stuck E Φ e :
+    sub_redexes_are_values e →
+    (|={E,∅}=> ∃ σ, ⌜base_stuck e σ⌝ ∗ ▷ (ownP σ))
+    ⊢ WP e @ E ?{{ Φ }}.
+  Proof.
+    iIntros (?) "H". iApply ownP_lift_stuck. iMod "H" as (σ) "[% >Hσ]".
+    iExists σ. iModIntro. by auto with iFrame.
+  Qed.
+
+  Lemma ownP_lift_pure_base_step s E Φ e1 :
+    (∀ σ1, base_reducible e1 σ1) →
+    (∀ σ1 κ e2 σ2 efs, base_step e1 σ1 κ e2 σ2 efs → κ = [] ∧ σ2 = σ1) →
+    (▷ ∀ κ e2 efs σ, ⌜base_step e1 σ κ e2 σ efs⌝ →
+      WP e2 @ s; E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }})
+    ⊢ WP e1 @ s; E {{ Φ }}.
+  Proof using Hinh.
+    iIntros (??) "H".  iApply ownP_lift_pure_step; eauto.
+    { by destruct s; auto. }
+    iNext. iIntros (?????). iApply "H"; eauto.
+  Qed.
+
+  Lemma ownP_lift_atomic_base_step {s E Φ} e1 σ1 :
+    base_reducible e1 σ1 →
+    ▷ (ownP σ1) ∗ ▷ (∀ κ e2 σ2 efs,
+    ⌜base_step e1 σ1 κ e2 σ2 efs⌝ -∗ ownP σ2 -∗
+      from_option Φ False (to_val e2) ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }})
+    ⊢ WP e1 @ s; E {{ Φ }}.
+  Proof.
+    iIntros (?) "[Hst H]". iApply ownP_lift_atomic_step; eauto.
+    { by destruct s; eauto using reducible_not_val. }
+    iSplitL "Hst"; first done.
+    iNext. iIntros (???? ?) "Hσ". iApply ("H" with "[] Hσ"); eauto.
+  Qed.
+
+  Lemma ownP_lift_atomic_det_base_step {s E Φ e1} σ1 v2 σ2 efs :
+    base_reducible e1 σ1 →
+    (∀ κ' e2' σ2' efs', base_step e1 σ1 κ' e2' σ2' efs' →
+      σ2' = σ2 ∧ to_val e2' = Some v2 ∧ efs' = efs) →
+    ▷ (ownP σ1) ∗ ▷ (ownP σ2 -∗
+                      Φ v2 ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }})
+    ⊢ WP e1 @ s; E {{ Φ }}.
+  Proof.
+    intros Hr Hs.
+    destruct s; apply ownP_lift_atomic_det_step; eauto using reducible_not_val;
+    intros; eapply Hs; eauto 10.
+  Qed.
+
+  Lemma ownP_lift_atomic_det_base_step_no_fork {s E e1} σ1 κ v2 σ2 :
+    base_reducible e1 σ1 →
+    (∀ κ' e2' σ2' efs', base_step e1 σ1 κ' e2' σ2' efs' →
+      κ' = κ ∧ σ2' = σ2 ∧ to_val e2' = Some v2 ∧ efs' = []) →
+    {{{ ▷ (ownP σ1) }}} e1 @ s; E {{{ RET v2; ownP σ2 }}}.
+  Proof.
+    intros ???; apply ownP_lift_atomic_det_step_no_fork; last naive_solver.
+    by destruct s; eauto using reducible_not_val.
+  Qed.
+
+  Lemma ownP_lift_pure_det_base_step_no_fork {s E Φ} e1 e2 :
+    (∀ σ1, base_reducible e1 σ1) →
+    (∀ σ1 κ e2' σ2 efs', base_step e1 σ1 κ e2' σ2 efs' → κ = [] ∧ σ2 = σ1 ∧ e2' = e2 ∧ efs' = []) →
+    ▷ WP e2 @ s; E {{ Φ }} ⊢ WP e1 @ s; E {{ Φ }}.
+  Proof using Hinh.
+    iIntros (??) "H"; iApply wp_lift_pure_det_step_no_fork; try by eauto.
+    by destruct s; eauto using reducible_not_val.
+  Qed.
+End ectx_lifting.

iris/program_logic/total_adequacy.v

+From iris.algebra Require Import gmap auth agree gset coPset list.
+From iris.bi Require Import big_op fixpoint_mono.
+From iris.proofmode Require Import proofmode.
+From iris.program_logic Require Export total_weakestpre adequacy.
+From iris.prelude Require Import options.
+Import uPred.
+
+Section adequacy.
+Context `{!irisGS_gen HasNoLc Λ Σ}.
+Implicit Types e : expr Λ.
+
+Definition twptp_pre (twptp : list (expr Λ) → iProp Σ)
+    (t1 : list (expr Λ)) : iProp Σ :=
+  ∀ t2 σ1 ns κ κs σ2 nt, ⌜step (t1,σ1) κ (t2,σ2)⌝ -∗
+    state_interp σ1 ns κs nt ={⊤}=∗
+              ∃ nt', ⌜κ = []⌝ ∗ state_interp σ2 (S ns) κs nt' ∗ twptp t2.
+
+Lemma twptp_pre_mono (twptp1 twptp2 : list (expr Λ) → iProp Σ) :
+  □ (∀ t, twptp1 t -∗ twptp2 t) -∗
+  ∀ t, twptp_pre twptp1 t -∗ twptp_pre twptp2 t.
+Proof.
+  iIntros "#H"; iIntros (t) "Hwp". rewrite /twptp_pre.
+  iIntros (t2 σ1 ns κ κs σ2 nt1) "Hstep Hσ".
+  iMod ("Hwp" with "[$] [$]") as (n2) "($ & Hσ & ?)".
+  iModIntro. iExists n2. iFrame "Hσ". by iApply "H".
+Qed.
+
+Local Instance twptp_pre_mono' : BiMonoPred twptp_pre.
+Proof.
+  constructor; first (intros ????; apply twptp_pre_mono).
+  intros wp Hwp n t1 t2 ?%(discrete_iff _ _)%leibniz_equiv; solve_proper.
+Qed.
+
+Definition twptp (t : list (expr Λ)) : iProp Σ :=
+  bi_least_fixpoint twptp_pre t.
+
+Lemma twptp_unfold t : twptp t ⊣⊢ twptp_pre twptp t.
+Proof. by rewrite /twptp least_fixpoint_unfold. Qed.
+
+Lemma twptp_ind Ψ :
+  ⊢ (□ ∀ t, twptp_pre (λ t, Ψ t ∧ twptp t) t -∗ Ψ t) → ∀ t, twptp t -∗ Ψ t.
+Proof.
+  iIntros "#IH" (t) "H".
+  assert (NonExpansive Ψ).
+  { by intros n ?? ->%(discrete_iff _ _)%leibniz_equiv. }
+  iApply (least_fixpoint_ind _ Ψ with "[] H").
+  iIntros "!>" (t') "H". by iApply "IH".
+Qed.
+
+Local Instance twptp_Permutation : Proper ((≡ₚ) ==> (⊢)) twptp.
+Proof.
+  iIntros (t1 t1' Ht) "Ht1". iRevert (t1' Ht); iRevert (t1) "Ht1".
+  iApply twptp_ind; iIntros "!>" (t1) "IH"; iIntros (t1' Ht).
+  rewrite twptp_unfold /twptp_pre. iIntros (t2 σ1 ns κ κs σ2 nt Hstep) "Hσ".
+  destruct (step_Permutation t1' t1 t2 κ σ1 σ2) as (t2'&?&?); [done..|].
+  iMod ("IH" $! t2' with "[% //] Hσ") as (n2) "($ & Hσ & IH & _)".
+  iModIntro. iExists n2. iFrame "Hσ". by iApply "IH".
+Qed.
+
+Lemma twptp_app t1 t2 : twptp t1 -∗ twptp t2 -∗ twptp (t1 ++ t2).
+Proof.
+  iIntros "H1". iRevert (t2). iRevert (t1) "H1".
+  iApply twptp_ind; iIntros "!>" (t1) "IH1". iIntros (t2) "H2".
+  iRevert (t1) "IH1"; iRevert (t2) "H2".
+  iApply twptp_ind; iIntros "!>" (t2) "IH2". iIntros (t1) "IH1".
+  rewrite twptp_unfold /twptp_pre. iIntros (t1'' σ1 ns κ κs σ2 nt Hstep) "Hσ1".
+  destruct Hstep as [e1 σ1' e2 σ2' efs' t1' t2' [=Ht ?] ? Hstep]; simplify_eq/=.
+  apply app_eq_inv in Ht as [(t&?&?)|(t&?&?)]; subst.
+  (* Case distinction on whether [e1] is in [t1] or [t2]. *)
+  - destruct t as [|e1' ?]; simplify_eq/=.
+    + iMod ("IH2" with "[%] Hσ1") as (n2) "($ & Hσ & IH2 & _)".
+      { by eapply (step_atomic _ _ _ _ _ []). }
+      iModIntro. iExists n2. iFrame "Hσ".
+      rewrite -{2}(left_id_L [] (++) (e2 :: _)). iApply "IH2".
+      by setoid_rewrite (right_id_L [] (++)).
+    + iMod ("IH1" with "[%] Hσ1") as (n2) "($ & Hσ & IH1 & _)"; first by econstructor.
+      iAssert (twptp t2) with "[IH2]" as "Ht2".
+      { rewrite twptp_unfold. iApply (twptp_pre_mono with "[] IH2").
+        iIntros "!> * [_ ?] //". }
+      iModIntro. iExists n2. iFrame "Hσ".
+      rewrite -assoc_L (comm _ t2) !cons_middle !assoc_L. by iApply "IH1".
+  - iMod ("IH2" with "[%] Hσ1") as (n2) "($ & Hσ & IH2 & _)"; first by econstructor.
+    iModIntro. iExists n2. iFrame "Hσ". rewrite -assoc_L. by iApply "IH2".
+Qed.
+
+Lemma twp_twptp s Φ e : WP e @ s; ⊤ [{ Φ }] -∗ twptp [e].
+Proof.
+  iIntros "He". remember (⊤ : coPset) as E eqn:HE.
+  iRevert (HE). iRevert (e E Φ) "He". iApply twp_ind.
+  iIntros "!>" (e E Φ); iIntros "IH" (->).
+  rewrite twptp_unfold /twptp_pre /twp_pre.
+  iIntros (t1' σ1' ns κ κs σ2' nt Hstep) "Hσ1".
+  destruct Hstep as [e1 σ1 e2 σ2 efs [|? t1] t2 ?? Hstep];
+    simplify_eq/=; try discriminate_list.
+  destruct (to_val e1) as [v|] eqn:He1.
+  { apply val_stuck in Hstep; naive_solver. }
+  iMod ("IH" with "Hσ1") as "[_ IH]".
+  iMod ("IH" with "[% //]") as "($ & Hσ & [IH _] & IHfork)".
+  iModIntro. iExists (length efs + nt). iFrame "Hσ".
+  iApply (twptp_app [_] with "(IH [//])").
+  clear. iInduction efs as [|e efs IH]; simpl.
+  { rewrite twptp_unfold /twptp_pre. iIntros (t2 σ1 ns κ κs σ2 nt1 Hstep).
+    destruct Hstep; simplify_eq/=; discriminate_list. }
+  iDestruct "IHfork" as "[[IH' _] IHfork]".
+  iApply (twptp_app [_] with "(IH' [//])"). by iApply "IH".
+Qed.
+
+Lemma twptp_total σ ns nt t :
+  state_interp σ ns [] nt -∗ twptp t ={⊤}=∗ ⌜sn erased_step (t, σ)⌝.
+Proof.
+  iIntros "Hσ Ht". iRevert (σ ns nt) "Hσ". iRevert (t) "Ht".
+  iApply twptp_ind; iIntros "!>" (t) "IH"; iIntros (σ ns nt) "Hσ".
+  iApply (pure_mono _ _ (Acc_intro _)). iIntros ([t' σ'] [κ Hstep]).
+  rewrite /twptp_pre.
+  iMod ("IH" with "[% //] Hσ") as (n' ->) "[Hσ [H _]]".
+  by iApply "H".
+Qed.
+End adequacy.
+
+Theorem twp_total Σ Λ `{!invGpreS Σ} s e σ Φ n :
+  (∀ `{Hinv : !invGS_gen HasNoLc Σ},
+     ⊢ |={⊤}=> ∃
+         (stateI : state Λ → nat → list (observation Λ) → nat → iProp Σ)
+         (** We abstract over any instance of [irisG], and thus any value of
+             the field [num_laters_per_step]. This is needed because instances
+             of [irisG] (e.g., the one of HeapLang) are shared between WP and
+             TWP, where TWP simply ignores [num_laters_per_step]. *)
+         (num_laters_per_step : nat → nat)
+         (fork_post : val Λ → iProp Σ)
+         state_interp_mono,
+       let _ : irisGS_gen HasNoLc Λ Σ :=
+           IrisG Hinv stateI fork_post num_laters_per_step state_interp_mono
+       in
+       stateI σ n [] 0 ∗ WP e @ s; ⊤ [{ Φ }]) →
+  sn erased_step ([e], σ). (* i.e. ([e], σ) is strongly normalizing *)
+Proof.
+  intros Hwp. eapply pure_soundness.
+  apply (fupd_soundness_no_lc ⊤ ⊤ _ 0)=> Hinv. iIntros "_".
+  iMod (Hwp) as (stateI num_laters_per_step fork_post stateI_mono) "[Hσ H]".
+  set (iG := IrisG Hinv stateI fork_post num_laters_per_step stateI_mono).
+  iApply (@twptp_total _ _ iG _ n with "Hσ").
+  by iApply (@twp_twptp _ _ (IrisG Hinv _ fork_post _ _)).
+Qed.

iris/program_logic/total_ectx_lifting.v

+(** Some derived lemmas for ectx-based languages *)
+From iris.proofmode Require Import proofmode.
+From iris.program_logic Require Export ectx_language total_weakestpre total_lifting.
+From iris.prelude Require Import options.
+
+Section wp.
+Context {Λ : ectxLanguage} `{!irisGS_gen hlc Λ Σ} {Hinh : Inhabited (state Λ)}.
+Implicit Types P : iProp Σ.
+Implicit Types Φ : val Λ → iProp Σ.
+Implicit Types v : val Λ.
+Implicit Types e : expr Λ.
+Local Hint Resolve base_prim_reducible_no_obs base_reducible_prim_step
+  base_reducible_no_obs_reducible : core.
+
+Lemma twp_lift_base_step {s E Φ} e1 :
+  to_val e1 = None →
+  (∀ σ1 ns κs nt, state_interp σ1 ns κs nt ={E,∅}=∗
+    ⌜base_reducible_no_obs e1 σ1⌝ ∗
+    ∀ κ e2 σ2 efs, ⌜base_step e1 σ1 κ e2 σ2 efs⌝ ={∅,E}=∗
+      ⌜κ = []⌝ ∗
+      state_interp σ2 (S ns) κs (length efs + nt) ∗
+      WP e2 @ s; E [{ Φ }] ∗
+      [∗ list] i ↦ ef ∈ efs, WP ef @ s; ⊤ [{ fork_post }])
+  ⊢ WP e1 @ s; E [{ Φ }].
+Proof.
+  iIntros (?) "H".
+  iApply (twp_lift_step _ E)=>//. iIntros (σ1 ns κs nt) "Hσ".
+  iMod ("H" $! σ1 with "Hσ") as "[% H]"; iModIntro.
+  iSplit; [destruct s; auto|]. iIntros (κ e2 σ2 efs Hstep).
+  iApply "H". by eauto.
+Qed.
+
+Lemma twp_lift_pure_base_step_no_fork {s E Φ} e1 :
+  (∀ σ1, base_reducible_no_obs e1 σ1) →
+  (∀ σ1 κ e2 σ2 efs, base_step e1 σ1 κ e2 σ2 efs → κ = [] ∧ σ2 = σ1 ∧ efs = []) →
+  (|={E}=> ∀ κ e2 efs σ, ⌜base_step e1 σ κ e2 σ efs⌝ → WP e2 @ s; E [{ Φ }] )
+  ⊢ WP e1 @ s; E [{ Φ }].
+Proof using Hinh.
+  iIntros (??) ">H". iApply twp_lift_pure_step_no_fork; eauto.
+  iIntros "!>" (?????). iApply "H"; eauto.
+Qed.
+
+Lemma twp_lift_atomic_base_step {s E Φ} e1 :
+  to_val e1 = None →
+  (∀ σ1 ns κs nt, state_interp σ1 ns κs nt ={E}=∗
+    ⌜base_reducible_no_obs e1 σ1⌝ ∗
+    ∀ κ e2 σ2 efs, ⌜base_step e1 σ1 κ e2 σ2 efs⌝ ={E}=∗
+      ⌜κ = []⌝ ∗
+      state_interp σ2 (S ns) κs (length efs + nt) ∗
+      from_option Φ False (to_val e2) ∗
+      [∗ list] ef ∈ efs, WP ef @ s; ⊤ [{ fork_post }])
+  ⊢ WP e1 @ s; E [{ Φ }].
+Proof.
+  iIntros (?) "H". iApply twp_lift_atomic_step; eauto.
+  iIntros (σ1 ns κs nt) "Hσ1". iMod ("H" $! σ1 with "Hσ1") as "[% H]"; iModIntro.
+  iSplit; first by destruct s; auto. iIntros (κ e2 σ2 efs Hstep). iApply "H"; eauto.
+Qed.
+
+Lemma twp_lift_atomic_base_step_no_fork {s E Φ} e1 :
+  to_val e1 = None →
+  (∀ σ1 ns κs nt, state_interp σ1 ns κs nt ={E}=∗
+    ⌜base_reducible_no_obs e1 σ1⌝ ∗
+    ∀ κ e2 σ2 efs, ⌜base_step e1 σ1 κ e2 σ2 efs⌝ ={E}=∗
+      ⌜κ = []⌝ ∗ ⌜efs = []⌝ ∗ state_interp σ2 (S ns) κs nt
+                            ∗ from_option Φ False (to_val e2))
+  ⊢ WP e1 @ s; E [{ Φ }].
+Proof.
+  iIntros (?) "H". iApply twp_lift_atomic_base_step; eauto.
+  iIntros (σ1 ns κs nt) "Hσ1". iMod ("H" $! σ1 with "Hσ1") as "[$ H]"; iModIntro.
+  iIntros (κ v2 σ2 efs Hstep).
+  iMod ("H" with "[# //]") as "(-> & -> & ? & $) /=". by iFrame.
+Qed.
+
+Lemma twp_lift_pure_det_base_step_no_fork {s E Φ} e1 e2 :
+  to_val e1 = None →
+  (∀ σ1, base_reducible_no_obs e1 σ1) →
+  (∀ σ1 κ e2' σ2 efs',
+    base_step e1 σ1 κ e2' σ2 efs' → κ = [] ∧ σ2 = σ1 ∧ e2' = e2 ∧ efs' = []) →
+  WP e2 @ s; E [{ Φ }] ⊢ WP e1 @ s; E [{ Φ }].
+Proof using Hinh.
+  intros. rewrite -(twp_lift_pure_det_step_no_fork e1 e2); eauto.
+Qed.
+End wp.

iris/program_logic/total_lifting.v

+From iris.bi Require Export big_op.
+From iris.proofmode Require Import proofmode.
+From iris.program_logic Require Export total_weakestpre.
+From iris.prelude Require Import options.
+
+Section lifting.
+Context `{!irisGS_gen hlc Λ Σ}.
+Implicit Types v : val Λ.
+Implicit Types e : expr Λ.
+Implicit Types σ : state Λ.
+Implicit Types P Q : iProp Σ.
+Implicit Types Φ : val Λ → iProp Σ.
+
+Local Hint Resolve reducible_no_obs_reducible : core.
+
+Lemma twp_lift_step s E Φ e1 :
+  to_val e1 = None →
+  (∀ σ1 ns κs nt, state_interp σ1 ns κs nt ={E,∅}=∗
+    ⌜if s is NotStuck then reducible_no_obs e1 σ1 else True⌝ ∗
+    ∀ κ e2 σ2 efs, ⌜prim_step e1 σ1 κ e2 σ2 efs⌝ ={∅,E}=∗
+      ⌜κ = []⌝ ∗
+      state_interp σ2 (S ns) κs (length efs + nt) ∗
+      WP e2 @ s; E [{ Φ }] ∗
+      [∗ list] ef ∈ efs, WP ef @ s; ⊤ [{ fork_post }])
+  ⊢ WP e1 @ s; E [{ Φ }].
+Proof. by rewrite twp_unfold /twp_pre=> ->. Qed.
+
+(** Derived lifting lemmas. *)
+Lemma twp_lift_pure_step_no_fork `{!Inhabited (state Λ)} s E Φ e1 :
+  (∀ σ1, reducible_no_obs e1 σ1) →
+  (∀ σ1 κ e2 σ2 efs, prim_step e1 σ1 κ e2 σ2 efs → κ = [] ∧ σ2 = σ1 ∧ efs = []) →
+  (|={E}=> ∀ κ e2 efs σ, ⌜prim_step e1 σ κ e2 σ efs⌝ → WP e2 @ s; E [{ Φ }])
+  ⊢ WP e1 @ s; E [{ Φ }].
+Proof.
+  iIntros (Hsafe Hstep) ">H". iApply twp_lift_step.
+  { eapply reducible_not_val, reducible_no_obs_reducible, (Hsafe inhabitant). }
+  iIntros (σ1 ns κs n) "Hσ".
+  iApply fupd_mask_intro; first by set_solver. iIntros "Hclose". iSplit.
+  { iPureIntro. destruct s; auto. }
+  iIntros (κ e2 σ2 efs ?). destruct (Hstep σ1 κ e2 σ2 efs) as (->&<-&->); auto.
+  iMod (state_interp_mono with "Hσ"). iMod "Hclose" as "_".
+  iDestruct ("H" with "[//]") as "H". simpl. by iFrame.
+Qed.
+
+(* Atomic steps don't need any mask-changing business here, one can
+   use the generic lemmas here. *)
+Lemma twp_lift_atomic_step {s E Φ} e1 :
+  to_val e1 = None →
+  (∀ σ1 ns κs nt, state_interp σ1 ns κs nt ={E}=∗
+    ⌜if s is NotStuck then reducible_no_obs e1 σ1 else True⌝ ∗
+    ∀ κ e2 σ2 efs, ⌜prim_step e1 σ1 κ e2 σ2 efs⌝ ={E}=∗
+      ⌜κ = []⌝ ∗
+      state_interp σ2 (S ns) κs (length efs + nt) ∗
+      from_option Φ False (to_val e2) ∗
+      [∗ list] ef ∈ efs, WP ef @ s; ⊤ [{ fork_post }])
+  ⊢ WP e1 @ s; E [{ Φ }].
+Proof.
+  iIntros (?) "H".
+  iApply (twp_lift_step _ E _ e1)=>//; iIntros (σ1 ns κs nt) "Hσ1".
+  iMod ("H" $! σ1 with "Hσ1") as "[$ H]".
+  iApply fupd_mask_intro; first set_solver.
+  iIntros "Hclose" (κ e2 σ2 efs) "%". iMod "Hclose" as "_".
+  iMod ("H" $! κ e2 σ2 efs with "[#]") as "($ & $ & HΦ & $)"; first by eauto.
+  destruct (to_val e2) eqn:?; last by iExFalso.
+  iApply twp_value; last done. by apply of_to_val.
+Qed.
+
+Lemma twp_lift_pure_det_step_no_fork `{!Inhabited (state Λ)} {s E Φ} e1 e2 :
+  (∀ σ1, reducible_no_obs e1 σ1) →
+  (∀ σ1 κ e2' σ2 efs', prim_step e1 σ1 κ e2' σ2 efs' →
+    κ = [] ∧ σ2 = σ1 ∧ e2' = e2 ∧ efs' = []) →
+  (|={E}=> WP e2 @ s; E [{ Φ }]) ⊢ WP e1 @ s; E [{ Φ }].
+Proof.
+  iIntros (? Hpuredet) ">H". iApply (twp_lift_pure_step_no_fork s E); try done.
+  { naive_solver. }
+  iIntros "!>" (κ' e' efs' σ (_&_&->&->)%Hpuredet); auto.
+Qed.
+
+Lemma twp_pure_step `{!Inhabited (state Λ)} s E e1 e2 φ n Φ :
+  PureExec φ n e1 e2 →
+  φ →
+  WP e2 @ s; E [{ Φ }] ⊢ WP e1 @ s; E [{ Φ }].
+Proof.
+  iIntros (Hexec Hφ) "Hwp". specialize (Hexec Hφ).
+  iInduction Hexec as [e|n e1 e2 e3 [Hsafe ?] ? IH]; simpl; first done.
+  iApply twp_lift_pure_det_step_no_fork; [done|naive_solver|].
+  iModIntro. by iApply "IH".
+Qed.
+End lifting.

iris/program_logic/total_weakestpre.v

+From iris.bi Require Import fixpoint_mono big_op.
+From iris.proofmode Require Import proofmode.
+From iris.program_logic Require Export weakestpre.
+From iris.prelude Require Import options.
+Import uPred.
+
+(** The definition of total weakest preconditions is very similar to the
+definition of normal (i.e. partial) weakest precondition, with the exception
+that there is no later modality. Hence, instead of taking a Banach's fixpoint,
+we take a least fixpoint. *)
+Definition twp_pre `{!irisGS_gen hlc Λ Σ} (s : stuckness)
+      (wp : coPset → expr Λ → (val Λ → iProp Σ) → iProp Σ) :
+    coPset → expr Λ → (val Λ → iProp Σ) → iProp Σ := λ E e1 Φ,
+  match to_val e1 with
+  | Some v => |={E}=> Φ v
+  | None => ∀ σ1 ns κs nt,
+     state_interp σ1 ns κs nt ={E,∅}=∗
+       ⌜if s is NotStuck then reducible_no_obs e1 σ1 else True⌝ ∗
+       ∀ κ e2 σ2 efs, ⌜prim_step e1 σ1 κ e2 σ2 efs⌝ ={∅,E}=∗
+         ⌜κ = []⌝ ∗
+         state_interp σ2 (S ns) κs (length efs + nt) ∗
+         wp E e2 Φ ∗
+         [∗ list] ef ∈ efs, wp ⊤ ef fork_post
+  end%I.
+
+(** This is some uninteresting bookkeeping to prove that [twp_pre_mono] is
+monotone. The actual least fixpoint [twp_def] can be found below. *)
+Local Lemma twp_pre_mono `{!irisGS_gen hlc Λ Σ} s
+    (wp1 wp2 : coPset → expr Λ → (val Λ → iProp Σ) → iProp Σ) :
+  ⊢ (□ ∀ E e Φ, wp1 E e Φ -∗ wp2 E e Φ) →
+    ∀ E e Φ, twp_pre s wp1 E e Φ -∗ twp_pre s wp2 E e Φ.
+Proof.
+  iIntros "#H"; iIntros (E e1 Φ) "Hwp". rewrite /twp_pre.
+  destruct (to_val e1) as [v|]; first done.
+  iIntros (σ1 ns κs nt) "Hσ". iMod ("Hwp" with "Hσ") as "($ & Hwp)"; iModIntro.
+  iIntros (κ e2 σ2 efs) "Hstep".
+  iMod ("Hwp" with "Hstep") as (?) "(Hσ & Hwp & Hfork)".
+  iModIntro. iFrame "Hσ". iSplit; first done. iSplitL "Hwp".
+  - by iApply "H".
+  - iApply (@big_sepL_impl with "Hfork"); iIntros "!>" (k e _) "Hwp".
+    by iApply "H".
+Qed.
+
+(* Uncurry [twp_pre] and equip its type with an OFE structure *)
+Local Definition twp_pre' `{!irisGS_gen hlc Λ Σ} (s : stuckness) :
+  (prodO (prodO (leibnizO coPset) (exprO Λ)) (val Λ -d> iPropO Σ) → iPropO Σ) →
+  prodO (prodO (leibnizO coPset) (exprO Λ)) (val Λ -d> iPropO Σ) → iPropO Σ :=
+    uncurry3 ∘ twp_pre s ∘ curry3.
+
+Local Instance twp_pre_mono' `{!irisGS_gen hlc Λ Σ} s : BiMonoPred (twp_pre' s).
+Proof.
+  constructor.
+  - iIntros (wp1 wp2 ??) "#H"; iIntros ([[E e1] Φ]); iRevert (E e1 Φ).
+    iApply twp_pre_mono. iIntros "!>" (E e Φ). iApply ("H" $! (E,e,Φ)).
+  - intros wp Hwp n [[E1 e1] Φ1] [[E2 e2] Φ2]
+      [[?%leibniz_equiv ?%leibniz_equiv] ?]; simplify_eq/=.
+    rewrite /curry3 /twp_pre. do 26 (f_equiv || done). by apply pair_ne.
+Qed.
+
+Local Definition twp_def `{!irisGS_gen hlc Λ Σ} : Twp (iProp Σ) (expr Λ) (val Λ) stuckness :=
+  λ s E e Φ, bi_least_fixpoint (twp_pre' s) (E,e,Φ).
+Local Definition twp_aux : seal (@twp_def). Proof. by eexists. Qed.
+Definition twp' := twp_aux.(unseal).
+Global Arguments twp' {hlc Λ Σ _}.
+Global Existing Instance twp'.
+Local Lemma twp_unseal `{!irisGS_gen hlc Λ Σ} : twp = @twp_def hlc Λ Σ _.
+Proof. rewrite -twp_aux.(seal_eq) //. Qed.
+
+Section twp.
+Context `{!irisGS_gen hlc Λ Σ}.
+Implicit Types s : stuckness.
+Implicit Types P : iProp Σ.
+Implicit Types Φ : val Λ → iProp Σ.
+Implicit Types v : val Λ.
+Implicit Types e : expr Λ.
+
+(* Weakest pre *)
+Lemma twp_unfold s E e Φ : WP e @ s; E [{ Φ }] ⊣⊢ twp_pre s (twp s) E e Φ.
+Proof. by rewrite twp_unseal /twp_def least_fixpoint_unfold. Qed.
+Lemma twp_ind s Ψ :
+  (∀ n E e, Proper (pointwise_relation _ (dist n) ==> dist n) (Ψ E e)) →
+  □ (∀ e E Φ, twp_pre s (λ E e Φ, Ψ E e Φ ∧ WP e @ s; E [{ Φ }]) E e Φ -∗ Ψ E e Φ) -∗
+  ∀ e E Φ, WP e @ s; E [{ Φ }] -∗ Ψ E e Φ.
+Proof.
+  iIntros (HΨ). iIntros "#IH" (e E Φ) "H". rewrite twp_unseal.
+  set (Ψ' := uncurry3 Ψ :
+    prodO (prodO (leibnizO coPset) (exprO Λ)) (val Λ -d> iPropO Σ) → iPropO Σ).
+  assert (NonExpansive Ψ').
+  { intros n [[E1 e1] Φ1] [[E2 e2] Φ2]
+      [[?%leibniz_equiv ?%leibniz_equiv] ?]; simplify_eq/=. by apply HΨ. }
+  iApply (least_fixpoint_ind _ Ψ' with "[] H").
+  iIntros "!>" ([[??] ?]) "H". by iApply "IH".
+Qed.
+
+Global Instance twp_ne s E e n :
+  Proper (pointwise_relation _ (dist n) ==> dist n) (twp (PROP:=iProp Σ) s E e).
+Proof.
+  intros Φ1 Φ2 HΦ. rewrite !twp_unseal. by apply (least_fixpoint_ne _), pair_ne, HΦ.
+Qed.
+Global Instance twp_proper s E e :
+  Proper (pointwise_relation _ (≡) ==> (≡)) (twp (PROP:=iProp Σ) s E e).
+Proof.
+  by intros Φ Φ' ?; apply equiv_dist=>n; apply twp_ne=>v; apply equiv_dist.
+Qed.
+
+Lemma twp_value_fupd' s E Φ v : WP of_val v @ s; E [{ Φ }] ⊣⊢ |={E}=> Φ v.
+Proof. rewrite twp_unfold /twp_pre to_of_val. auto. Qed.
+
+Lemma twp_strong_mono s1 s2 E1 E2 e Φ Ψ :
+  s1 ⊑ s2 → E1 ⊆ E2 →
+  WP e @ s1; E1 [{ Φ }] -∗ (∀ v, Φ v ={E2}=∗ Ψ v) -∗ WP e @ s2; E2 [{ Ψ }].
+Proof.
+  iIntros (? HE) "H HΦ". iRevert (E2 Ψ HE) "HΦ"; iRevert (e E1 Φ) "H".
+  iApply twp_ind; first solve_proper.
+  iIntros "!>" (e E1 Φ) "IH"; iIntros (E2 Ψ HE) "HΦ".
+  rewrite !twp_unfold /twp_pre. destruct (to_val e) as [v|] eqn:?.
+  { iApply ("HΦ" with "[> -]"). by iApply (fupd_mask_mono E1 _). }
+  iIntros (σ1 ns κs nt) "Hσ".
+  iMod (fupd_mask_subseteq E1) as "Hclose"; first done.
+  iMod ("IH" with "[$]") as "[% IH]".
+  iModIntro; iSplit; [by destruct s1, s2|]. iIntros (κ e2 σ2 efs Hstep).
+  iMod ("IH" with "[//]") as (?) "(Hσ & IH & IHefs)"; auto.
+  iMod "Hclose" as "_"; iModIntro.
+  iFrame "Hσ". iSplit; first done. iSplitR "IHefs".
+  - iDestruct "IH" as "[IH _]". iApply ("IH" with "[//] HΦ").
+  - iApply (big_sepL_impl with "IHefs"); iIntros "!>" (k ef _) "[IH _]".
+    iApply "IH"; auto.
+Qed.
+
+Lemma fupd_twp s E e Φ : (|={E}=> WP e @ s; E [{ Φ }]) ⊢ WP e @ s; E [{ Φ }].
+Proof.
+  rewrite twp_unfold /twp_pre. iIntros "H". destruct (to_val e) as [v|] eqn:?.
+  { by iMod "H". }
+  iIntros (σ1 ns κs nt) "Hσ1". iMod "H". by iApply "H".
+Qed.
+Lemma twp_fupd s E e Φ : WP e @ s; E [{ v, |={E}=> Φ v }] ⊢ WP e @ s; E [{ Φ }].
+Proof. iIntros "H". iApply (twp_strong_mono with "H"); auto. Qed.
+
+Lemma twp_atomic s E1 E2 e Φ `{!Atomic (stuckness_to_atomicity s) e} :
+  (|={E1,E2}=> WP e @ s; E2 [{ v, |={E2,E1}=> Φ v }]) ⊢ WP e @ s; E1 [{ Φ }].
+Proof.
+  iIntros "H". rewrite !twp_unfold /twp_pre /=.
+  destruct (to_val e) as [v|] eqn:He.
+  { by iDestruct "H" as ">>> $". }
+  iIntros (σ1 ns κs nt) "Hσ". iMod "H". iMod ("H" $! σ1 with "Hσ") as "[$ H]".
+  iModIntro. iIntros (κ e2 σ2 efs Hstep).
+  iMod ("H" with "[//]") as (?) "(Hσ & H & Hefs)". destruct s.
+  - rewrite !twp_unfold /twp_pre. destruct (to_val e2) as [v2|] eqn:He2.
+    + iDestruct "H" as ">> $". by iFrame.
+    + iMod ("H" with "[$]") as "[H _]". iDestruct "H" as %(? & ? & ? & ?).
+      by edestruct (atomic _ _ _ _ _ Hstep).
+  - destruct (atomic _ _ _ _ _ Hstep) as [v <-%of_to_val].
+    rewrite twp_value_fupd'. iMod "H" as ">H".
+    iModIntro. iSplit; first done. iFrame "Hσ Hefs". by iApply twp_value_fupd'.
+Qed.
+
+Lemma twp_bind K `{!LanguageCtx K} s E e Φ :
+  WP e @ s; E [{ v, WP K (of_val v) @ s; E [{ Φ }] }] ⊢ WP K e @ s; E [{ Φ }].
+Proof.
+  revert Φ. cut (∀ Φ', WP e @ s; E [{ Φ' }] -∗ ∀ Φ,
+    (∀ v, Φ' v -∗ WP K (of_val v) @ s; E [{ Φ }]) -∗ WP K e @ s; E [{ Φ }]).
+  { iIntros (help Φ) "H". iApply (help with "H"); auto. }
+  iIntros (Φ') "H". iRevert (e E Φ') "H". iApply twp_ind; first solve_proper.
+  iIntros "!>" (e E1 Φ') "IH". iIntros (Φ) "HΦ".
+  rewrite /twp_pre. destruct (to_val e) as [v|] eqn:He.
+  { apply of_to_val in He as <-. iApply fupd_twp. by iApply "HΦ". }
+  rewrite twp_unfold /twp_pre fill_not_val //.
+  iIntros (σ1 ns κs nt) "Hσ". iMod ("IH" with "[$]") as "[% IH]".
+  iModIntro; iSplit.
+  { iPureIntro. unfold reducible_no_obs in *.
+    destruct s; naive_solver eauto using fill_step. }
+  iIntros (κ e2 σ2 efs Hstep).
+  destruct (fill_step_inv e σ1 κ e2 σ2 efs) as (e2'&->&?); auto.
+  iMod ("IH" $! κ e2' σ2 efs with "[//]") as (?) "(Hσ & IH & IHefs)".
+  iModIntro. iFrame "Hσ". iSplit; first done. iSplitR "IHefs".
+  - iDestruct "IH" as "[IH _]". by iApply "IH".
+  - by setoid_rewrite and_elim_r.
+Qed.
+
+Lemma twp_bind_inv K `{!LanguageCtx K} s E e Φ :
+  WP K e @ s; E [{ Φ }] -∗ WP e @ s; E [{ v, WP K (of_val v) @ s; E [{ Φ }] }].
+Proof.
+  iIntros "H". remember (K e) as e' eqn:He'.
+  iRevert (e He'). iRevert (e' E Φ) "H". iApply twp_ind; first solve_proper.
+  iIntros "!>" (e' E1 Φ) "IH". iIntros (e ->).
+  rewrite !twp_unfold {2}/twp_pre. destruct (to_val e) as [v|] eqn:He.
+  { iModIntro. apply of_to_val in He as <-. rewrite !twp_unfold.
+    iApply (twp_pre_mono with "[] IH"). by iIntros "!>" (E e Φ') "[_ ?]". }
+  rewrite /twp_pre fill_not_val //.
+  iIntros (σ1 ns κs nt) "Hσ". iMod ("IH" with "[$]") as "[% IH]".
+  iModIntro; iSplit.
+  { destruct s; eauto using reducible_no_obs_fill_inv. }
+  iIntros (κ e2 σ2 efs Hstep).
+  iMod ("IH" $! κ (K e2) σ2 efs with "[]")
+    as (?) "(Hσ & IH & IHefs)"; eauto using fill_step.
+  iModIntro. iFrame "Hσ". iSplit; first done. iSplitR "IHefs".
+  - iDestruct "IH" as "[IH _]". by iApply "IH".
+  - by setoid_rewrite and_elim_r.
+Qed.
+
+Lemma twp_wp s E e Φ : WP e @ s; E [{ Φ }] -∗ WP e @ s; E {{ Φ }}.
+Proof.
+  iIntros "H". iLöb as "IH" forall (E e Φ).
+  rewrite wp_unfold twp_unfold /wp_pre /twp_pre. destruct (to_val e) as [v|]=>//=.
+  iIntros (σ1 ns κ κs nt) "Hσ". iMod ("H" with "Hσ") as "[% H]".
+  iIntros "!>". iSplitR.
+  { destruct s; eauto using reducible_no_obs_reducible. }
+  iIntros (e2 σ2 efs) "Hstep _". iMod ("H" with "Hstep") as (->) "(Hσ & H & Hfork)".
+  iApply fupd_mask_intro; [set_solver+|]. iIntros "Hclose".
+  iIntros "!>!>". iApply step_fupdN_intro=>//. iModIntro. iMod "Hclose" as "_".
+  iModIntro. iFrame "Hσ". iSplitL "H".
+  { by iApply "IH". }
+  iApply (@big_sepL_impl with "Hfork").
+  iIntros "!>" (k ef _) "H". by iApply "IH".
+Qed.
+
+(** This lemma is similar to [wp_step_fupdN_strong], the difference is the TWP
+(instead of a WP) in the premise. Since TWPs do not use up later credits, we get
+[£ n] in the viewshift in the premise. *)
+Lemma twp_wp_fupdN_strong n s E1 E2 e P Φ :
+  TCEq (to_val e) None → E2 ⊆ E1 →
+  (∀ σ ns κs nt, state_interp σ ns κs nt ={E1,∅}=∗
+                 ⌜n ≤ S (num_laters_per_step ns)⌝) ∧
+  ((|={E1,E2}=> £ n ={∅}▷=∗^n |={E2,E1}=> P) ∗
+    WP e @ s; E2 [{ v, P ={E1}=∗ Φ v }]) -∗
+  WP e @ s; E1 {{ Φ }}.
+Proof.
+  destruct n as [|n].
+  { iIntros (_ ?) "/= [_ [HP Hwp]]".
+    iApply (wp_strong_mono with "[Hwp]"); [done..|by iApply twp_wp|]; simpl.
+    iIntros (v) "H". iApply ("H" with "[>HP]"). iMod "HP".
+    iMod lc_zero as "Hlc". by iApply "HP". }
+  rewrite wp_unfold twp_unfold /wp_pre /twp_pre. iIntros (-> ?) "H".
+  iIntros (σ1 ns κ κs nt) "Hσ".
+  destruct (decide (n ≤ num_laters_per_step ns)) as [Hn|Hn]; first last.
+  { iDestruct "H" as "[Hn _]". iMod ("Hn" with "Hσ") as %?. lia. }
+  iDestruct "H" as "[_ [>HP Hwp]]". iMod ("Hwp" with "[$]") as "[% H]".
+  iIntros "!>". iSplitR.
+  { destruct s; eauto using reducible_no_obs_reducible. }
+  iIntros (e2 σ2 efs Hstep) "Hcred /=".
+  iDestruct ("H" $! κ e2 σ2 efs with "[% //]") as "H".
+  iMod ("HP" with "[Hcred]") as "HP".
+  { iApply (lc_weaken with "Hcred"); lia. }
+  iIntros "!> !>". iMod "HP". iModIntro.
+  iApply step_fupdN_le; [apply Hn|done|..].
+  iApply (step_fupdN_wand with "HP"); iIntros "HP".
+  iMod "H" as (->) "($ & Hwp & Hfork)". iMod "HP". iModIntro. iSplitR "Hfork".
+  - iApply twp_wp. iApply (twp_strong_mono with "Hwp"); [done|set_solver|].
+    iIntros (v) "HΦ". iApply ("HΦ" with "HP").
+  - iApply (big_sepL_impl with "Hfork").
+    iIntros "!>" (k ef _) "H". by iApply twp_wp.
+Qed.
+
+(** * Derived rules *)
+Lemma twp_mono s E e Φ Ψ :
+  (∀ v, Φ v ⊢ Ψ v) → WP e @ s; E [{ Φ }] ⊢ WP e @ s; E [{ Ψ }].
+Proof.
+  iIntros (HΦ) "H"; iApply (twp_strong_mono with "H"); auto.
+  iIntros (v) "?". by iApply HΦ.
+Qed.
+Lemma twp_stuck_mono s1 s2 E e Φ :
+  s1 ⊑ s2 → WP e @ s1; E [{ Φ }] ⊢ WP e @ s2; E [{ Φ }].
+Proof. iIntros (?) "H". iApply (twp_strong_mono with "H"); auto. Qed.
+Lemma twp_stuck_weaken s E e Φ :
+  WP e @ s; E [{ Φ }] ⊢ WP e @ E ?[{ Φ }].
+Proof. apply twp_stuck_mono. by destruct s. Qed.
+Lemma twp_mask_mono s E1 E2 e Φ :
+  E1 ⊆ E2 → WP e @ s; E1 [{ Φ }] -∗ WP e @ s; E2 [{ Φ }].
+Proof. iIntros (?) "H"; iApply (twp_strong_mono with "H"); auto. Qed.
+Global Instance twp_mono' s E e :
+  Proper (pointwise_relation _ (⊢) ==> (⊢)) (twp (PROP:=iProp Σ) s E e).
+Proof. by intros Φ Φ' ?; apply twp_mono. Qed.
+
+Lemma twp_value_fupd s E Φ e v : IntoVal e v → WP e @ s; E [{ Φ }] ⊣⊢ |={E}=> Φ v.
+Proof. intros <-. by apply twp_value_fupd'. Qed.
+Lemma twp_value' s E Φ v : Φ v ⊢ WP (of_val v) @ s; E [{ Φ }].
+Proof. rewrite twp_value_fupd'. auto. Qed.
+Lemma twp_value s E Φ e v : IntoVal e v → Φ v ⊢ WP e @ s; E [{ Φ }].
+Proof. intros <-. apply twp_value'. Qed.
+
+Lemma twp_frame_l s E e Φ R : R ∗ WP e @ s; E [{ Φ }] ⊢ WP e @ s; E [{ v, R ∗ Φ v }].
+Proof. iIntros "[? H]". iApply (twp_strong_mono with "H"); auto with iFrame. Qed.
+Lemma twp_frame_r s E e Φ R : WP e @ s; E [{ Φ }] ∗ R ⊢ WP e @ s; E [{ v, Φ v ∗ R }].
+Proof. iIntros "[H ?]". iApply (twp_strong_mono with "H"); auto with iFrame. Qed.
+
+Lemma twp_wand s E e Φ Ψ :
+  WP e @ s; E [{ Φ }] -∗ (∀ v, Φ v -∗ Ψ v) -∗ WP e @ s; E [{ Ψ }].
+Proof.
+  iIntros "H HΦ". iApply (twp_strong_mono with "H"); auto.
+  iIntros (?) "?". by iApply "HΦ".
+Qed.
+Lemma twp_wand_l s E e Φ Ψ :
+  (∀ v, Φ v -∗ Ψ v) ∗ WP e @ s; E [{ Φ }] -∗ WP e @ s; E [{ Ψ }].
+Proof. iIntros "[H Hwp]". iApply (twp_wand with "Hwp H"). Qed.
+Lemma twp_wand_r s E e Φ Ψ :
+  WP e @ s; E [{ Φ }] ∗ (∀ v, Φ v -∗ Ψ v) -∗ WP e @ s; E [{ Ψ }].
+Proof. iIntros "[Hwp H]". iApply (twp_wand with "Hwp H"). Qed.
+Lemma twp_frame_wand s E e Φ R :
+  R -∗ WP e @ s; E [{ v, R -∗ Φ v }] -∗ WP e @ s; E [{ Φ }].
+Proof.
+  iIntros "HR HWP". iApply (twp_wand with "HWP").
+  iIntros (v) "HΦ". by iApply "HΦ".
+Qed.
+
+Lemma twp_wp_step s E e P Φ :
+  TCEq (to_val e) None →
+  ▷ P -∗
+  WP e @ s; E [{ v, P ={E}=∗ Φ v }] -∗ WP e @ s; E {{ Φ }}.
+Proof.
+  iIntros (?) "HP Hwp".
+  iApply (wp_step_fupd _ _ E _ P with "[HP]"); [auto..|]. by iApply twp_wp.
+Qed.
+End twp.
+
+(** Proofmode class instances *)
+Section proofmode_classes.
+  Context `{!irisGS_gen hlc Λ Σ}.
+  Implicit Types P Q : iProp Σ.
+  Implicit Types Φ : val Λ → iProp Σ.
+  Implicit Types v : val Λ.
+  Implicit Types e : expr Λ.
+
+  Global Instance frame_twp p s E e R Φ Ψ :
+    (FrameInstantiateExistDisabled → ∀ v, Frame p R (Φ v) (Ψ v)) →
+    Frame p R (WP e @ s; E [{ Φ }]) (WP e @ s; E [{ Ψ }]) | 2.
+  Proof.
+    rewrite /Frame=> HR. rewrite twp_frame_l. apply twp_mono, HR. constructor.
+  Qed.
+
+  Global Instance is_except_0_wp s E e Φ : IsExcept0 (WP e @ s; E [{ Φ }]).
+  Proof. by rewrite /IsExcept0 -{2}fupd_twp -except_0_fupd -fupd_intro. Qed.
+
+  Global Instance elim_modal_bupd_twp p s E e P Φ :
+    ElimModal True p false (|==> P) P (WP e @ s; E [{ Φ }]) (WP e @ s; E [{ Φ }]).
+  Proof.
+    by rewrite /ElimModal intuitionistically_if_elim
+      (bupd_fupd E) fupd_frame_r wand_elim_r fupd_twp.
+  Qed.
+
+  Global Instance elim_modal_fupd_twp p s E e P Φ :
+    ElimModal True p false (|={E}=> P) P (WP e @ s; E [{ Φ }]) (WP e @ s; E [{ Φ }]).
+  Proof.
+    by rewrite /ElimModal intuitionistically_if_elim
+      fupd_frame_r wand_elim_r fupd_twp.
+  Qed.
+  (** Error message instance for non-mask-changing view shifts.
+  Also uses a slightly different error: we cannot apply [fupd_mask_subseteq]
+  if [e] is not atomic, so we tell the user to first add a leading [fupd]
+  and then change the mask of that. *)
+  Global Instance elim_modal_fupd_twp_wrong_mask p s E1 E2 e P Φ :
+    ElimModal
+      (pm_error "Goal and eliminated modality must have the same mask.
+Use [iApply fupd_twp; iMod (fupd_mask_subseteq E2)] to adjust the mask of your goal to [E2]")
+      p false
+      (|={E2}=> P) False (WP e @ s; E1 [{ Φ }]) False | 100.
+  Proof. intros []. Qed.
+
+  Global Instance elim_modal_fupd_twp_atomic p s E1 E2 e P Φ :
+    ElimModal (Atomic (stuckness_to_atomicity s) e) p false
+            (|={E1,E2}=> P) P
+            (WP e @ s; E1 [{ Φ }]) (WP e @ s; E2 [{ v, |={E2,E1}=> Φ v }])%I | 100.
+  Proof.
+    intros ?. by rewrite intuitionistically_if_elim
+      fupd_frame_r wand_elim_r twp_atomic.
+  Qed.
+  (** Error message instance for mask-changing view shifts. *)
+  Global Instance elim_modal_fupd_twp_atomic_wrong_mask p s E1 E2 E2' e P Φ :
+    ElimModal
+      (pm_error "Goal and eliminated modality must have the same mask.
+  Use [iMod (fupd_mask_subseteq E2)] to adjust the mask of your goal to [E2]")
+      p false
+      (|={E2,E2'}=> P) False
+      (WP e @ s; E1 [{ Φ }]) False | 200.
+  Proof. intros []. Qed.
+
+  Global Instance add_modal_fupd_twp s E e P Φ :
+    AddModal (|={E}=> P) P (WP e @ s; E [{ Φ }]).
+  Proof. by rewrite /AddModal fupd_frame_r wand_elim_r fupd_twp. Qed.
+
+  Global Instance elim_acc_twp_atomic {X} E1 E2 α β γ e s Φ :
+    ElimAcc (X:=X) (Atomic (stuckness_to_atomicity s) e)
+            (fupd E1 E2) (fupd E2 E1)
+            α β γ (WP e @ s; E1 [{ Φ }])
+            (λ x, WP e @ s; E2 [{ v, |={E2}=> β x ∗ (γ x -∗? Φ v) }])%I | 100.
+  Proof.
+    iIntros (?) "Hinner >Hacc". iDestruct "Hacc" as (x) "[Hα Hclose]".
+    iApply (twp_wand with "(Hinner Hα)").
+    iIntros (v) ">[Hβ HΦ]". iApply "HΦ". by iApply "Hclose".
+  Qed.
+End proofmode_classes.

iris/program_logic/weakestpre.v

+From iris.proofmode Require Import base proofmode classes.
+From iris.base_logic.lib Require Export fancy_updates.
+From iris.program_logic Require Export language.
+(* FIXME: If we import iris.bi.weakestpre earlier texan triples do not
+   get pretty-printed correctly. *)
+From iris.bi Require Export weakestpre.
+From iris.prelude Require Import options.
+Import uPred.
+
+Class irisGS_gen (hlc : has_lc) (Λ : language) (Σ : gFunctors) := IrisG {
+  #[global] iris_invGS :: invGS_gen hlc Σ;
+
+  (** The state interpretation is an invariant that should hold in
+  between each step of reduction. Here [Λstate] is the global state,
+  the first [nat] is the number of steps already performed by the
+  program, [list (observation Λ)] are the remaining observations, and the
+  last [nat] is the number of forked-off threads (not the total number
+  of threads, which is one higher because there is always a main
+  thread). *)
+  state_interp : state Λ → nat → list (observation Λ) → nat → iProp Σ;
+
+  (** A fixed postcondition for any forked-off thread. For most languages, e.g.
+  heap_lang, this will simply be [True]. However, it is useful if one wants to
+  keep track of resources precisely, as in e.g. Iron. *)
+  fork_post : val Λ → iProp Σ;
+
+  (** The number of additional logical steps (i.e., later modality in the
+  definition of WP) and later credits per physical step is
+  [S (num_laters_per_step ns)], where [ns] is the number of physical steps
+  executed so far. We add one to [num_laters_per_step] to ensure that there
+  is always at least one later and later credit for each physical step. *)
+  num_laters_per_step : nat → nat;
+
+  (** When performing pure steps, the state interpretation needs to be
+  adapted for the change in the [ns] parameter.
+
+  Note that we use an empty-mask fancy update here. We could also use
+  a basic update or a bare magic wand, the expressiveness of the
+  framework would be the same. If we removed the modality here, then
+  the client would have to include the modality it needs as part of
+  the definition of [state_interp]. Since adding the modality as part
+  of the definition [state_interp_mono] does not significantly
+  complicate the formalization in Iris, we prefer simplifying the
+  client. *)
+  state_interp_mono σ ns κs nt:
+    state_interp σ ns κs nt ⊢ |={∅}=> state_interp σ (S ns) κs nt
+}.
+Global Opaque iris_invGS.
+Global Arguments IrisG {hlc Λ Σ}.
+
+Notation irisGS := (irisGS_gen HasLc).
+
+(** The predicate we take the fixpoint of in order to define the WP. *)
+(** In the step case, we both provide [S (num_laters_per_step ns)]
+  later credits, as well as an iterated update modality that allows
+  stripping as many laters, where [ns] is the number of steps already taken.
+  We have both as each of these provides distinct advantages:
+  - Later credits do not have to be used right away, but can be kept to
+    eliminate laters at a later point.
+  - The step-taking update composes well in parallel: we can independently
+    compose two clients who want to eliminate their laters for the same
+    physical step, which is not possible with later credits, as they
+    can only be used by exactly one client.
+  - The step-taking update can even be used by clients that opt out of
+    later credits, e.g. because they use [BiFUpdPlainly]. *)
+Definition wp_pre `{!irisGS_gen hlc Λ Σ} (s : stuckness)
+    (wp : coPset -d> expr Λ -d> (val Λ -d> iPropO Σ) -d> iPropO Σ) :
+    coPset -d> expr Λ -d> (val Λ -d> iPropO Σ) -d> iPropO Σ := λ E e1 Φ,
+  match to_val e1 with
+  | Some v => |={E}=> Φ v
+  | None => ∀ σ1 ns κ κs nt,
+     state_interp σ1 ns (κ ++ κs) nt ={E,∅}=∗
+       ⌜if s is NotStuck then reducible e1 σ1 else True⌝ ∗
+       ∀ e2 σ2 efs, ⌜prim_step e1 σ1 κ e2 σ2 efs⌝ -∗
+         £ (S (num_laters_per_step ns))
+         ={∅}▷=∗^(S $ num_laters_per_step ns) |={∅,E}=>
+         state_interp σ2 (S ns) κs (length efs + nt) ∗
+         wp E e2 Φ ∗
+         [∗ list] i ↦ ef ∈ efs, wp ⊤ ef fork_post
+  end%I.
+
+Local Instance wp_pre_contractive `{!irisGS_gen hlc Λ Σ} s : Contractive (wp_pre s).
+Proof.
+  rewrite /wp_pre /= => n wp wp' Hwp E e1 Φ.
+  do 25 (f_contractive || f_equiv).
+  (* FIXME : simplify this proof once we have a good definition and a
+     proper instance for step_fupdN. *)
+  induction num_laters_per_step as [|k IH]; simpl.
+  - repeat (f_contractive || f_equiv); apply Hwp.
+  - by rewrite -IH.
+Qed.
+
+Local Definition wp_def `{!irisGS_gen hlc Λ Σ} : Wp (iProp Σ) (expr Λ) (val Λ) stuckness :=
+  λ s : stuckness, fixpoint (wp_pre s).
+Local Definition wp_aux : seal (@wp_def). Proof. by eexists. Qed.
+Definition wp' := wp_aux.(unseal).
+Global Arguments wp' {hlc Λ Σ _}.
+Global Existing Instance wp'.
+Local Lemma wp_unseal `{!irisGS_gen hlc Λ Σ} : wp = @wp_def hlc Λ Σ _.
+Proof. rewrite -wp_aux.(seal_eq) //. Qed.
+
+Section wp.
+Context `{!irisGS_gen hlc Λ Σ}.
+Implicit Types s : stuckness.
+Implicit Types P : iProp Σ.
+Implicit Types Φ : val Λ → iProp Σ.
+Implicit Types v : val Λ.
+Implicit Types e : expr Λ.
+
+(* Weakest pre *)
+Lemma wp_unfold s E e Φ :
+  WP e @ s; E {{ Φ }} ⊣⊢ wp_pre s (wp (PROP:=iProp Σ) s) E e Φ.
+Proof. rewrite wp_unseal. apply (fixpoint_unfold (wp_pre s)). Qed.
+
+Global Instance wp_ne s E e n :
+  Proper (pointwise_relation _ (dist n) ==> dist n) (wp (PROP:=iProp Σ) s E e).
+Proof.
+  revert e. induction (lt_wf n) as [n _ IH]=> e Φ Ψ HΦ.
+  rewrite !wp_unfold /wp_pre /=.
+  (* FIXME: figure out a way to properly automate this proof *)
+  (* FIXME: reflexivity, as being called many times by f_equiv and f_contractive
+  is very slow here *)
+  do 25 (f_contractive || f_equiv).
+  (* FIXME : simplify this proof once we have a good definition and a
+     proper instance for step_fupdN. *)
+  induction num_laters_per_step as [|k IHk]; simpl; last by rewrite IHk.
+  rewrite IH; [done..|]. intros v. eapply dist_lt; last done. apply HΦ.
+Qed.
+Global Instance wp_proper s E e :
+  Proper (pointwise_relation _ (≡) ==> (≡)) (wp (PROP:=iProp Σ) s E e).
+Proof.
+  by intros Φ Φ' ?; apply equiv_dist=>n; apply wp_ne=>v; apply equiv_dist.
+Qed.
+Global Instance wp_contractive s E e n :
+  TCEq (to_val e) None →
+  Proper (pointwise_relation _ (dist_later n) ==> dist n) (wp (PROP:=iProp Σ) s E e).
+Proof.
+  intros He Φ Ψ HΦ. rewrite !wp_unfold /wp_pre He /=.
+  do 24 (f_contractive || f_equiv).
+  (* FIXME : simplify this proof once we have a good definition and a
+     proper instance for step_fupdN. *)
+  induction num_laters_per_step as [|k IHk]; simpl; last by rewrite IHk.
+  by do 4 f_equiv.
+Qed.
+
+Lemma wp_value_fupd' s E Φ v : WP of_val v @ s; E {{ Φ }} ⊣⊢ |={E}=> Φ v.
+Proof. rewrite wp_unfold /wp_pre to_of_val. auto. Qed.
+
+Lemma wp_strong_mono s1 s2 E1 E2 e Φ Ψ :
+  s1 ⊑ s2 → E1 ⊆ E2 →
+  WP e @ s1; E1 {{ Φ }} -∗ (∀ v, Φ v ={E2}=∗ Ψ v) -∗ WP e @ s2; E2 {{ Ψ }}.
+Proof.
+  iIntros (? HE) "H HΦ". iLöb as "IH" forall (e E1 E2 HE Φ Ψ).
+  rewrite !wp_unfold /wp_pre /=.
+  destruct (to_val e) as [v|] eqn:?.
+  { iApply ("HΦ" with "[> -]"). by iApply (fupd_mask_mono E1 _). }
+  iIntros (σ1 ns κ κs nt) "Hσ".
+  iMod (fupd_mask_subseteq E1) as "Hclose"; first done.
+  iMod ("H" with "[$]") as "[% H]".
+  iModIntro. iSplit; [by destruct s1, s2|]. iIntros (e2 σ2 efs Hstep) "Hcred".
+  iMod ("H" with "[//] Hcred") as "H". iIntros "!> !>".  iMod "H". iModIntro.
+  iApply (step_fupdN_wand with "[H]"); first by iApply "H".
+  iIntros ">($ & H & Hefs)". iMod "Hclose" as "_". iModIntro. iSplitR "Hefs".
+  - iApply ("IH" with "[//] H HΦ").
+  - iApply (big_sepL_impl with "Hefs"); iIntros "!>" (k ef _).
+    iIntros "H". iApply ("IH" with "[] H"); auto.
+Qed.
+
+Lemma fupd_wp s E e Φ : (|={E}=> WP e @ s; E {{ Φ }}) ⊢ WP e @ s; E {{ Φ }}.
+Proof.
+  rewrite wp_unfold /wp_pre. iIntros "H". destruct (to_val e) as [v|] eqn:?.
+  { by iMod "H". }
+  iIntros (σ1 ns κ κs nt) "Hσ1". iMod "H". by iApply "H".
+Qed.
+Lemma wp_fupd s E e Φ : WP e @ s; E {{ v, |={E}=> Φ v }} ⊢ WP e @ s; E {{ Φ }}.
+Proof. iIntros "H". iApply (wp_strong_mono s s E with "H"); auto. Qed.
+
+Lemma wp_atomic s E1 E2 e Φ `{!Atomic (stuckness_to_atomicity s) e} :
+  (|={E1,E2}=> WP e @ s; E2 {{ v, |={E2,E1}=> Φ v }}) ⊢ WP e @ s; E1 {{ Φ }}.
+Proof.
+  iIntros "H". rewrite !wp_unfold /wp_pre.
+  destruct (to_val e) as [v|] eqn:He.
+  { by iDestruct "H" as ">>> $". }
+  iIntros (σ1 ns κ κs nt) "Hσ". iMod "H". iMod ("H" $! σ1 with "Hσ") as "[$ H]".
+  iModIntro. iIntros (e2 σ2 efs Hstep) "Hcred".
+  iApply (step_fupdN_wand with "(H [//] Hcred)").
+  iIntros ">(Hσ & H & Hefs)". destruct s.
+  - rewrite !wp_unfold /wp_pre. destruct (to_val e2) as [v2|] eqn:He2.
+    + iDestruct "H" as ">> $". by iFrame.
+    + iMod ("H" $! _ _ [] with "[$]") as "[H _]". iDestruct "H" as %(? & ? & ? & ? & ?).
+      by edestruct (atomic _ _ _ _ _ Hstep).
+  - destruct (atomic _ _ _ _ _ Hstep) as [v <-%of_to_val].
+    rewrite wp_value_fupd'. iMod "H" as ">H".
+    iModIntro. iFrame "Hσ Hefs". by iApply wp_value_fupd'.
+Qed.
+
+(** This lemma gives us access to the later credits that are generated in each step,
+  assuming that we have instantiated [num_laters_per_step] with a non-trivial (e.g. linear)
+  function.
+  This lemma can be used to provide a "regeneration" mechanism for later credits.
+  [state_interp] will have to be defined in a way that involves the required regneration
+  tokens. TODO: point to an example of how this is used.
+
+  In detail, a client can use this lemma as follows:
+  * the client obtains the state interpretation [state_interp _ ns _ _],
+  * it uses some ghost state wired up to the interpretation to know that
+    [ns = k + m], and update the state interpretation to [state_interp _ m _ _],
+  * _after_ [e] has finally stepped, we get [num_laters_per_step k] later credits
+    that we can use to prove [P] in the postcondition, and we have to update
+    the state interpretation from [state_interp _ (S m) _ _] to
+    [state_interp _ (S ns) _ _] again. *)
+Lemma wp_credit_access s E e Φ P :
+  TCEq (to_val e) None →
+  (∀ m k, num_laters_per_step m + num_laters_per_step k ≤ num_laters_per_step (m + k)) →
+  (∀ σ1 ns κs nt, state_interp σ1 ns κs nt ={E}=∗
+    ∃ k m, state_interp σ1 m κs nt ∗ ⌜ns = (m + k)%nat⌝ ∗
+    (∀ nt σ2 κs, £ (num_laters_per_step k) -∗ state_interp σ2 (S m) κs nt ={E}=∗
+      state_interp σ2 (S ns) κs nt ∗ P)) -∗
+  WP e @ s; E {{ v, P ={E}=∗ Φ v }} -∗
+  WP e @ s; E {{ Φ }}.
+Proof.
+  rewrite !wp_unfold /wp_pre /=. iIntros (-> Htri) "Hupd Hwp".
+  iIntros (σ1 ns κ κs nt) "Hσ1".
+  iMod ("Hupd" with "Hσ1") as (k m) "(Hσ1 & -> & Hpost)".
+  iMod ("Hwp" with "Hσ1") as "[$ Hwp]". iModIntro.
+  iIntros (e2 σ2 efs Hstep) "Hc".
+  iDestruct "Hc" as "[Hone Hc]".
+  iPoseProof (lc_weaken with "Hc") as "Hc"; first apply Htri.
+  iDestruct "Hc" as "[Hm Hk]".
+  iCombine "Hone Hm" as "Hm".
+  iApply (step_fupd_wand with "(Hwp [//] Hm)"). iIntros "Hwp".
+  iApply (step_fupdN_le (num_laters_per_step m)); [ | done | ].
+  { etrans; last apply Htri. lia. }
+  iApply (step_fupdN_wand with "Hwp"). iIntros ">(SI & Hwp & $)".
+  iMod ("Hpost" with "Hk SI") as "[$ HP]". iModIntro.
+  iApply (wp_strong_mono with "Hwp"); [by auto..|].
+  iIntros (v) "HΦ". iApply ("HΦ" with "HP").
+Qed.
+
+(** In this stronger version of [wp_step_fupdN], the masks in the
+   step-taking fancy update are a bit weird and somewhat difficult to
+   use in practice. Hence, we prove it for the sake of completeness,
+   but [wp_step_fupdN] is just a little bit weaker, suffices in
+   practice and is easier to use.
+
+   See the statement of [wp_step_fupdN] below to understand the use of
+   ordinary conjunction here. *)
+Lemma wp_step_fupdN_strong n s E1 E2 e P Φ :
+  TCEq (to_val e) None → E2 ⊆ E1 →
+  (∀ σ ns κs nt, state_interp σ ns κs nt
+       ={E1,∅}=∗ ⌜n ≤ S (num_laters_per_step ns)⌝) ∧
+  ((|={E1,E2}=> |={∅}▷=>^n |={E2,E1}=> P) ∗
+    WP e @ s; E2 {{ v, P ={E1}=∗ Φ v }}) -∗
+  WP e @ s; E1 {{ Φ }}.
+Proof.
+  destruct n as [|n].
+  { iIntros (_ ?) "/= [_ [HP Hwp]]".
+    iApply (wp_strong_mono with "Hwp"); [done..|].
+    iIntros (v) "H". iApply ("H" with "[>HP]"). by do 2 iMod "HP". }
+  rewrite !wp_unfold /wp_pre /=. iIntros (-> ?) "H".
+  iIntros (σ1 ns κ κs nt) "Hσ".
+  destruct (decide (n ≤ num_laters_per_step ns)) as [Hn|Hn]; first last.
+  { iDestruct "H" as "[Hn _]". iMod ("Hn" with "Hσ") as %?. lia. }
+  iDestruct "H" as "[_ [>HP Hwp]]". iMod ("Hwp" with "[$]") as "[$ H]". iMod "HP".
+  iIntros "!>" (e2 σ2 efs Hstep) "Hcred". iMod ("H" $! e2 σ2 efs with "[% //] Hcred") as "H".
+  iIntros "!>!>". iMod "H". iMod "HP". iModIntro.
+  revert n Hn. generalize (num_laters_per_step ns)=>n0 n Hn.
+  iInduction n as [|n IH] forall (n0 Hn).
+  - iApply (step_fupdN_wand with "H"). iIntros ">($ & Hwp & $)". iMod "HP".
+    iModIntro. iApply (wp_strong_mono with "Hwp"); [done|set_solver|].
+    iIntros (v) "HΦ". iApply ("HΦ" with "HP").
+  - destruct n0 as [|n0]; [lia|]=>/=. iMod "HP". iMod "H". iIntros "!> !>".
+    iMod "HP". iMod "H". iModIntro. iApply ("IH" with "[] HP H").
+    auto with lia.
+Qed.
+
+Lemma wp_bind K `{!LanguageCtx K} s E e Φ :
+  WP e @ s; E {{ v, WP K (of_val v) @ s; E {{ Φ }} }} ⊢ WP K e @ s; E {{ Φ }}.
+Proof.
+  iIntros "H". iLöb as "IH" forall (E e Φ). rewrite wp_unfold /wp_pre.
+  destruct (to_val e) as [v|] eqn:He.
+  { apply of_to_val in He as <-. by iApply fupd_wp. }
+  rewrite wp_unfold /wp_pre fill_not_val /=; [|done].
+  iIntros (σ1 step κ κs n) "Hσ". iMod ("H" with "[$]") as "[% H]".
+  iModIntro; iSplit.
+  { destruct s; eauto using reducible_fill. }
+  iIntros (e2 σ2 efs Hstep) "Hcred".
+  destruct (fill_step_inv e σ1 κ e2 σ2 efs) as (e2'&->&?); auto.
+  iMod ("H" $! e2' σ2 efs with "[//] Hcred") as "H". iIntros "!>!>".
+  iMod "H". iModIntro. iApply (step_fupdN_wand with "H"). iIntros "H".
+  iMod "H" as "($ & H & $)". iModIntro. by iApply "IH".
+Qed.
+
+Lemma wp_bind_inv K `{!LanguageCtx K} s E e Φ :
+  WP K e @ s; E {{ Φ }} ⊢ WP e @ s; E {{ v, WP K (of_val v) @ s; E {{ Φ }} }}.
+Proof.
+  iIntros "H". iLöb as "IH" forall (E e Φ). rewrite !wp_unfold /wp_pre /=.
+  destruct (to_val e) as [v|] eqn:He.
+  { apply of_to_val in He as <-. by rewrite !wp_unfold /wp_pre. }
+  rewrite fill_not_val //.
+  iIntros (σ1 ns κ κs nt) "Hσ". iMod ("H" with "[$]") as "[% H]".
+  iModIntro; iSplit.
+  { destruct s; eauto using reducible_fill_inv. }
+  iIntros (e2 σ2 efs Hstep) "Hcred".
+  iMod ("H" $! _ _ _ with "[] Hcred") as "H"; first eauto using fill_step.
+  iIntros "!> !>". iMod "H". iModIntro. iApply (step_fupdN_wand with "H").
+  iIntros "H". iMod "H" as "($ & H & $)". iModIntro. by iApply "IH".
+Qed.
+
+(** * Derived rules *)
+Lemma wp_mono s E e Φ Ψ : (∀ v, Φ v ⊢ Ψ v) → WP e @ s; E {{ Φ }} ⊢ WP e @ s; E {{ Ψ }}.
+Proof.
+  iIntros (HΦ) "H"; iApply (wp_strong_mono with "H"); auto.
+  iIntros (v) "?". by iApply HΦ.
+Qed.
+Lemma wp_stuck_mono s1 s2 E e Φ :
+  s1 ⊑ s2 → WP e @ s1; E {{ Φ }} ⊢ WP e @ s2; E {{ Φ }}.
+Proof. iIntros (?) "H". iApply (wp_strong_mono with "H"); auto. Qed.
+Lemma wp_stuck_weaken s E e Φ :
+  WP e @ s; E {{ Φ }} ⊢ WP e @ E ?{{ Φ }}.
+Proof. apply wp_stuck_mono. by destruct s. Qed.
+Lemma wp_mask_mono s E1 E2 e Φ : E1 ⊆ E2 → WP e @ s; E1 {{ Φ }} ⊢ WP e @ s; E2 {{ Φ }}.
+Proof. iIntros (?) "H"; iApply (wp_strong_mono with "H"); auto. Qed.
+Global Instance wp_mono' s E e :
+  Proper (pointwise_relation _ (⊢) ==> (⊢)) (wp (PROP:=iProp Σ) s E e).
+Proof. by intros Φ Φ' ?; apply wp_mono. Qed.
+Global Instance wp_flip_mono' s E e :
+  Proper (pointwise_relation _ (flip (⊢)) ==> (flip (⊢))) (wp (PROP:=iProp Σ) s E e).
+Proof. by intros Φ Φ' ?; apply wp_mono. Qed.
+
+Lemma wp_value_fupd s E Φ e v : IntoVal e v → WP e @ s; E {{ Φ }} ⊣⊢ |={E}=> Φ v.
+Proof. intros <-. by apply wp_value_fupd'. Qed.
+Lemma wp_value' s E Φ v : Φ v ⊢ WP (of_val v) @ s; E {{ Φ }}.
+Proof. rewrite wp_value_fupd'. auto. Qed.
+Lemma wp_value s E Φ e v : IntoVal e v → Φ v ⊢ WP e @ s; E {{ Φ }}.
+Proof. intros <-. apply wp_value'. Qed.
+
+Lemma wp_frame_l s E e Φ R : R ∗ WP e @ s; E {{ Φ }} ⊢ WP e @ s; E {{ v, R ∗ Φ v }}.
+Proof. iIntros "[? H]". iApply (wp_strong_mono with "H"); auto with iFrame. Qed.
+Lemma wp_frame_r s E e Φ R : WP e @ s; E {{ Φ }} ∗ R ⊢ WP e @ s; E {{ v, Φ v ∗ R }}.
+Proof. iIntros "[H ?]". iApply (wp_strong_mono with "H"); auto with iFrame. Qed.
+
+(** This lemma states that if we can prove that [n] laters are used in
+   the current physical step, then one can perform an n-steps fancy
+   update during that physical step. The resources needed to prove the
+   bound on [n] are not used up: they can be reused in the proof of
+   the WP or in the proof of the n-steps fancy update. In order to
+   describe this unusual resource flow, we use ordinary conjunction as
+   a premise. *)
+Lemma wp_step_fupdN n s E1 E2 e P Φ :
+  TCEq (to_val e) None → E2 ⊆ E1 →
+  (∀ σ ns κs nt, state_interp σ ns κs nt
+       ={E1,∅}=∗ ⌜n ≤ S (num_laters_per_step ns)⌝) ∧
+  ((|={E1∖E2,∅}=> |={∅}▷=>^n |={∅,E1∖E2}=> P) ∗
+    WP e @ s; E2 {{ v, P ={E1}=∗ Φ v }}) -∗
+  WP e @ s; E1 {{ Φ }}.
+Proof.
+  iIntros (??) "H". iApply (wp_step_fupdN_strong with "[H]"); [done|].
+  iApply (and_mono_r with "H"). apply sep_mono_l. iIntros "HP".
+  iMod fupd_mask_subseteq_emptyset_difference as "H"; [|iMod "HP"]; [set_solver|].
+  iMod "H" as "_". replace (E1 ∖ (E1 ∖ E2)) with E2; last first.
+  { set_unfold=>x. destruct (decide (x ∈ E2)); naive_solver. }
+  iModIntro. iApply (step_fupdN_wand with "HP"). iIntros "H".
+  iApply fupd_mask_frame; [|iMod "H"; iModIntro]; [set_solver|].
+  by rewrite difference_empty_L (comm_L (∪)) -union_difference_L.
+Qed.
+Lemma wp_step_fupd s E1 E2 e P Φ :
+  TCEq (to_val e) None → E2 ⊆ E1 →
+  (|={E1}[E2]▷=> P) -∗ WP e @ s; E2 {{ v, P ={E1}=∗ Φ v }} -∗ WP e @ s; E1 {{ Φ }}.
+Proof.
+  iIntros (??) "HR H".
+  iApply (wp_step_fupdN_strong 1 _ E1 E2 with "[-]"); [done|..]. iSplit.
+  - iIntros (????) "_". iMod (fupd_mask_subseteq ∅) as "_"; [set_solver+|].
+    auto with lia.
+  - iFrame "H". iMod "HR" as "$". auto.
+Qed.
+
+Lemma wp_frame_step_l s E1 E2 e Φ R :
+  TCEq (to_val e) None → E2 ⊆ E1 →
+  (|={E1}[E2]▷=> R) ∗ WP e @ s; E2 {{ Φ }} ⊢ WP e @ s; E1 {{ v, R ∗ Φ v }}.
+Proof.
+  iIntros (??) "[Hu Hwp]". iApply (wp_step_fupd with "Hu"); try done.
+  iApply (wp_mono with "Hwp"). by iIntros (?) "$$".
+Qed.
+Lemma wp_frame_step_r s E1 E2 e Φ R :
+  TCEq (to_val e) None → E2 ⊆ E1 →
+  WP e @ s; E2 {{ Φ }} ∗ (|={E1}[E2]▷=> R) ⊢ WP e @ s; E1 {{ v, Φ v ∗ R }}.
+Proof.
+  rewrite [(WP _ @ _; _ {{ _ }} ∗ _)%I]comm; setoid_rewrite (comm _ _ R).
+  apply wp_frame_step_l.
+Qed.
+Lemma wp_frame_step_l' s E e Φ R :
+  TCEq (to_val e) None → ▷ R ∗ WP e @ s; E {{ Φ }} ⊢ WP e @ s; E {{ v, R ∗ Φ v }}.
+Proof. iIntros (?) "[??]". iApply (wp_frame_step_l s E E); try iFrame; eauto. Qed.
+Lemma wp_frame_step_r' s E e Φ R :
+  TCEq (to_val e) None → WP e @ s; E {{ Φ }} ∗ ▷ R ⊢ WP e @ s; E {{ v, Φ v ∗ R }}.
+Proof. iIntros (?) "[??]". iApply (wp_frame_step_r s E E); try iFrame; eauto. Qed.
+
+Lemma wp_wand s E e Φ Ψ :
+  WP e @ s; E {{ Φ }} -∗ (∀ v, Φ v -∗ Ψ v) -∗ WP e @ s; E {{ Ψ }}.
+Proof.
+  iIntros "Hwp H". iApply (wp_strong_mono with "Hwp"); auto.
+  iIntros (?) "?". by iApply "H".
+Qed.
+Lemma wp_wand_l s E e Φ Ψ :
+  (∀ v, Φ v -∗ Ψ v) ∗ WP e @ s; E {{ Φ }} ⊢ WP e @ s; E {{ Ψ }}.
+Proof. iIntros "[H Hwp]". iApply (wp_wand with "Hwp H"). Qed.
+Lemma wp_wand_r s E e Φ Ψ :
+  WP e @ s; E {{ Φ }} ∗ (∀ v, Φ v -∗ Ψ v) ⊢ WP e @ s; E {{ Ψ }}.
+Proof. iIntros "[Hwp H]". iApply (wp_wand with "Hwp H"). Qed.
+Lemma wp_frame_wand s E e Φ R :
+  R -∗ WP e @ s; E {{ v, R -∗ Φ v }} -∗ WP e @ s; E {{ Φ }}.
+Proof.
+  iIntros "HR HWP". iApply (wp_wand with "HWP").
+  iIntros (v) "HΦ". by iApply "HΦ".
+Qed.
+End wp.
+
+(** Proofmode class instances *)
+Section proofmode_classes.
+  Context `{!irisGS_gen hlc Λ Σ}.
+  Implicit Types P Q : iProp Σ.
+  Implicit Types Φ : val Λ → iProp Σ.
+  Implicit Types v : val Λ.
+  Implicit Types e : expr Λ.
+
+  Global Instance frame_wp p s E e R Φ Ψ :
+    (FrameInstantiateExistDisabled → ∀ v, Frame p R (Φ v) (Ψ v)) →
+    Frame p R (WP e @ s; E {{ Φ }}) (WP e @ s; E {{ Ψ }}) | 2.
+  Proof.
+    rewrite /Frame=> HR. rewrite wp_frame_l. apply wp_mono, HR. constructor.
+  Qed.
+
+  Global Instance is_except_0_wp s E e Φ : IsExcept0 (WP e @ s; E {{ Φ }}).
+  Proof. by rewrite /IsExcept0 -{2}fupd_wp -except_0_fupd -fupd_intro. Qed.
+
+  Global Instance elim_modal_bupd_wp p s E e P Φ :
+    ElimModal True p false (|==> P) P (WP e @ s; E {{ Φ }}) (WP e @ s; E {{ Φ }}).
+  Proof.
+    by rewrite /ElimModal intuitionistically_if_elim
+      (bupd_fupd E) fupd_frame_r wand_elim_r fupd_wp.
+  Qed.
+
+  Global Instance elim_modal_fupd_wp p s E e P Φ :
+    ElimModal True p false (|={E}=> P) P (WP e @ s; E {{ Φ }}) (WP e @ s; E {{ Φ }}).
+  Proof.
+    by rewrite /ElimModal intuitionistically_if_elim
+      fupd_frame_r wand_elim_r fupd_wp.
+  Qed.
+  (** Error message instance for non-mask-changing view shifts.
+  Also uses a slightly different error: we cannot apply [fupd_mask_subseteq]
+  if [e] is not atomic, so we tell the user to first add a leading [fupd]
+  and then change the mask of that. *)
+  Global Instance elim_modal_fupd_wp_wrong_mask p s E1 E2 e P Φ :
+    ElimModal
+      (pm_error "Goal and eliminated modality must have the same mask.
+Use [iApply fupd_wp; iMod (fupd_mask_subseteq E2)] to adjust the mask of your goal to [E2]")
+      p false
+      (|={E2}=> P) False (WP e @ s; E1 {{ Φ }}) False | 100.
+  Proof. intros []. Qed.
+
+  Global Instance elim_modal_fupd_wp_atomic p s E1 E2 e P Φ :
+    ElimModal (Atomic (stuckness_to_atomicity s) e) p false
+            (|={E1,E2}=> P) P
+            (WP e @ s; E1 {{ Φ }}) (WP e @ s; E2 {{ v, |={E2,E1}=> Φ v }})%I | 100.
+  Proof.
+    intros ?. by rewrite intuitionistically_if_elim
+      fupd_frame_r wand_elim_r wp_atomic.
+  Qed.
+  (** Error message instance for mask-changing view shifts. *)
+  Global Instance elim_modal_fupd_wp_atomic_wrong_mask p s E1 E2 E2' e P Φ :
+    ElimModal
+      (pm_error "Goal and eliminated modality must have the same mask.
+Use [iMod (fupd_mask_subseteq E2)] to adjust the mask of your goal to [E2]")
+      p false
+      (|={E2,E2'}=> P) False
+      (WP e @ s; E1 {{ Φ }}) False | 200.
+  Proof. intros []. Qed.
+
+  Global Instance add_modal_fupd_wp s E e P Φ :
+    AddModal (|={E}=> P) P (WP e @ s; E {{ Φ }}).
+  Proof. by rewrite /AddModal fupd_frame_r wand_elim_r fupd_wp. Qed.
+
+  Global Instance elim_acc_wp_atomic {X} E1 E2 α β γ e s Φ :
+    ElimAcc (X:=X) (Atomic (stuckness_to_atomicity s) e)
+            (fupd E1 E2) (fupd E2 E1)
+            α β γ (WP e @ s; E1 {{ Φ }})
+            (λ x, WP e @ s; E2 {{ v, |={E2}=> β x ∗ (γ x -∗? Φ v) }})%I | 100.
+  Proof.
+    iIntros (?) "Hinner >Hacc". iDestruct "Hacc" as (x) "[Hα Hclose]".
+    iApply (wp_wand with "(Hinner Hα)").
+    iIntros (v) ">[Hβ HΦ]". iApply "HΦ". by iApply "Hclose".
+  Qed.
+
+  Global Instance elim_acc_wp_nonatomic {X} E α β γ e s Φ :
+    ElimAcc (X:=X) True (fupd E E) (fupd E E)
+            α β γ (WP e @ s; E {{ Φ }})
+            (λ x, WP e @ s; E {{ v, |={E}=> β x ∗ (γ x -∗? Φ v) }})%I.
+  Proof.
+    iIntros (_) "Hinner >Hacc". iDestruct "Hacc" as (x) "[Hα Hclose]".
+    iApply wp_fupd.
+    iApply (wp_wand with "(Hinner Hα)").
+    iIntros (v) ">[Hβ HΦ]". iApply "HΦ". by iApply "Hclose".
+  Qed.
+End proofmode_classes.

iris/proofmode/base.v

+From Coq Require Export Ascii.
+From stdpp Require Export strings.
+From iris.prelude Require Export prelude.
+From iris.prelude Require Import options.
+From Ltac2 Require Ltac2.
+
+(** * Utility definitions used by the proofmode *)
+
+(** ** N-ary tactics *)
+(** Ltac1 does not provide primitives to manipulate lists (e.g., [ident_list],
+[simple_intropattern_list]), needed for [iIntros], [iDestruct], etc. We can do
+that in Ltac2. For most proofmode tactics we only need to iterate over a list
+(either in forward or backward direction). The Ltac1 tactics [ltac1_list_iter]
+and [ltac1_list_rev_iter] allow us to do that while encapsulating the Ltac2
+code. These tactics can be used as:
+
+  Ltac _iTactic xs :=
+    ltac1_list_iter ltac:(fun x => /* stuff */) xs.
+  Tactic Notation "iTactic" "(" ne_ident_list(xs) ")" :=
+    _iTactic xs.
+
+It is important to note that given one n-ary [Tactic Notation] we cannot call
+another n-ary [Tactic Notation]. For example, the following does NOT work:
+
+  Tactic Notation "iAnotherTactic" "(" ne_ident_list(xs) ")" :=
+    /* stuff */
+    iTactic (xs).
+
+Because of this reason, as already shown above, we typically provide an [Ltac]
+called [_iTactic] (note the underscore to mark it is "private"), and define the
+[Tactic Notation] as a wrapper, allowing us to write:
+
+  Tactic Notation "iAnotherTactic" "(" ne_ident_list(xs) ")" :=
+    /* stuff */
+    _iTactic xs.
+*)
+
+Ltac2 of_ltac1_list l := Option.get (Ltac1.to_list l).
+
+Ltac ltac1_list_iter tac l :=
+  let go := ltac2:(tac l |- List.iter (ltac1:(tac x |- tac x) tac)
+                                      (of_ltac1_list l)) in
+  go tac l.
+
+Ltac ltac1_list_rev_iter tac l :=
+  let go := ltac2:(tac l |- List.iter (ltac1:(tac x |- tac x) tac)
+                                      (List.rev (of_ltac1_list l))) in
+  go tac l.
+
+(** Since the Ltac1-Ltac2 API only supports unit-returning functions, there is
+no nice way to produce an empty list in ltac1. We therefore often define a
+special version [_iTactic0] for the empty list. This version can be created
+using [with_ltac1_nil]:
+
+  Ltac _iTactic0 := with_ltac1_nil ltac:(fun xs => _iTactic xs)
+*)
+Ltac with_ltac1_nil tac :=
+  let go := ltac2:(tac |- ltac1:(tac l |- tac l) tac (Ltac1.of_list [])) in
+  go tac.
+
+(* Directions of rewrites *)
+Inductive direction := Left | Right.
+
+Local Open Scope lazy_bool_scope.
+
+(* Some specific versions of operations on strings, booleans, positive for the
+proof mode. We need those so that we can make [cbv] unfold just them, but not
+the actual operations that may appear in users' proofs. *)
+
+Lemma lazy_andb_true (b1 b2 : bool) : b1 &&& b2 = true ↔ b1 = true ∧ b2 = true.
+Proof. destruct b1, b2; intuition congruence. Qed.
+
+Definition negb (b : bool) : bool := if b then false else true.
+Lemma negb_true b : negb b = true ↔ b = false.
+Proof. by destruct b. Qed.
+
+Fixpoint Pos_succ (x : positive) : positive :=
+  match x with
+  | (p~1)%positive => ((Pos_succ p)~0)%positive
+  | (p~0)%positive => (p~1)%positive
+  | 1%positive => 2%positive
+  end.
+
+Definition beq (b1 b2 : bool) : bool :=
+  match b1, b2 with
+  | false, false | true, true => true
+  | _, _ => false
+  end.
+
+Definition ascii_beq (x y : ascii) : bool :=
+  let 'Ascii x1 x2 x3 x4 x5 x6 x7 x8 := x in
+  let 'Ascii y1 y2 y3 y4 y5 y6 y7 y8 := y in
+  beq x1 y1 &&& beq x2 y2 &&& beq x3 y3 &&& beq x4 y4 &&&
+    beq x5 y5 &&& beq x6 y6 &&& beq x7 y7 &&& beq x8 y8.
+
+Fixpoint string_beq (s1 s2 : string) : bool :=
+  match s1, s2 with
+  | "", "" => true
+  | String a1 s1, String a2 s2 => ascii_beq a1 a2 &&& string_beq s1 s2
+  | _, _ => false
+  end.
+
+Lemma beq_true b1 b2 : beq b1 b2 = true ↔ b1 = b2.
+Proof. destruct b1, b2; simpl; intuition congruence. Qed.
+
+Lemma ascii_beq_true x y : ascii_beq x y = true ↔ x = y.
+Proof.
+  destruct x, y; rewrite /= !lazy_andb_true !beq_true. intuition congruence.
+Qed.
+
+Lemma string_beq_true s1 s2 : string_beq s1 s2 = true ↔ s1 = s2.
+Proof.
+  revert s2. induction s1 as [|x s1 IH]=> -[|y s2] //=.
+  rewrite lazy_andb_true ascii_beq_true IH. intuition congruence.
+Qed.
+
+Lemma string_beq_reflect s1 s2 : reflect (s1 = s2) (string_beq s1 s2).
+Proof. apply iff_reflect. by rewrite string_beq_true. Qed.
+
+Module Export ident.
+Inductive ident :=
+  | IAnon : positive → ident
+  | INamed :> string → ident.
+End ident.
+
+Global Instance maybe_IAnon : Maybe IAnon := λ i,
+  match i with IAnon n => Some n | _ => None end.
+Global Instance maybe_INamed : Maybe INamed := λ i,
+  match i with INamed s => Some s | _ => None end.
+
+Global Instance beq_eq_dec : EqDecision ident.
+Proof. solve_decision. Defined.
+
+Definition positive_beq := Eval compute in Pos.eqb.
+
+Lemma positive_beq_true x y : positive_beq x y = true ↔ x = y.
+Proof. apply Pos.eqb_eq. Qed.
+
+Definition ident_beq (i1 i2 : ident) : bool :=
+  match i1, i2 with
+  | IAnon n1, IAnon n2 => positive_beq n1 n2
+  | INamed s1, INamed s2 => string_beq s1 s2
+  | _, _ => false
+  end.
+
+Lemma ident_beq_true i1 i2 : ident_beq i1 i2 = true ↔ i1 = i2.
+Proof.
+  destruct i1, i2; rewrite /= ?string_beq_true ?positive_beq_true; naive_solver.
+Qed.
+
+Lemma ident_beq_reflect i1 i2 : reflect (i1 = i2) (ident_beq i1 i2).
+Proof. apply iff_reflect. by rewrite ident_beq_true. Qed.
+
+(** Copies of some functions on [list] and [option] for better reduction control. *)
+Fixpoint pm_app {A} (l1 l2 : list A) : list A :=
+  match l1 with [] => l2 | x :: l1 => x :: pm_app l1 l2 end.
+
+Definition pm_option_bind {A B} (f : A → option B) (mx : option A) : option B :=
+  match mx with Some x => f x | None => None end.
+Global Arguments pm_option_bind {_ _} _ !_ /.
+
+Definition pm_from_option {A B} (f : A → B) (y : B) (mx : option A) : B :=
+  match mx with None => y | Some x => f x end.
+Global Arguments pm_from_option {_ _} _ _ !_ /.
+
+Definition pm_option_fun {A B} (f : option (A → B)) (x : A) : option B :=
+  match f with None => None | Some f => Some (f x) end.
+Global Arguments pm_option_fun {_ _} !_ _ /.
+
+(* Can't write [id] here as that would not reduce. *)
+Notation pm_default := (pm_from_option (λ x, x)).

iris/proofmode/class_instances.v

+From iris.bi Require Import telescopes.
+From iris.proofmode Require Import base modality_instances classes classes_make.
+From iris.proofmode Require Import ltac_tactics.
+From iris.prelude Require Import options.
+Import bi.
+
+(* FIXME(Coq #6294): needs new unification *)
+(** The lemma [from_assumption_exact] is not an instance, but defined using
+[notypeclasses refine] through [Hint Extern] to enable the better unification
+algorithm. We use [shelve] to avoid the creation of unshelved goals for evars
+by [refine], which otherwise causes TC search to fail. Such unshelved goals are
+created for example when solving [FromAssumption p ?P ?Q] where both [?P] and
+[?Q] are evars. See [test_iApply_evar] in [tests/proofmode] for an example. *)
+Lemma from_assumption_exact {PROP : bi} p (P : PROP) : FromAssumption p P P.
+Proof. by rewrite /FromAssumption /= intuitionistically_if_elim. Qed.
+Global Hint Extern 0 (FromAssumption _ _ _) =>
+  notypeclasses refine (from_assumption_exact _ _); shelve : typeclass_instances.
+
+(* FIXME(Coq #6294): needs new unification *)
+(** Similarly, the lemma [from_exist_exist] is defined using a [Hint Extern] to
+enable the better unification algorithm.
+See https://gitlab.mpi-sws.org/iris/iris/issues/288 *)
+Lemma from_exist_exist {PROP : bi} {A} (Φ : A → PROP) : FromExist (∃ a, Φ a) Φ.
+Proof. by rewrite /FromExist. Qed.
+Global Hint Extern 0 (FromExist _ _) =>
+  notypeclasses refine (from_exist_exist _) : typeclass_instances.
+
+Section class_instances.
+Context {PROP : bi}.
+Implicit Types P Q R : PROP.
+Implicit Types mP : option PROP.
+
+(** AsEmpValid *)
+Global Instance as_emp_valid_emp_valid d P : AsEmpValid0 d (⊢ P) P | 0.
+Proof. by rewrite /AsEmpValid. Qed.
+Global Instance as_emp_valid_entails d P Q : AsEmpValid0 d (P ⊢ Q) (P -∗ Q).
+Proof. split => _; [ apply bi.entails_wand | apply bi.wand_entails ]. Qed.
+Global Instance as_emp_valid_equiv d P Q : AsEmpValid0 d (P ≡ Q) (P ∗-∗ Q).
+Proof. split => _; [ apply bi.equiv_wand_iff | apply bi.wand_iff_equiv ]. Qed.
+
+Global Instance as_emp_valid_forall d {A : Type} (φ : A → Prop) (P : A → PROP) :
+  (∀ x, AsEmpValid d (φ x) (P x)) → AsEmpValid d (∀ x, φ x) (∀ x, P x).
+Proof.
+  move=>H1. split=>? H2.
+  - apply bi.forall_intro=>?. by apply H1, H2.
+  - intros x. apply H1 => //. revert H2. by rewrite (bi.forall_elim x).
+Qed.
+Global Instance as_emp_valid_tforall d {TT : tele} (φ : TT → Prop) (P : TT → PROP) :
+  (∀ x, AsEmpValid d (φ x) (P x)) → AsEmpValid d (∀.. x, φ x) (∀.. x, P x).
+Proof.
+  rewrite /AsEmpValid !tforall_forall bi_tforall_forall.
+  apply as_emp_valid_forall.
+Qed.
+
+(** FromAffinely *)
+Global Instance from_affinely_affine P : Affine P → FromAffinely P P.
+Proof. intros. by rewrite /FromAffinely affinely_elim. Qed.
+Global Instance from_affinely_default P : FromAffinely (<affine> P) P | 100.
+Proof. by rewrite /FromAffinely. Qed.
+Global Instance from_affinely_intuitionistically P :
+  FromAffinely (□ P) (<pers> P) | 100.
+Proof. by rewrite /FromAffinely. Qed.
+
+(** IntoAbsorbingly *)
+Global Instance into_absorbingly_True : @IntoAbsorbingly PROP True emp | 0.
+Proof. by rewrite /IntoAbsorbingly -absorbingly_emp_True. Qed.
+Global Instance into_absorbingly_absorbing P : Absorbing P → IntoAbsorbingly P P | 1.
+Proof. intros. by rewrite /IntoAbsorbingly absorbing_absorbingly. Qed.
+Global Instance into_absorbingly_intuitionistically P :
+  IntoAbsorbingly (<pers> P) (□ P) | 2.
+Proof.
+  by rewrite /IntoAbsorbingly -absorbingly_intuitionistically_into_persistently.
+Qed.
+Global Instance into_absorbingly_default P : IntoAbsorbingly (<absorb> P) P | 100.
+Proof. by rewrite /IntoAbsorbingly. Qed.
+
+(** FromAssumption *)
+Global Instance from_assumption_persistently_r P Q :
+  FromAssumption true P Q → KnownRFromAssumption true P (<pers> Q).
+Proof.
+  rewrite /KnownRFromAssumption /FromAssumption /= =><-.
+  apply intuitionistically_persistent.
+Qed.
+Global Instance from_assumption_affinely_r P Q :
+  FromAssumption true P Q → KnownRFromAssumption true P (<affine> Q).
+Proof.
+  rewrite /KnownRFromAssumption /FromAssumption /= =><-.
+  by rewrite affinely_idemp.
+Qed.
+Global Instance from_assumption_intuitionistically_r P Q :
+  FromAssumption true P Q → KnownRFromAssumption true P (□ Q).
+Proof.
+  rewrite /KnownRFromAssumption /FromAssumption /= =><-.
+  by rewrite intuitionistically_idemp.
+Qed.
+Global Instance from_assumption_absorbingly_r p P Q :
+  FromAssumption p P Q → KnownRFromAssumption p P (<absorb> Q).
+Proof.
+  rewrite /KnownRFromAssumption /FromAssumption /= =><-.
+  apply absorbingly_intro.
+Qed.
+
+Global Instance from_assumption_intuitionistically_l p P Q :
+  FromAssumption true P Q → KnownLFromAssumption p (□ P) Q.
+Proof.
+  rewrite /KnownLFromAssumption /FromAssumption /= =><-.
+  by rewrite intuitionistically_if_elim.
+Qed.
+Global Instance from_assumption_persistently_l_true P Q :
+  FromAssumption true P Q → KnownLFromAssumption true (<pers> P) Q.
+Proof.
+  rewrite /KnownLFromAssumption /FromAssumption /= =><-.
+  rewrite intuitionistically_persistently_elim //.
+Qed.
+Global Instance from_assumption_persistently_l_false `{!BiAffine PROP} P Q :
+  FromAssumption true P Q → KnownLFromAssumption false (<pers> P) Q.
+Proof.
+  rewrite /KnownLFromAssumption /FromAssumption /= =><-.
+  by rewrite intuitionistically_into_persistently.
+Qed.
+Global Instance from_assumption_affinely_l_true p P Q :
+  FromAssumption p P Q → KnownLFromAssumption p (<affine> P) Q.
+Proof.
+  rewrite /KnownLFromAssumption /FromAssumption /= =><-.
+  by rewrite affinely_elim.
+Qed.
+Global Instance from_assumption_intuitionistically_l_true p P Q :
+  FromAssumption p P Q → KnownLFromAssumption p (□ P) Q.
+Proof.
+  rewrite /KnownLFromAssumption /FromAssumption /= =><-.
+  by rewrite intuitionistically_elim.
+Qed.
+
+Global Instance from_assumption_forall {A} p (Φ : A → PROP) Q x :
+  FromAssumption p (Φ x) Q → KnownLFromAssumption p (∀ x, Φ x) Q.
+Proof.
+  rewrite /KnownLFromAssumption /FromAssumption=> <-.
+  by rewrite forall_elim.
+Qed.
+Global Instance from_assumption_tforall {TT : tele} p (Φ : TT → PROP) Q x :
+  FromAssumption p (Φ x) Q → KnownLFromAssumption p (∀.. x, Φ x) Q.
+Proof.
+  rewrite /KnownLFromAssumption /FromAssumption=> <-.
+  by rewrite bi_tforall_forall forall_elim.
+Qed.
+
+(** IntoPure *)
+Global Instance into_pure_pure φ : @IntoPure PROP ⌜φ⌝ φ.
+Proof. by rewrite /IntoPure. Qed.
+
+Global Instance into_pure_pure_and (φ1 φ2 : Prop) P1 P2 :
+  IntoPure P1 φ1 → IntoPure P2 φ2 → IntoPure (P1 ∧ P2) (φ1 ∧ φ2).
+Proof. rewrite /IntoPure pure_and. by intros -> ->. Qed.
+Global Instance into_pure_pure_or (φ1 φ2 : Prop) P1 P2 :
+  IntoPure P1 φ1 → IntoPure P2 φ2 → IntoPure (P1 ∨ P2) (φ1 ∨ φ2).
+Proof. rewrite /IntoPure pure_or. by intros -> ->. Qed.
+Global Instance into_pure_pure_impl `{!BiPureForall PROP} (φ1 φ2 : Prop) P1 P2 :
+  FromPure false P1 φ1 → IntoPure P2 φ2 → IntoPure (P1 → P2) (φ1 → φ2).
+Proof. rewrite /FromPure /IntoPure /= => <- ->. apply pure_impl_2. Qed.
+
+Global Instance into_pure_exist {A} (Φ : A → PROP) (φ : A → Prop) :
+  (∀ x, IntoPure (Φ x) (φ x)) → IntoPure (∃ x, Φ x) (∃ x, φ x).
+Proof. rewrite /IntoPure=>Hx. rewrite pure_exist. by setoid_rewrite Hx. Qed.
+Global Instance into_pure_texist {TT : tele} (Φ : TT → PROP) (φ : TT → Prop) :
+  (∀ x, IntoPure (Φ x) (φ x)) → IntoPure (∃.. x, Φ x) (∃.. x, φ x).
+Proof. rewrite /IntoPure texist_exist bi_texist_exist. apply into_pure_exist. Qed.
+Global Instance into_pure_forall `{!BiPureForall PROP}
+    {A} (Φ : A → PROP) (φ : A → Prop) :
+  (∀ x, IntoPure (Φ x) (φ x)) → IntoPure (∀ x, Φ x) (∀ x, φ x).
+Proof. rewrite /IntoPure=>Hx. rewrite -pure_forall_2. by setoid_rewrite Hx. Qed.
+Global Instance into_pure_tforall `{!BiPureForall PROP}
+    {TT : tele} (Φ : TT → PROP) (φ : TT → Prop) :
+  (∀ x, IntoPure (Φ x) (φ x)) → IntoPure (∀.. x, Φ x) (∀.. x, φ x).
+Proof.
+  rewrite /IntoPure !tforall_forall bi_tforall_forall. apply into_pure_forall.
+Qed.
+
+Global Instance into_pure_pure_sep (φ1 φ2 : Prop) P1 P2 :
+  IntoPure P1 φ1 → IntoPure P2 φ2 → IntoPure (P1 ∗ P2) (φ1 ∧ φ2).
+Proof. rewrite /IntoPure=> -> ->. by rewrite sep_and pure_and. Qed.
+Global Instance into_pure_pure_wand `{!BiPureForall PROP} a (φ1 φ2 : Prop) P1 P2 :
+  FromPure a P1 φ1 → IntoPure P2 φ2 → IntoPure (P1 -∗ P2) (φ1 → φ2).
+Proof.
+  rewrite /FromPure /IntoPure=> <- -> /=. rewrite pure_impl.
+  apply impl_intro_l, pure_elim_l=> ?. rewrite (pure_True φ1) //.
+  by rewrite -affinely_affinely_if affinely_True_emp left_id.
+Qed.
+
+Global Instance into_pure_affinely P φ : IntoPure P φ → IntoPure (<affine> P) φ.
+Proof. rewrite /IntoPure=> ->. apply affinely_elim. Qed.
+Global Instance into_pure_intuitionistically P φ :
+  IntoPure P φ → IntoPure (□ P) φ.
+Proof. rewrite /IntoPure=> ->. apply intuitionistically_elim. Qed.
+Global Instance into_pure_absorbingly P φ : IntoPure P φ → IntoPure (<absorb> P) φ.
+Proof. rewrite /IntoPure=> ->. by rewrite absorbingly_pure. Qed.
+Global Instance into_pure_persistently P φ :
+  IntoPure P φ → IntoPure (<pers> P) φ.
+Proof. rewrite /IntoPure=> ->. apply: persistently_elim. Qed.
+
+Global Instance into_pure_big_sepL {A}
+    (Φ : nat → A → PROP) (φ : nat → A → Prop) (l : list A) :
+  (∀ k x, IntoPure (Φ k x) (φ k x)) →
+  IntoPure ([∗ list] k↦x ∈ l, Φ k x) (∀ k x, l !! k = Some x → φ k x).
+Proof.
+  rewrite /IntoPure. intros HΦ.
+  setoid_rewrite HΦ. rewrite big_sepL_pure_1. done.
+Qed.
+Global Instance into_pure_big_sepM `{Countable K} {A}
+    (Φ : K → A → PROP) (φ : K → A → Prop) (m : gmap K A) :
+  (∀ k x, IntoPure (Φ k x) (φ k x)) →
+  IntoPure ([∗ map] k↦x ∈ m, Φ k x) (map_Forall φ m).
+Proof.
+  rewrite /IntoPure. intros HΦ.
+  setoid_rewrite HΦ. rewrite big_sepM_pure_1. done.
+Qed.
+Global Instance into_pure_big_sepS `{Countable A}
+    (Φ : A → PROP) (φ : A → Prop) (X : gset A) :
+  (∀ x, IntoPure (Φ x) (φ x)) →
+  IntoPure ([∗ set] x ∈ X, Φ x) (set_Forall φ X).
+Proof.
+  rewrite /IntoPure. intros HΦ.
+  setoid_rewrite HΦ. rewrite big_sepS_pure_1. done.
+Qed.
+Global Instance into_pure_big_sepMS `{Countable A}
+    (Φ : A → PROP) (φ : A → Prop) (X : gmultiset A) :
+  (∀ x, IntoPure (Φ x) (φ x)) →
+  IntoPure ([∗ mset] x ∈ X, Φ x) (∀ y : A, y ∈ X → φ y).
+Proof.
+  rewrite /IntoPure. intros HΦ.
+  setoid_rewrite HΦ. rewrite big_sepMS_pure_1. done.
+Qed.
+
+(** FromPure *)
+Global Instance from_pure_emp : @FromPure PROP true emp True.
+Proof. rewrite /FromPure /=. apply (affine _). Qed.
+Global Instance from_pure_pure φ : @FromPure PROP false ⌜φ⌝ φ.
+Proof. by rewrite /FromPure /=. Qed.
+Global Instance from_pure_pure_and a1 a2 (φ1 φ2 : Prop) P1 P2 :
+  FromPure a1 P1 φ1 → FromPure a2 P2 φ2 →
+  FromPure (if a1 then true else a2) (P1 ∧ P2) (φ1 ∧ φ2).
+Proof.
+  rewrite /FromPure pure_and=> <- <- /=. rewrite affinely_if_and.
+  f_equiv; apply affinely_if_flag_mono; destruct a1; naive_solver.
+Qed.
+Global Instance from_pure_pure_or a1 a2 (φ1 φ2 : Prop) P1 P2 :
+  FromPure a1 P1 φ1 → FromPure a2 P2 φ2 →
+  FromPure (if a1 then true else a2) (P1 ∨ P2) (φ1 ∨ φ2).
+Proof.
+  rewrite /FromPure pure_or=> <- <- /=. rewrite affinely_if_or.
+  f_equiv; apply affinely_if_flag_mono; destruct a1; naive_solver.
+Qed.
+Global Instance from_pure_pure_impl a (φ1 φ2 : Prop) P1 P2 :
+  IntoPure P1 φ1 → FromPure a P2 φ2 → FromPure a (P1 → P2) (φ1 → φ2).
+Proof.
+  rewrite /FromPure /IntoPure pure_impl_1=> -> <-. destruct a=>//=.
+  apply bi.impl_intro_l. by rewrite affinely_and_r bi.impl_elim_r.
+Qed.
+
+Global Instance from_pure_exist {A} a (Φ : A → PROP) (φ : A → Prop) :
+  (∀ x, FromPure a (Φ x) (φ x)) → FromPure a (∃ x, Φ x) (∃ x, φ x).
+Proof.
+  rewrite /FromPure=>Hx. rewrite pure_exist affinely_if_exist.
+  by setoid_rewrite Hx.
+Qed.
+Global Instance from_pure_texist {TT : tele} a (Φ : TT → PROP) (φ : TT → Prop) :
+  (∀ x, FromPure a (Φ x) (φ x)) → FromPure a (∃.. x, Φ x) (∃.. x, φ x).
+Proof. rewrite /FromPure texist_exist bi_texist_exist. apply from_pure_exist. Qed.
+Global Instance from_pure_forall {A} a (Φ : A → PROP) (φ : A → Prop) :
+  (∀ x, FromPure a (Φ x) (φ x)) → FromPure a (∀ x, Φ x) (∀ x, φ x).
+Proof.
+  rewrite /FromPure=>Hx. rewrite pure_forall_1. setoid_rewrite <-Hx.
+  destruct a=>//=. apply affinely_forall.
+Qed.
+Global Instance from_pure_tforall {TT : tele} a (Φ : TT → PROP) (φ : TT → Prop) :
+  (∀ x, FromPure a (Φ x) (φ x)) → FromPure a (∀.. x, Φ x) (∀.. x, φ x).
+Proof.
+  rewrite /FromPure !tforall_forall bi_tforall_forall. apply from_pure_forall.
+Qed.
+
+Global Instance from_pure_pure_sep_true a1 a2 (φ1 φ2 : Prop) P1 P2 :
+  FromPure a1 P1 φ1 → FromPure a2 P2 φ2 →
+  FromPure (if a1 then a2 else false) (P1 ∗ P2) (φ1 ∧ φ2).
+Proof.
+  rewrite /FromPure=> <- <-. destruct a1; simpl.
+  - by rewrite pure_and -persistent_and_affinely_sep_l affinely_if_and_r.
+  - by rewrite pure_and -affinely_affinely_if -persistent_and_affinely_sep_r_1.
+Qed.
+Global Instance from_pure_pure_wand a (φ1 φ2 : Prop) P1 P2 :
+  IntoPure P1 φ1 → FromPure a P2 φ2 →
+  TCOr (TCEq a false) (Affine P1) →
+  FromPure a (P1 -∗ P2) (φ1 → φ2).
+Proof.
+  rewrite /FromPure /IntoPure=> HP1 <- Ha /=. apply wand_intro_l.
+  destruct a; simpl.
+  - destruct Ha as [Ha|?]; first inversion Ha.
+    rewrite -persistent_and_affinely_sep_r -(affine_affinely P1) HP1.
+    by rewrite affinely_and_l pure_impl_1 impl_elim_r.
+  - by rewrite HP1 sep_and pure_impl_1 impl_elim_r.
+Qed.
+
+Global Instance from_pure_persistently P a φ :
+  FromPure true P φ → FromPure a (<pers> P) φ.
+Proof.
+  rewrite /FromPure=> <- /=.
+  by rewrite persistently_affinely_elim affinely_if_elim persistently_pure.
+Qed.
+Global Instance from_pure_affinely_true a P φ :
+  FromPure a P φ → FromPure true (<affine> P) φ.
+Proof. rewrite /FromPure=><- /=. by rewrite -affinely_affinely_if affinely_idemp. Qed.
+Global Instance from_pure_intuitionistically_true a P φ :
+  FromPure a P φ → FromPure true (□ P) φ.
+Proof.
+  rewrite /FromPure=><- /=.
+  rewrite -intuitionistically_affinely_elim -affinely_affinely_if affinely_idemp.
+  by rewrite intuitionistic_intuitionistically.
+Qed.
+Global Instance from_pure_absorbingly a P φ :
+  FromPure a P φ → FromPure false (<absorb> P) φ.
+Proof.
+  rewrite /FromPure=> <- /=. rewrite -affinely_affinely_if.
+  by rewrite -persistent_absorbingly_affinely_2.
+Qed.
+
+Global Instance from_pure_big_sepL {A}
+    a (Φ : nat → A → PROP) (φ : nat → A → Prop) (l : list A) :
+  (∀ k x, FromPure a (Φ k x) (φ k x)) →
+  TCOr (TCEq a true) (BiAffine PROP) →
+  FromPure a ([∗ list] k↦x ∈ l, Φ k x) (∀ k x, l !! k = Some x → φ k x).
+Proof.
+  rewrite /FromPure. destruct a; simpl; intros HΦ Haffine.
+  - rewrite big_sepL_affinely_pure_2.
+    setoid_rewrite HΦ. done.
+  - destruct Haffine as [[=]%TCEq_eq|?].
+    rewrite -big_sepL_pure. setoid_rewrite HΦ. done.
+Qed.
+Global Instance from_pure_big_sepM `{Countable K} {A}
+    a (Φ : K → A → PROP) (φ : K → A → Prop) (m : gmap K A) :
+  (∀ k x, FromPure a (Φ k x) (φ k x)) →
+  TCOr (TCEq a true) (BiAffine PROP) →
+  FromPure a ([∗ map] k↦x ∈ m, Φ k x) (map_Forall φ m).
+Proof.
+  rewrite /FromPure. destruct a; simpl; intros HΦ Haffine.
+  - rewrite big_sepM_affinely_pure_2.
+    setoid_rewrite HΦ. done.
+  - destruct Haffine as [[=]%TCEq_eq|?].
+    rewrite -big_sepM_pure. setoid_rewrite HΦ. done.
+Qed.
+Global Instance from_pure_big_sepS `{Countable A}
+    a (Φ : A → PROP) (φ : A → Prop) (X : gset A) :
+  (∀ x, FromPure a (Φ x) (φ x)) →
+  TCOr (TCEq a true) (BiAffine PROP) →
+  FromPure a ([∗ set] x ∈ X, Φ x) (set_Forall φ X).
+Proof.
+  rewrite /FromPure. destruct a; simpl; intros HΦ Haffine.
+  - rewrite big_sepS_affinely_pure_2.
+    setoid_rewrite HΦ. done.
+  - destruct Haffine as [[=]%TCEq_eq|?].
+    rewrite -big_sepS_pure. setoid_rewrite HΦ. done.
+Qed.
+Global Instance from_pure_big_sepMS `{Countable A}
+    a (Φ : A → PROP) (φ : A → Prop) (X : gmultiset A) :
+  (∀ x, FromPure a (Φ x) (φ x)) →
+  TCOr (TCEq a true) (BiAffine PROP) →
+  FromPure a ([∗ mset] x ∈ X, Φ x) (∀ y : A, y ∈ X → φ y).
+Proof.
+  rewrite /FromPure. destruct a; simpl; intros HΦ Haffine.
+  - rewrite big_sepMS_affinely_pure_2.
+    setoid_rewrite HΦ. done.
+  - destruct Haffine as [[=]%TCEq_eq|?].
+    rewrite -big_sepMS_pure. setoid_rewrite HΦ. done.
+Qed.
+
+(** IntoPersistent *)
+Global Instance into_persistent_persistently p P Q :
+  IntoPersistent true P Q → IntoPersistent p (<pers> P) Q | 0.
+Proof.
+  rewrite /IntoPersistent /= => ->.
+  destruct p; simpl; auto using persistently_idemp_1.
+Qed.
+Global Instance into_persistent_affinely p P Q :
+  IntoPersistent p P Q → IntoPersistent p (<affine> P) Q | 0.
+Proof. rewrite /IntoPersistent /= => <-. by rewrite affinely_elim. Qed.
+Global Instance into_persistent_intuitionistically p P Q :
+  IntoPersistent true P Q → IntoPersistent p (□ P) Q | 0.
+Proof.
+  rewrite /IntoPersistent /= =><-.
+  destruct p; simpl;
+    eauto using persistently_mono, intuitionistically_elim,
+    intuitionistically_into_persistently_1.
+Qed.
+Global Instance into_persistent_here P : IntoPersistent true P P | 1.
+Proof. by rewrite /IntoPersistent. Qed.
+Global Instance into_persistent_persistent P :
+  Persistent P → IntoPersistent false P P | 100.
+Proof. intros. by rewrite /IntoPersistent. Qed.
+
+(** FromModal *)
+Global Instance from_modal_affinely P :
+  FromModal True modality_affinely (<affine> P) (<affine> P) P | 2.
+Proof. by rewrite /FromModal. Qed.
+
+Global Instance from_modal_persistently P :
+  FromModal True modality_persistently (<pers> P) (<pers> P) P | 2.
+Proof. by rewrite /FromModal. Qed.
+Global Instance from_modal_intuitionistically P :
+  FromModal True modality_intuitionistically (□ P) (□ P) P | 1.
+Proof. by rewrite /FromModal. Qed.
+Global Instance from_modal_intuitionistically_affine_bi P :
+  BiAffine PROP → FromModal True modality_persistently (□ P) (□ P) P | 0.
+Proof.
+  intros. by rewrite /FromModal /= intuitionistically_into_persistently.
+Qed.
+
+Global Instance from_modal_absorbingly P :
+  FromModal True modality_id (<absorb> P) (<absorb> P) P.
+Proof. by rewrite /FromModal /= -absorbingly_intro. Qed.
+
+(** IntoWand *)
+Global Instance into_wand_wand' p q (P Q P' Q' : PROP) :
+  IntoWand' p q (P -∗ Q) P' Q' → IntoWand p q (P -∗ Q) P' Q' | 100.
+Proof. done. Qed.
+Global Instance into_wand_impl' p q (P Q P' Q' : PROP) :
+  IntoWand' p q (P → Q) P' Q' → IntoWand p q (P → Q) P' Q' | 100.
+Proof. done. Qed.
+Global Instance into_wand_wandM' p q mP (Q P' Q' : PROP) :
+  IntoWand' p q (mP -∗? Q) P' Q' → IntoWand p q (mP -∗? Q) P' Q' | 100.
+Proof. done. Qed.
+
+Global Instance into_wand_wand p q P Q P' :
+  FromAssumption q P P' → IntoWand p q (P' -∗ Q) P Q.
+Proof.
+  rewrite /FromAssumption /IntoWand=> HP. by rewrite HP intuitionistically_if_elim.
+Qed.
+(** Implication instances
+  For non-affine BIs, generally we assume [P → ...] is written in cases where
+  that would be equivalent to [<affine> P -∗ ...], i.e., [P] is absorbing and
+  persistent and an affinely modality is added when proving the premise. If the
+  implication itself or the premise are taken from the persistent context,
+  things become a bit easier and we can drop some of these requirements. We also
+  support arbitrary implications for affine BIs via [BiAffine]. *)
+Global Instance into_wand_impl_false_false P Q P' P'' :
+  Absorbing P →
+  (* Cheap check comes first *)
+  TCOr (BiAffine PROP) (Persistent P) →
+  MakeAffinely P P' →
+  FromAssumption false P'' P' →
+  IntoWand false false (P → Q) P'' Q.
+Proof.
+  rewrite /MakeAffinely /IntoWand /FromAssumption /= => ? Hpers <- ->.
+  apply wand_intro_l. destruct Hpers.
+  - rewrite impl_wand_1 affinely_elim wand_elim_r //.
+  - rewrite persistent_impl_wand_affinely wand_elim_r //.
+Qed.
+Global Instance into_wand_impl_false_true P Q P' :
+  Absorbing P' →
+  FromAssumption true P P' →
+  IntoWand false true (P' → Q) P Q.
+Proof.
+  rewrite /IntoWand /FromAssumption /= => ? HP. apply wand_intro_l.
+  rewrite -(persistently_elim P').
+  rewrite persistent_impl_wand_affinely.
+  rewrite -(intuitionistically_idemp P) HP.
+  apply wand_elim_r.
+Qed.
+Global Instance into_wand_impl_true_false P Q P' P'' :
+  MakeAffinely P P' →
+  FromAssumption false P'' P' →
+  IntoWand true false (P → Q) P'' Q.
+Proof.
+  rewrite /MakeAffinely /IntoWand /FromAssumption /= => <- ->.
+  apply wand_intro_r.
+  rewrite sep_and intuitionistically_elim affinely_elim impl_elim_l //.
+Qed.
+Global Instance into_wand_impl_true_true P Q P' :
+  FromAssumption true P P' →
+  IntoWand true true (P' → Q) P Q.
+Proof.
+  rewrite /FromAssumption /IntoWand /= => <-. apply wand_intro_l.
+  rewrite sep_and [(□ (_ → _))%I]intuitionistically_elim impl_elim_r //.
+Qed.
+
+Global Instance into_wand_wandM p q mP' P Q :
+  FromAssumption q P (default emp%I mP') → IntoWand p q (mP' -∗? Q) P Q.
+Proof. rewrite /IntoWand wandM_sound. exact: into_wand_wand. Qed.
+
+Global Instance into_wand_and_l p q R1 R2 P' Q' :
+  IntoWand p q R1 P' Q' → IntoWand p q (R1 ∧ R2) P' Q'.
+Proof. rewrite /IntoWand=> ?. by rewrite /bi_wand_iff and_elim_l. Qed.
+Global Instance into_wand_and_r p q R1 R2 P' Q' :
+  IntoWand p q R2 Q' P' → IntoWand p q (R1 ∧ R2) Q' P'.
+Proof. rewrite /IntoWand=> ?. by rewrite /bi_wand_iff and_elim_r. Qed.
+
+Global Instance into_wand_forall_prop_true p (φ : Prop) P :
+  IntoWand p true (∀ _ : φ, P) ⌜ φ ⌝ P.
+Proof.
+  rewrite /IntoWand (intuitionistically_if_elim p) /=
+          -impl_wand_intuitionistically -pure_impl_forall
+          bi.persistently_elim //.
+Qed.
+Global Instance into_wand_forall_prop_false p (φ : Prop) Pφ P :
+  MakeAffinely ⌜ φ ⌝ Pφ →
+  IntoWand p false (∀ _ : φ, P) Pφ P.
+Proof.
+  rewrite /MakeAffinely /IntoWand=> <-.
+  rewrite (intuitionistically_if_elim p) /=.
+  by rewrite -pure_impl_forall -persistent_impl_wand_affinely.
+Qed.
+
+Global Instance into_wand_forall {A} p q (Φ : A → PROP) P Q x :
+  IntoWand p q (Φ x) P Q → IntoWand p q (∀ x, Φ x) P Q.
+Proof. rewrite /IntoWand=> <-. by rewrite (forall_elim x). Qed.
+Global Instance into_wand_tforall {TT : tele} p q (Φ : TT → PROP) P Q x :
+  IntoWand p q (Φ x) P Q → IntoWand p q (∀.. x, Φ x) P Q.
+Proof. rewrite /IntoWand=> <-. by rewrite bi_tforall_forall (forall_elim x). Qed.
+
+Global Instance into_wand_affine p q R P Q :
+  IntoWand p q R P Q → IntoWand p q (<affine> R) (<affine> P) (<affine> Q).
+Proof.
+  rewrite /IntoWand /= => HR. apply wand_intro_r. destruct p; simpl in *.
+  - rewrite (affinely_elim R) -(affine_affinely (□ R)) HR. destruct q; simpl in *.
+    + rewrite (affinely_elim P) -{2}(affine_affinely (□ P)).
+      by rewrite affinely_sep_2 wand_elim_l.
+    + by rewrite affinely_sep_2 wand_elim_l.
+  - rewrite HR. destruct q; simpl in *.
+    + rewrite (affinely_elim P) -{2}(affine_affinely (□ P)).
+      by rewrite affinely_sep_2 wand_elim_l.
+    + by rewrite affinely_sep_2 wand_elim_l.
+Qed.
+(* In case the argument is affine, but the wand resides in the spatial context,
+we can only eliminate the affine modality in the argument. This would lead to
+the following instance:
+
+  IntoWand false q R P Q → IntoWand' false q R (<affine> P) Q.
+
+This instance is redundant, however, since the elimination of the affine
+modality is already covered by the [IntoAssumption] instances that are used at
+the leaves of the instance search for [IntoWand]. *)
+Global Instance into_wand_affine_args q R P Q :
+  IntoWand true q R P Q → IntoWand' true q R (<affine> P) (<affine> Q).
+Proof.
+  rewrite /IntoWand' /IntoWand /= => HR. apply wand_intro_r.
+  rewrite -(affine_affinely (□ R)) HR. destruct q; simpl.
+  - rewrite (affinely_elim P) -{2}(affine_affinely (□ P)).
+    by rewrite affinely_sep_2 wand_elim_l.
+  - by rewrite affinely_sep_2 wand_elim_l.
+Qed.
+
+Global Instance into_wand_intuitionistically p q R P Q :
+  IntoWand true q R P Q → IntoWand p q (□ R) P Q.
+Proof. rewrite /IntoWand /= => ->. by rewrite {1}intuitionistically_if_elim. Qed.
+Global Instance into_wand_persistently_true q R P Q :
+  IntoWand true q R P Q → IntoWand true q (<pers> R) P Q.
+Proof. by rewrite /IntoWand /= intuitionistically_persistently_elim. Qed.
+Global Instance into_wand_persistently_false q R P Q :
+  Absorbing R → IntoWand false q R P Q → IntoWand false q (<pers> R) P Q.
+Proof. intros ?. by rewrite /IntoWand persistently_elim. Qed.
+
+(** FromWand *)
+Global Instance from_wand_wand P1 P2 : FromWand (P1 -∗ P2) P1 P2.
+Proof. by rewrite /FromWand. Qed.
+Global Instance from_wand_wandM mP1 P2 :
+  FromWand (mP1 -∗? P2) (default emp mP1)%I P2.
+Proof. by rewrite /FromWand wandM_sound. Qed.
+
+(** FromImpl *)
+Global Instance from_impl_impl P1 P2 : FromImpl (P1 → P2) P1 P2.
+Proof. by rewrite /FromImpl. Qed.
+
+(** FromAnd *)
+Global Instance from_and_and P1 P2 : FromAnd (P1 ∧ P2) P1 P2 | 100.
+Proof. by rewrite /FromAnd. Qed.
+Global Instance from_and_sep_persistent_l P1 P1' P2 :
+  Persistent P1 → IntoAbsorbingly P1' P1 → FromAnd (P1 ∗ P2) P1' P2 | 9.
+Proof.
+  rewrite /IntoAbsorbingly /FromAnd=> ? ->.
+  rewrite persistent_and_affinely_sep_l_1 {1}(persistent_persistently_2 P1).
+  by rewrite absorbingly_elim_persistently -{2}(intuitionistically_elim P1).
+Qed.
+Global Instance from_and_sep_persistent_r P1 P2 P2' :
+  Persistent P2 → IntoAbsorbingly P2' P2 → FromAnd (P1 ∗ P2) P1 P2' | 10.
+Proof.
+  rewrite /IntoAbsorbingly /FromAnd=> ? ->.
+  rewrite persistent_and_affinely_sep_r_1 {1}(persistent_persistently_2 P2).
+  by rewrite absorbingly_elim_persistently -{2}(intuitionistically_elim P2).
+Qed.
+
+Global Instance from_and_pure φ ψ : @FromAnd PROP ⌜φ ∧ ψ⌝ ⌜φ⌝ ⌜ψ⌝.
+Proof. by rewrite /FromAnd pure_and. Qed.
+
+Global Instance from_and_persistently P Q1 Q2 :
+  FromAnd P Q1 Q2 →
+  FromAnd (<pers> P) (<pers> Q1) (<pers> Q2).
+Proof. rewrite /FromAnd=> <-. by rewrite persistently_and. Qed.
+Global Instance from_and_persistently_sep P Q1 Q2 :
+  FromSep P Q1 Q2 →
+  FromAnd (<pers> P) (<pers> Q1) (<pers> Q2) | 11.
+Proof. rewrite /FromAnd=> <-. by rewrite -persistently_and persistently_and_sep. Qed.
+
+Global Instance from_and_big_sepL_cons_persistent {A} (Φ : nat → A → PROP) l x l' :
+  IsCons l x l' →
+  Persistent (Φ 0 x) →
+  FromAnd ([∗ list] k ↦ y ∈ l, Φ k y) (Φ 0 x) ([∗ list] k ↦ y ∈ l', Φ (S k) y).
+Proof. rewrite /IsCons=> -> ?. by rewrite /FromAnd big_sepL_cons persistent_and_sep_1. Qed.
+Global Instance from_and_big_sepL_app_persistent {A} (Φ : nat → A → PROP) l l1 l2 :
+  IsApp l l1 l2 →
+  (∀ k y, Persistent (Φ k y)) →
+  FromAnd ([∗ list] k ↦ y ∈ l, Φ k y)
+    ([∗ list] k ↦ y ∈ l1, Φ k y) ([∗ list] k ↦ y ∈ l2, Φ (length l1 + k) y).
+Proof. rewrite /IsApp=> -> ?. by rewrite /FromAnd big_sepL_app persistent_and_sep_1. Qed.
+
+Global Instance from_and_big_sepL2_cons_persistent {A B}
+    (Φ : nat → A → B → PROP) l1 x1 l1' l2 x2 l2' :
+  IsCons l1 x1 l1' → IsCons l2 x2 l2' →
+  Persistent (Φ 0 x1 x2) →
+  FromAnd ([∗ list] k ↦ y1;y2 ∈ l1;l2, Φ k y1 y2)
+    (Φ 0 x1 x2) ([∗ list] k ↦ y1;y2 ∈ l1';l2', Φ (S k) y1 y2).
+Proof.
+  rewrite /IsCons=> -> -> ?.
+  by rewrite /FromAnd big_sepL2_cons persistent_and_sep_1.
+Qed.
+Global Instance from_and_big_sepL2_app_persistent {A B}
+    (Φ : nat → A → B → PROP) l1 l1' l1'' l2 l2' l2'' :
+  IsApp l1 l1' l1'' → IsApp l2 l2' l2'' →
+  (∀ k y1 y2, Persistent (Φ k y1 y2)) →
+  FromAnd ([∗ list] k ↦ y1;y2 ∈ l1;l2, Φ k y1 y2)
+    ([∗ list] k ↦ y1;y2 ∈ l1';l2', Φ k y1 y2)
+    ([∗ list] k ↦ y1;y2 ∈ l1'';l2'', Φ (length l1' + k) y1 y2).
+Proof.
+  rewrite /IsApp=> -> -> ?. rewrite /FromAnd persistent_and_sep_1.
+  apply wand_elim_l', big_sepL2_app.
+Qed.
+
+Global Instance from_and_big_sepMS_disj_union_persistent
+    `{Countable A} (Φ : A → PROP) X1 X2 :
+  (∀ y, Persistent (Φ y)) →
+  FromAnd ([∗ mset] y ∈ X1 ⊎ X2, Φ y) ([∗ mset] y ∈ X1, Φ y) ([∗ mset] y ∈ X2, Φ y).
+Proof. intros. by rewrite /FromAnd big_sepMS_disj_union persistent_and_sep_1. Qed.
+
+(** FromSep *)
+Global Instance from_sep_sep P1 P2 : FromSep (P1 ∗ P2) P1 P2 | 100.
+Proof. by rewrite /FromSep. Qed.
+Global Instance from_sep_and P1 P2 :
+  TCOr (Affine P1) (Absorbing P2) → TCOr (Affine P2) (Absorbing P1) →
+  FromSep (P1 ∧ P2) P1 P2 | 101.
+Proof. intros. by rewrite /FromSep sep_and. Qed.
+
+Global Instance from_sep_pure φ ψ : @FromSep PROP ⌜φ ∧ ψ⌝ ⌜φ⌝ ⌜ψ⌝.
+Proof. by rewrite /FromSep pure_and sep_and. Qed.
+
+Global Instance from_sep_affinely P Q1 Q2 :
+  FromSep P Q1 Q2 → FromSep (<affine> P) (<affine> Q1) (<affine> Q2).
+Proof. rewrite /FromSep=> <-. by rewrite affinely_sep_2. Qed.
+Global Instance from_sep_intuitionistically P Q1 Q2 :
+  FromSep P Q1 Q2 → FromSep (□ P) (□ Q1) (□ Q2).
+Proof. rewrite /FromSep=> <-. by rewrite intuitionistically_sep_2. Qed.
+Global Instance from_sep_absorbingly P Q1 Q2 :
+  FromSep P Q1 Q2 → FromSep (<absorb> P) (<absorb> Q1) (<absorb> Q2).
+Proof. rewrite /FromSep=> <-. by rewrite absorbingly_sep. Qed.
+Global Instance from_sep_persistently P Q1 Q2 :
+  FromSep P Q1 Q2 →
+  FromSep (<pers> P) (<pers> Q1) (<pers> Q2).
+Proof. rewrite /FromSep=> <-. by rewrite persistently_sep_2. Qed.
+
+Global Instance from_sep_big_sepL_cons {A} (Φ : nat → A → PROP) l x l' :
+  IsCons l x l' →
+  FromSep ([∗ list] k ↦ y ∈ l, Φ k y) (Φ 0 x) ([∗ list] k ↦ y ∈ l', Φ (S k) y).
+Proof. rewrite /IsCons=> ->. by rewrite /FromSep big_sepL_cons. Qed.
+Global Instance from_sep_big_sepL_app {A} (Φ : nat → A → PROP) l l1 l2 :
+  IsApp l l1 l2 →
+  FromSep ([∗ list] k ↦ y ∈ l, Φ k y)
+    ([∗ list] k ↦ y ∈ l1, Φ k y) ([∗ list] k ↦ y ∈ l2, Φ (length l1 + k) y).
+Proof. rewrite /IsApp=> ->. by rewrite /FromSep big_opL_app. Qed.
+
+Global Instance from_sep_big_sepL2_cons {A B} (Φ : nat → A → B → PROP)
+    l1 x1 l1' l2 x2 l2' :
+  IsCons l1 x1 l1' → IsCons l2 x2 l2' →
+  FromSep ([∗ list] k ↦ y1;y2 ∈ l1;l2, Φ k y1 y2)
+    (Φ 0 x1 x2) ([∗ list] k ↦ y1;y2 ∈ l1';l2', Φ (S k) y1 y2).
+Proof. rewrite /IsCons=> -> ->. by rewrite /FromSep big_sepL2_cons. Qed.
+Global Instance from_sep_big_sepL2_app {A B} (Φ : nat → A → B → PROP)
+    l1 l1' l1'' l2 l2' l2'' :
+  IsApp l1 l1' l1'' → IsApp l2 l2' l2'' →
+  FromSep ([∗ list] k ↦ y1;y2 ∈ l1;l2, Φ k y1 y2)
+    ([∗ list] k ↦ y1;y2 ∈ l1';l2', Φ k y1 y2)
+    ([∗ list] k ↦ y1;y2 ∈ l1'';l2'', Φ (length l1' + k) y1 y2).
+Proof. rewrite /IsApp=>-> ->. apply wand_elim_l', big_sepL2_app. Qed.
+
+Global Instance from_sep_big_sepMS_disj_union `{Countable A} (Φ : A → PROP) X1 X2 :
+  FromSep ([∗ mset] y ∈ X1 ⊎ X2, Φ y) ([∗ mset] y ∈ X1, Φ y) ([∗ mset] y ∈ X2, Φ y).
+Proof. by rewrite /FromSep big_sepMS_disj_union. Qed.
+
+(** MaybeCombineSepAs *)
+Global Instance maybe_combine_sep_as_affinely Q1 Q2 P progress :
+  MaybeCombineSepAs Q1 Q2 P progress →
+  MaybeCombineSepAs (<affine> Q1) (<affine> Q2) (<affine> P) progress | 30.
+Proof. rewrite /MaybeCombineSepAs =><-. by rewrite affinely_sep_2. Qed.
+Global Instance maybe_combine_sep_as_intuitionistically Q1 Q2 P progress :
+  MaybeCombineSepAs Q1 Q2 P progress →
+  MaybeCombineSepAs (□ Q1) (□ Q2) (□ P) progress | 30.
+Proof. rewrite /MaybeCombineSepAs =><-. by rewrite intuitionistically_sep_2. Qed.
+Global Instance maybe_combine_sep_as_absorbingly Q1 Q2 P progress :
+  MaybeCombineSepAs Q1 Q2 P progress →
+  MaybeCombineSepAs (<absorb> Q1) (<absorb> Q2) (<absorb> P) progress | 30.
+Proof. rewrite /MaybeCombineSepAs =><-. by rewrite absorbingly_sep. Qed.
+Global Instance maybe_combine_sep_as_persistently Q1 Q2 P progress :
+  MaybeCombineSepAs Q1 Q2 P progress →
+  MaybeCombineSepAs (<pers> Q1) (<pers> Q2) (<pers> P) progress | 30.
+Proof. rewrite /MaybeCombineSepAs =><-. by rewrite persistently_sep_2. Qed.
+
+(** CombineSepGives *)
+(* The results of these recursive instances drop the input modalities. This is
+fine, because the [P] argument in [CombineSepGives Q1 Q2 P] is by definition
+beneath a [<pers>] modality, and we have:
+         - [<affine><pers> P ⊢ <pers> P] holds, we have
+              [<pers><affine> P ⊣⊢ <pers> P] by [persistently_affinely_elim]
+              and the obtained [□ P] in [iCombine] is always [Affine] anyway.
+         - [□ <pers> P = <affine><pers> <pers> P], see [<affine>] and [<pers>]
+         - [<absorb><pers> P ⊣⊢ <pers> P], see [absorbingly_elim_persistently]
+         - [<pers><pers> P ⊣⊢ <pers> P], see [persistently_idemp] *)
+Global Instance combine_sep_as_affinely Q1 Q2 P :
+  CombineSepGives Q1 Q2 P → CombineSepGives (<affine> Q1) (<affine> Q2) P | 30.
+Proof. by rewrite /CombineSepGives affinely_sep_2 affinely_elim => ->. Qed.
+Global Instance combine_sep_as_intuitionistically Q1 Q2 P :
+  CombineSepGives Q1 Q2 P → CombineSepGives (□ Q1) (□ Q2) P | 30.
+Proof. rewrite /CombineSepGives => <-. by rewrite !intuitionistically_elim. Qed.
+Global Instance combine_sep_as_absorbingly Q1 Q2 P :
+  CombineSepGives Q1 Q2 P → CombineSepGives (<absorb> Q1) (<absorb> Q2) P | 30.
+Proof.
+  rewrite /CombineSepGives -absorbingly_sep =>->.
+  by rewrite absorbingly_elim_persistently.
+Qed.
+Global Instance combine_sep_as_persistently Q1 Q2 P :
+  CombineSepGives Q1 Q2 P → CombineSepGives (<pers> Q1) (<pers> Q2) P | 30.
+Proof.
+  rewrite /CombineSepGives persistently_sep_2 => ->.
+  by rewrite persistently_idemp.
+Qed.
+
+(** IntoAnd *)
+Global Instance into_and_and p P Q : IntoAnd p (P ∧ Q) P Q | 10.
+Proof. by rewrite /IntoAnd intuitionistically_if_and. Qed.
+Global Instance into_and_and_affine_l P Q Q' :
+  Affine P → FromAffinely Q' Q → IntoAnd false (P ∧ Q) P Q'.
+Proof.
+  intros. rewrite /IntoAnd /=.
+  by rewrite -(affine_affinely P) affinely_and_l affinely_and (from_affinely Q').
+Qed.
+Global Instance into_and_and_affine_r P P' Q :
+  Affine Q → FromAffinely P' P → IntoAnd false (P ∧ Q) P' Q.
+Proof.
+  intros. rewrite /IntoAnd /=.
+  by rewrite -(affine_affinely Q) affinely_and_r affinely_and (from_affinely P').
+Qed.
+
+Global Instance into_and_sep `{!BiPositive PROP} P Q : IntoAnd true (P ∗ Q) P Q.
+Proof.
+  rewrite /IntoAnd /= intuitionistically_sep
+    -and_sep_intuitionistically intuitionistically_and //.
+Qed.
+Global Instance into_and_sep_affine p P Q :
+  TCOr (Affine P) (Absorbing Q) → TCOr (Affine Q) (Absorbing P) →
+  IntoAnd p (P ∗ Q) P Q.
+Proof. intros. by rewrite /IntoAnd /= sep_and. Qed.
+
+Global Instance into_and_pure p φ ψ : @IntoAnd PROP p ⌜φ ∧ ψ⌝ ⌜φ⌝ ⌜ψ⌝.
+Proof. by rewrite /IntoAnd pure_and intuitionistically_if_and. Qed.
+
+Global Instance into_and_affinely p P Q1 Q2 :
+  IntoAnd p P Q1 Q2 → IntoAnd p (<affine> P) (<affine> Q1) (<affine> Q2).
+Proof.
+  rewrite /IntoAnd. destruct p; simpl.
+  - rewrite -affinely_and !intuitionistically_affinely_elim //.
+  - intros ->. by rewrite affinely_and.
+Qed.
+Global Instance into_and_intuitionistically p P Q1 Q2 :
+  IntoAnd p P Q1 Q2 → IntoAnd p (□ P) (□ Q1) (□ Q2).
+Proof.
+  rewrite /IntoAnd. destruct p; simpl.
+  - rewrite -intuitionistically_and !intuitionistically_idemp //.
+  - intros ->. by rewrite intuitionistically_and.
+Qed.
+Global Instance into_and_persistently p P Q1 Q2 :
+  IntoAnd p P Q1 Q2 →
+  IntoAnd p (<pers> P) (<pers> Q1) (<pers> Q2).
+Proof.
+  rewrite /IntoAnd /=. destruct p; simpl.
+  - rewrite -persistently_and !intuitionistically_persistently_elim //.
+  - intros ->. by rewrite persistently_and.
+Qed.
+
+(** IntoSep *)
+Global Instance into_sep_sep P Q : IntoSep (P ∗ Q) P Q.
+Proof. by rewrite /IntoSep. Qed.
+
+Inductive AndIntoSep : PROP → PROP → PROP → PROP → Prop :=
+  | and_into_sep_affine P Q Q' : Affine P → FromAffinely Q' Q → AndIntoSep P P Q Q'
+  | and_into_sep P Q : AndIntoSep P (<affine> P) Q Q.
+Existing Class AndIntoSep.
+Global Existing Instance and_into_sep_affine | 0.
+Global Existing Instance and_into_sep | 2.
+
+Global Instance into_sep_and_persistent_l P P' Q Q' :
+  Persistent P → AndIntoSep P P' Q Q' → IntoSep (P ∧ Q) P' Q'.
+Proof.
+  destruct 2 as [P Q Q'|P Q]; rewrite /IntoSep.
+  - rewrite -(from_affinely Q' Q) -(affine_affinely P) affinely_and_lr.
+    by rewrite persistent_and_affinely_sep_l_1.
+  - by rewrite persistent_and_affinely_sep_l_1.
+Qed.
+Global Instance into_sep_and_persistent_r P P' Q Q' :
+  Persistent Q → AndIntoSep Q Q' P P' → IntoSep (P ∧ Q) P' Q'.
+Proof.
+  destruct 2 as [Q P P'|Q P]; rewrite /IntoSep.
+  - rewrite -(from_affinely P' P) -(affine_affinely Q) -affinely_and_lr.
+    by rewrite persistent_and_affinely_sep_r_1.
+  - by rewrite persistent_and_affinely_sep_r_1.
+Qed.
+
+Global Instance into_sep_pure φ ψ : @IntoSep PROP ⌜φ ∧ ψ⌝ ⌜φ⌝ ⌜ψ⌝.
+Proof. by rewrite /IntoSep pure_and persistent_and_sep_1. Qed.
+
+Global Instance into_sep_affinely `{!BiPositive PROP} P Q1 Q2 :
+  IntoSep P Q1 Q2 → IntoSep (<affine> P) (<affine> Q1) (<affine> Q2) | 0.
+Proof. rewrite /IntoSep /= => ->. by rewrite affinely_sep. Qed.
+Global Instance into_sep_intuitionistically `{!BiPositive PROP} P Q1 Q2 :
+  IntoSep P Q1 Q2 → IntoSep (□ P) (□ Q1) (□ Q2) | 0.
+Proof. rewrite /IntoSep /= => ->. by rewrite intuitionistically_sep. Qed.
+(* FIXME: This instance is kind of strange, it just gets rid of the bi_affinely.
+Also, it overlaps with `into_sep_affinely_later`, and hence has higher
+cost. *)
+Global Instance into_sep_affinely_trim P Q1 Q2 :
+  IntoSep P Q1 Q2 → IntoSep (<affine> P) Q1 Q2 | 20.
+Proof. rewrite /IntoSep /= => ->. by rewrite affinely_elim. Qed.
+
+Global Instance into_sep_persistently `{!BiPositive PROP} P Q1 Q2 :
+  IntoSep P Q1 Q2 →
+  IntoSep (<pers> P) (<pers> Q1) (<pers> Q2).
+Proof. rewrite /IntoSep /= => ->. by rewrite persistently_sep. Qed.
+Global Instance into_sep_persistently_affine P Q1 Q2 :
+  IntoSep P Q1 Q2 →
+  TCOr (Affine Q1) (Absorbing Q2) → TCOr (Affine Q2) (Absorbing Q1) →
+  IntoSep (<pers> P) (<pers> Q1) (<pers> Q2).
+Proof.
+  rewrite /IntoSep /= => -> ??.
+  by rewrite sep_and persistently_and persistently_and_sep_l_1.
+Qed.
+Global Instance into_sep_intuitionistically_affine P Q1 Q2 :
+  IntoSep P Q1 Q2 →
+  TCOr (Affine Q1) (Absorbing Q2) → TCOr (Affine Q2) (Absorbing Q1) →
+  IntoSep (□ P) (□ Q1) (□ Q2).
+Proof.
+  rewrite /IntoSep /= => -> ??.
+  by rewrite sep_and intuitionistically_and and_sep_intuitionistically.
+Qed.
+
+Global Instance into_sep_big_sepL_cons {A} (Φ : nat → A → PROP) l x l' :
+  IsCons l x l' →
+  IntoSep ([∗ list] k ↦ y ∈ l, Φ k y)
+    (Φ 0 x) ([∗ list] k ↦ y ∈ l', Φ (S k) y).
+Proof. rewrite /IsCons=>->. by rewrite /IntoSep big_sepL_cons. Qed.
+Global Instance into_sep_big_sepL_app {A} (Φ : nat → A → PROP) l l1 l2 :
+  IsApp l l1 l2 →
+  IntoSep ([∗ list] k ↦ y ∈ l, Φ k y)
+    ([∗ list] k ↦ y ∈ l1, Φ k y) ([∗ list] k ↦ y ∈ l2, Φ (length l1 + k) y).
+Proof. rewrite /IsApp=>->. by rewrite /IntoSep big_sepL_app. Qed.
+
+(* No instance for app, since that only works when the LHSs have the same length *)
+Global Instance into_sep_big_sepL2_cons {A B}
+    (Φ : nat → A → B → PROP) l1 x1 l1' l2 x2 l2' :
+  IsCons l1 x1 l1' → IsCons l2 x2 l2' →
+  IntoSep ([∗ list] k ↦ y1;y2 ∈ l1;l2, Φ k y1 y2)
+    (Φ 0 x1 x2) ([∗ list] k ↦ y1;y2 ∈ l1';l2', Φ (S k) y1 y2).
+Proof. rewrite /IsCons=>-> ->. by rewrite /IntoSep big_sepL2_cons. Qed.
+
+Global Instance into_sep_big_sepMS_disj_union `{Countable A} (Φ : A → PROP) X1 X2 :
+  IntoSep ([∗ mset] y ∈ X1 ⊎ X2, Φ y) ([∗ mset] y ∈ X1, Φ y) ([∗ mset] y ∈ X2, Φ y).
+Proof. by rewrite /IntoSep big_sepMS_disj_union. Qed.
+
+(** FromOr *)
+Global Instance from_or_or P1 P2 : FromOr (P1 ∨ P2) P1 P2.
+Proof. by rewrite /FromOr. Qed.
+Global Instance from_or_pure φ ψ : @FromOr PROP ⌜φ ∨ ψ⌝ ⌜φ⌝ ⌜ψ⌝.
+Proof. by rewrite /FromOr pure_or. Qed.
+Global Instance from_or_affinely P Q1 Q2 :
+  FromOr P Q1 Q2 → FromOr (<affine> P) (<affine> Q1) (<affine> Q2).
+Proof. rewrite /FromOr=> <-. by rewrite affinely_or. Qed.
+Global Instance from_or_intuitionistically P Q1 Q2 :
+  FromOr P Q1 Q2 → FromOr (□ P) (□ Q1) (□ Q2).
+Proof. rewrite /FromOr=> <-. by rewrite intuitionistically_or. Qed.
+Global Instance from_or_absorbingly P Q1 Q2 :
+  FromOr P Q1 Q2 → FromOr (<absorb> P) (<absorb> Q1) (<absorb> Q2).
+Proof. rewrite /FromOr=> <-. by rewrite absorbingly_or. Qed.
+Global Instance from_or_persistently P Q1 Q2 :
+  FromOr P Q1 Q2 →
+  FromOr (<pers> P) (<pers> Q1) (<pers> Q2).
+Proof. rewrite /FromOr=> <-. by rewrite persistently_or. Qed.
+
+(** IntoOr *)
+Global Instance into_or_or P Q : IntoOr (P ∨ Q) P Q.
+Proof. by rewrite /IntoOr. Qed.
+Global Instance into_or_pure φ ψ : @IntoOr PROP ⌜φ ∨ ψ⌝ ⌜φ⌝ ⌜ψ⌝.
+Proof. by rewrite /IntoOr pure_or. Qed.
+Global Instance into_or_affinely P Q1 Q2 :
+  IntoOr P Q1 Q2 → IntoOr (<affine> P) (<affine> Q1) (<affine> Q2).
+Proof. rewrite /IntoOr=>->. by rewrite affinely_or. Qed.
+Global Instance into_or_intuitionistically P Q1 Q2 :
+  IntoOr P Q1 Q2 → IntoOr (□ P) (□ Q1) (□ Q2).
+Proof. rewrite /IntoOr=>->. by rewrite intuitionistically_or. Qed.
+Global Instance into_or_absorbingly P Q1 Q2 :
+  IntoOr P Q1 Q2 → IntoOr (<absorb> P) (<absorb> Q1) (<absorb> Q2).
+Proof. rewrite /IntoOr=>->. by rewrite absorbingly_or. Qed.
+Global Instance into_or_persistently P Q1 Q2 :
+  IntoOr P Q1 Q2 →
+  IntoOr (<pers> P) (<pers> Q1) (<pers> Q2).
+Proof. rewrite /IntoOr=>->. by rewrite persistently_or. Qed.
+
+(** FromExist *)
+Global Instance from_exist_texist {TT : tele} (Φ : TT → PROP) :
+  FromExist (∃.. a, Φ a) Φ.
+Proof. by rewrite /FromExist bi_texist_exist. Qed.
+Global Instance from_exist_pure {A} (φ : A → Prop) :
+  @FromExist PROP A ⌜∃ x, φ x⌝ (λ a, ⌜φ a⌝)%I.
+Proof. by rewrite /FromExist pure_exist. Qed.
+Global Instance from_exist_affinely {A} P (Φ : A → PROP) :
+  FromExist P Φ → FromExist (<affine> P) (λ a, <affine> (Φ a))%I.
+Proof. rewrite /FromExist=> <-. by rewrite affinely_exist. Qed.
+Global Instance from_exist_intuitionistically {A} P (Φ : A → PROP) :
+  FromExist P Φ → FromExist (□ P) (λ a, □ (Φ a))%I.
+Proof. rewrite /FromExist=> <-. by rewrite intuitionistically_exist. Qed.
+Global Instance from_exist_absorbingly {A} P (Φ : A → PROP) :
+  FromExist P Φ → FromExist (<absorb> P) (λ a, <absorb> (Φ a))%I.
+Proof. rewrite /FromExist=> <-. by rewrite absorbingly_exist. Qed.
+Global Instance from_exist_persistently {A} P (Φ : A → PROP) :
+  FromExist P Φ → FromExist (<pers> P) (λ a, <pers> (Φ a))%I.
+Proof. rewrite /FromExist=> <-. by rewrite persistently_exist. Qed.
+
+(** IntoExist *)
+
+(* These three instances [into_exist_exist], [into_exist_pure], and
+   [into_exist_texist] need to be written without notations, for example
+   [bi_exist Φ] and not [∃ a, Φ a], so that [AsIdentName] is always passed the
+   entire body of the exists with the binder. *)
+Global Instance into_exist_exist {A} (Φ : A → PROP) name :
+  AsIdentName Φ name → IntoExist (bi_exist Φ) Φ name.
+Proof. by rewrite /IntoExist. Qed.
+Global Instance into_exist_pure {A} (φ : A → Prop) name :
+  AsIdentName φ name →
+  @IntoExist PROP A ⌜ex φ⌝ (λ a, ⌜φ a⌝)%I name.
+Proof. by rewrite /IntoExist pure_exist. Qed.
+Global Instance into_exist_texist {TT : tele} (Φ : TT → PROP) name :
+  AsIdentName Φ name → IntoExist (bi_texist Φ) Φ name | 10.
+Proof. by rewrite /IntoExist bi_texist_exist. Qed.
+Global Instance into_exist_affinely {A} P (Φ : A → PROP) name :
+  IntoExist P Φ name → IntoExist (<affine> P) (λ a, <affine> (Φ a))%I name.
+Proof. rewrite /IntoExist=> HP. by rewrite HP affinely_exist. Qed.
+Global Instance into_exist_intuitionistically {A} P (Φ : A → PROP) name :
+  IntoExist P Φ name → IntoExist (□ P) (λ a, □ (Φ a))%I name.
+Proof. rewrite /IntoExist=> HP. by rewrite HP intuitionistically_exist. Qed.
+(* This instance is generalized to let us use [iDestruct as (P) "..."] and
+[iIntros "[% ...]"] for conjunctions with a pure left-hand side. There is some
+risk of backtracking here, but that should only happen in failing cases
+(assuming that appropriate modality commuting instances are provided for both
+conjunctions and existential quantification). The alternative of providing
+specialized instances for cases like ⌜P ∧ Q⌝ turned out to not be tenable.
+
+[to_ident_name H] makes the default name [H] when [P] is destructed with
+[iExistDestruct]. See [IntoPureT] for why [φ] is a [Type]. *)
+Global Instance into_exist_and_pure PQ P Q (φ : Type) :
+  IntoAnd false PQ P Q →
+  IntoPureT P φ →
+  IntoExist PQ (λ _ : φ, Q) (to_ident_name H) | 10.
+Proof.
+  intros HPQ (φ'&->&?). rewrite /IntoAnd /= in HPQ.
+  rewrite /IntoExist HPQ (into_pure P).
+  apply pure_elim_l=> Hφ. by rewrite -(exist_intro Hφ).
+Qed.
+(* [to_ident_name H] makes the default name [H] when [P] is destructed with
+[iExistDestruct]. See [IntoPureT] for why [φ] is a [Type]. *)
+Global Instance into_exist_sep_pure P Q (φ : Type) :
+  IntoPureT P φ →
+  TCOr (Affine P) (Absorbing Q) →
+  IntoExist (P ∗ Q) (λ _ : φ, Q) (to_ident_name H).
+Proof.
+  intros (φ'&->&?) ?. rewrite /IntoExist.
+  eapply (pure_elim φ'); [by rewrite (into_pure P); apply sep_elim_l, _|]=>?.
+  rewrite -exist_intro //. apply sep_elim_r, _.
+Qed.
+Global Instance into_exist_absorbingly {A} P (Φ : A → PROP) name :
+  IntoExist P Φ name → IntoExist (<absorb> P) (λ a, <absorb> (Φ a))%I name.
+Proof. rewrite /IntoExist=> HP. by rewrite HP absorbingly_exist. Qed.
+Global Instance into_exist_persistently {A} P (Φ : A → PROP) name :
+  IntoExist P Φ name → IntoExist (<pers> P) (λ a, <pers> (Φ a))%I name.
+Proof. rewrite /IntoExist=> HP. by rewrite HP persistently_exist. Qed.
+
+(** IntoForall *)
+Global Instance into_forall_forall {A} (Φ : A → PROP) : IntoForall (∀ a, Φ a) Φ.
+Proof. by rewrite /IntoForall. Qed.
+Global Instance into_forall_tforall {TT : tele} (Φ : TT → PROP) :
+  IntoForall (∀.. a, Φ a) Φ | 10.
+Proof. by rewrite /IntoForall bi_tforall_forall. Qed.
+Global Instance into_forall_affinely {A} P (Φ : A → PROP) :
+  IntoForall P Φ → IntoForall (<affine> P) (λ a, <affine> (Φ a))%I.
+Proof. rewrite /IntoForall=> HP. by rewrite HP affinely_forall. Qed.
+Global Instance into_forall_intuitionistically {A} P (Φ : A → PROP) :
+  IntoForall P Φ → IntoForall (□ P) (λ a, □ (Φ a))%I.
+Proof. rewrite /IntoForall=> HP. by rewrite HP intuitionistically_forall. Qed.
+Global Instance into_forall_persistently `{!BiPersistentlyForall PROP} {A} P (Φ : A → PROP) :
+  IntoForall P Φ → IntoForall (<pers> P) (λ a, <pers> (Φ a))%I.
+Proof. rewrite /IntoForall=> HP. by rewrite HP persistently_forall. Qed.
+
+Global Instance into_forall_impl_pure a φ P Q :
+  FromPureT a P φ →
+  TCOr (TCEq a false) (BiAffine PROP) →
+  IntoForall (P → Q) (λ _ : φ, Q).
+Proof.
+  rewrite /FromPureT /FromPure /IntoForall=> -[φ' [-> <-]] [->|?] /=.
+  - by rewrite pure_impl_forall.
+  - by rewrite -affinely_affinely_if affine_affinely pure_impl_forall.
+Qed.
+Global Instance into_forall_wand_pure a φ P Q :
+  FromPureT a P φ → IntoForall (P -∗ Q) (λ _ : φ, Q).
+Proof.
+  rewrite /FromPureT /FromPure /IntoForall=> -[φ' [-> <-]] /=.
+  apply forall_intro=>? /=. rewrite -affinely_affinely_if.
+  by rewrite -(pure_intro _ True) // /bi_affinely right_id emp_wand.
+Qed.
+
+(* These instances must be used only after [into_forall_wand_pure] and
+[into_forall_wand_pure] above. *)
+Global Instance into_forall_wand P Q :
+  IntoForall (P -∗ Q) (λ _ : ⊢ P, Q) | 10.
+Proof. rewrite /IntoForall. apply forall_intro=><-. rewrite emp_wand //. Qed.
+Global Instance into_forall_impl `{!BiAffine PROP} P Q :
+  IntoForall (P → Q) (λ _ : ⊢ P, Q) | 10.
+Proof.
+  rewrite /IntoForall. apply forall_intro=><-. rewrite -True_emp True_impl //.
+Qed.
+
+(** FromForall *)
+Global Instance from_forall_forall {A} (Φ : A → PROP) name :
+  AsIdentName Φ name → FromForall (bi_forall Φ) Φ name.
+Proof. by rewrite /FromForall. Qed.
+Global Instance from_forall_tforall {TT : tele} (Φ : TT → PROP) name :
+  AsIdentName Φ name → FromForall (bi_tforall Φ) Φ name.
+Proof. by rewrite /FromForall bi_tforall_forall. Qed.
+Global Instance from_forall_pure `{!BiPureForall PROP} {A} (φ : A → Prop) name :
+  AsIdentName φ name → @FromForall PROP A ⌜∀ a : A, φ a⌝ (λ a, ⌜ φ a ⌝)%I name.
+Proof. by rewrite /FromForall pure_forall_2. Qed.
+Global Instance from_tforall_pure `{!BiPureForall PROP}
+    {TT : tele} (φ : TT → Prop) name :
+  AsIdentName φ name → @FromForall PROP TT ⌜tforall φ⌝ (λ x, ⌜ φ x ⌝)%I name.
+Proof. by rewrite /FromForall tforall_forall pure_forall. Qed.
+
+(* [H] is the default name for the [φ] hypothesis, in the following three instances *)
+Global Instance from_forall_pure_not `{!BiPureForall PROP} (φ : Prop) :
+  @FromForall PROP φ ⌜¬ φ⌝ (λ _ : φ, False)%I (to_ident_name H).
+Proof. by rewrite /FromForall pure_forall. Qed.
+Global Instance from_forall_impl_pure P Q φ :
+  IntoPureT P φ → FromForall (P → Q) (λ _ : φ, Q) (to_ident_name H).
+Proof.
+  intros (φ'&->&?). by rewrite /FromForall -pure_impl_forall (into_pure P).
+Qed.
+Global Instance from_forall_wand_pure P Q φ :
+  IntoPureT P φ → TCOr (Affine P) (Absorbing Q) →
+  FromForall (P -∗ Q) (λ _ : φ, Q)%I (to_ident_name H).
+Proof.
+  intros (φ'&->&?) [|]; rewrite /FromForall; apply wand_intro_r.
+  - rewrite -(affine_affinely P) (into_pure P) -persistent_and_affinely_sep_r.
+    apply pure_elim_r=>?. by rewrite forall_elim.
+  - by rewrite (into_pure P) -pure_wand_forall wand_elim_l.
+Qed.
+
+Global Instance from_forall_intuitionistically `{!BiAffine PROP, !BiPersistentlyForall PROP}
+    {A} P (Φ : A → PROP) name :
+  FromForall P Φ name → FromForall (□ P) (λ a, □ (Φ a))%I name.
+Proof.
+  rewrite /FromForall=> <-. setoid_rewrite intuitionistically_into_persistently.
+  by rewrite persistently_forall.
+Qed.
+Global Instance from_forall_persistently `{!BiPersistentlyForall PROP}
+    {A} P (Φ : A → PROP) name :
+  FromForall P Φ name → FromForall (<pers> P) (λ a, <pers> (Φ a))%I name.
+Proof. rewrite /FromForall=> <-. by rewrite persistently_forall. Qed.
+
+(** ElimModal *)
+Global Instance elim_modal_wand φ p p' P P' Q Q' R :
+  ElimModal φ p p' P P' Q Q' → ElimModal φ p p' P P' (R -∗ Q) (R -∗ Q').
+Proof.
+  rewrite /ElimModal=> H Hφ. apply wand_intro_r.
+  rewrite wand_curry -assoc (comm _ (□?p' _)%I) -wand_curry wand_elim_l; auto.
+Qed.
+Global Instance elim_modal_wandM φ p p' P P' Q Q' mR :
+  ElimModal φ p p' P P' Q Q' →
+  ElimModal φ p p' P P' (mR -∗? Q) (mR -∗? Q').
+Proof. rewrite /ElimModal !wandM_sound. exact: elim_modal_wand. Qed.
+Global Instance elim_modal_forall {A} φ p p' P P' (Φ Ψ : A → PROP) :
+  (∀ x, ElimModal φ p p' P P' (Φ x) (Ψ x)) →
+  ElimModal φ p p' P P' (∀ x, Φ x) (∀ x, Ψ x).
+Proof.
+  rewrite /ElimModal=> H ?. apply forall_intro=> a. rewrite (forall_elim a); auto.
+Qed.
+Global Instance elim_modal_tforall {TT : tele} φ p p' P P' (Φ Ψ : TT → PROP) :
+  (∀ x, ElimModal φ p p' P P' (Φ x) (Ψ x)) →
+  ElimModal φ p p' P P' (∀.. x, Φ x) (∀.. x, Ψ x).
+Proof. rewrite /ElimModal !bi_tforall_forall. apply elim_modal_forall. Qed.
+Global Instance elim_modal_absorbingly_here p P Q :
+  Absorbing Q → ElimModal True p false (<absorb> P) P Q Q.
+Proof.
+  rewrite /ElimModal=> ? _. by rewrite intuitionistically_if_elim
+    absorbingly_sep_l wand_elim_r absorbing_absorbingly.
+Qed.
+
+(** AddModal *)
+Global Instance add_modal_wand P P' Q R :
+  AddModal P P' Q → AddModal P P' (R -∗ Q).
+Proof.
+  rewrite /AddModal=> H. apply wand_intro_r.
+  by rewrite wand_curry -assoc (comm _ P') -wand_curry wand_elim_l.
+Qed.
+Global Instance add_modal_wandM P P' Q mR :
+  AddModal P P' Q → AddModal P P' (mR -∗? Q).
+Proof. rewrite /AddModal wandM_sound. exact: add_modal_wand. Qed.
+Global Instance add_modal_forall {A} P P' (Φ : A → PROP) :
+  (∀ x, AddModal P P' (Φ x)) → AddModal P P' (∀ x, Φ x).
+Proof.
+  rewrite /AddModal=> H. apply forall_intro=> a. by rewrite (forall_elim a).
+Qed.
+Global Instance add_modal_tforall {TT : tele} P P' (Φ : TT → PROP) :
+  (∀ x, AddModal P P' (Φ x)) → AddModal P P' (∀.. x, Φ x).
+Proof. rewrite /AddModal bi_tforall_forall. apply add_modal_forall. Qed.
+
+(** ElimInv *)
+Global Instance elim_inv_acc_without_close {X : Type}
+     φ1 φ2 Pinv Pin (M1 M2 : PROP → PROP) α β mγ Q (Q' : X → PROP) :
+  IntoAcc (X:=X) Pinv φ1 Pin M1 M2 α β mγ →
+  ElimAcc (X:=X) φ2 M1 M2 α β mγ Q Q' →
+  ElimInv (φ1 ∧ φ2) Pinv Pin α None Q Q'.
+Proof.
+  rewrite /ElimAcc /IntoAcc /ElimInv.
+  iIntros (Hacc Helim [??]) "(Hinv & Hin & Hcont)".
+  iApply (Helim with "[Hcont]"); first done.
+  - iIntros (x) "Hα". iApply "Hcont". iSplitL; simpl; done.
+  - iApply (Hacc with "Hinv Hin"). done.
+Qed.
+
+(* This uses [pm_default] because, after inference, all accessors will have
+[None] or [Some _] there, so we want to reduce the combinator before showing the
+goal to the user. *)
+Global Instance elim_inv_acc_with_close {X : Type}
+    φ1 φ2 Pinv Pin (M1 M2 : PROP → PROP) α β mγ Q Q' :
+  IntoAcc Pinv φ1 Pin M1 M2 α β mγ →
+  (∀ R, ElimModal φ2 false false (M1 R) R Q Q') →
+  ElimInv (X:=X) (φ1 ∧ φ2) Pinv Pin
+          α
+          (Some (λ x, β x -∗ M2 (pm_default emp (mγ x))))%I
+          Q (λ _, Q').
+Proof.
+  rewrite /ElimAcc /IntoAcc /ElimInv.
+  iIntros (Hacc Helim [??]) "(Hinv & Hin & Hcont)".
+  iMod (Hacc with "Hinv Hin") as (x) "[Hα Hclose]"; first done.
+  iApply "Hcont". simpl. iSplitL "Hα"; done.
+Qed.
+End class_instances.

iris/proofmode/class_instances_embedding.v

+From iris.bi Require Import bi.
+From iris.proofmode Require Import modality_instances classes.
+From iris.prelude Require Import options.
+Import bi.
+
+(** We add a useless hypothesis [BiEmbed PROP PROP'] in order to make sure this
+instance is not used when there is no embedding between [PROP] and [PROP']. The
+first [`{BiEmbed PROP PROP'}] is not considered as a premise by Coq TC search
+mechanism because the rest of the hypothesis is dependent on it. *)
+Global Instance as_emp_valid_embed `{!BiEmbed PROP PROP'} d (φ : Prop) (P : PROP) :
+  BiEmbed PROP PROP' →
+  AsEmpValid0 d φ P → AsEmpValid d φ ⎡P⎤.
+Proof. rewrite /AsEmpValid0 /AsEmpValid=> _ [? ?]. rewrite embed_emp_valid //. Qed.
+
+Section class_instances_embedding.
+Context `{!BiEmbed PROP PROP'}.
+Implicit Types P Q R : PROP.
+
+Global Instance into_pure_embed P φ :
+  IntoPure P φ → IntoPure ⎡P⎤ φ.
+Proof. rewrite /IntoPure=> ->. by rewrite embed_pure. Qed.
+
+Global Instance from_pure_embed a P φ :
+  FromPure a P φ → FromPure a ⎡P⎤ φ.
+Proof. rewrite /FromPure=> <-. by rewrite -embed_pure embed_affinely_if_2. Qed.
+
+Global Instance into_persistent_embed p P Q :
+  IntoPersistent p P Q → IntoPersistent p ⎡P⎤ ⎡Q⎤ | 0.
+Proof.
+  rewrite /IntoPersistent -embed_persistently -embed_persistently_if=> -> //.
+Qed.
+
+(* When having a modality nested in an embedding, e.g. [ ⎡|==> P⎤ ], we prefer
+the embedding over the modality. *)
+Global Instance from_modal_embed P :
+  FromModal True (@modality_embed PROP PROP' _) ⎡P⎤ ⎡P⎤ P.
+Proof. by rewrite /FromModal. Qed.
+
+Global Instance from_modal_id_embed φ `(sel : A) P Q :
+  FromModal φ modality_id sel P Q →
+  FromModal φ modality_id sel ⎡P⎤ ⎡Q⎤ | 100.
+Proof. rewrite /FromModal /= =>HPQ ?. by rewrite -HPQ. Qed.
+
+Global Instance from_modal_affinely_embed φ `(sel : A) P Q :
+  FromModal φ modality_affinely sel P Q →
+  FromModal φ modality_affinely sel ⎡P⎤ ⎡Q⎤ | 100.
+Proof. rewrite /FromModal /= =>HPQ ?. by rewrite -HPQ // embed_affinely_2. Qed.
+Global Instance from_modal_persistently_embed φ `(sel : A) P Q :
+  FromModal φ modality_persistently sel P Q →
+  FromModal φ modality_persistently sel ⎡P⎤ ⎡Q⎤ | 100.
+Proof. rewrite /FromModal /= =>HPQ ?. by rewrite -HPQ // embed_persistently. Qed.
+Global Instance from_modal_intuitionistically_embed φ `(sel : A) P Q :
+  FromModal φ modality_intuitionistically sel P Q →
+  FromModal φ modality_intuitionistically sel ⎡P⎤ ⎡Q⎤ | 100.
+Proof. rewrite /FromModal /= =>HPQ ?. by rewrite -HPQ // embed_intuitionistically_2. Qed.
+
+Global Instance into_wand_embed p q R P Q :
+  IntoWand p q R P Q → IntoWand p q ⎡R⎤ ⎡P⎤ ⎡Q⎤.
+Proof. by rewrite /IntoWand !embed_intuitionistically_if_2 -embed_wand=> ->. Qed.
+
+(* There are two versions for [IntoWand ⎡R⎤ ...] with the argument being
+[<affine> ⎡P⎤]. When the wand [⎡R⎤] resides in the intuitionistic context
+the result of wand elimination will have the affine modality. Otherwise, it
+won't. Note that when the wand [⎡R⎤] is under an affine modality, the instance
+[into_wand_affine] would already have been used. *)
+Global Instance into_wand_affine_embed_true q P Q R :
+  IntoWand true q R P Q → IntoWand true q ⎡R⎤ (<affine> ⎡P⎤) (<affine> ⎡Q⎤) | 100.
+Proof.
+  rewrite /IntoWand /=.
+  rewrite -(intuitionistically_idemp ⎡ _ ⎤) embed_intuitionistically_2=> ->.
+  apply bi.wand_intro_l. destruct q; simpl.
+  - rewrite affinely_elim  -(intuitionistically_idemp ⎡ _ ⎤).
+    rewrite embed_intuitionistically_2 intuitionistically_sep_2 -embed_sep.
+    by rewrite wand_elim_r intuitionistically_affinely.
+  - by rewrite intuitionistically_affinely affinely_sep_2 -embed_sep wand_elim_r.
+Qed.
+Global Instance into_wand_affine_embed_false q P Q R :
+  IntoWand false q R (<affine> P) Q →
+  IntoWand false q ⎡R⎤ (<affine> ⎡P⎤) ⎡Q⎤ | 100.
+Proof.
+  rewrite /IntoWand /= => ->.
+  by rewrite embed_affinely_2 embed_intuitionistically_if_2 embed_wand.
+Qed.
+
+Global Instance from_wand_embed P Q1 Q2 :
+  FromWand P Q1 Q2 → FromWand ⎡P⎤ ⎡Q1⎤ ⎡Q2⎤.
+Proof. by rewrite /FromWand -embed_wand => <-. Qed.
+
+Global Instance from_impl_embed P Q1 Q2 :
+  FromImpl P Q1 Q2 → FromImpl ⎡P⎤ ⎡Q1⎤ ⎡Q2⎤.
+Proof. by rewrite /FromImpl -embed_impl => <-. Qed.
+
+Global Instance from_and_embed P Q1 Q2 :
+  FromAnd P Q1 Q2 → FromAnd ⎡P⎤ ⎡Q1⎤ ⎡Q2⎤.
+Proof. by rewrite /FromAnd -embed_and => <-. Qed.
+
+Global Instance from_sep_embed P Q1 Q2 :
+  FromSep P Q1 Q2 → FromSep ⎡P⎤ ⎡Q1⎤ ⎡Q2⎤.
+Proof. by rewrite /FromSep -embed_sep => <-. Qed.
+
+Global Instance maybe_combine_sep_as_embed Q1 Q2 P progress :
+  MaybeCombineSepAs Q1 Q2 P progress →
+  MaybeCombineSepAs ⎡Q1⎤ ⎡Q2⎤ ⎡P⎤ progress.
+Proof. by rewrite /MaybeCombineSepAs -embed_sep => <-. Qed.
+
+Global Instance combine_sep_gives_embed Q1 Q2 P :
+  CombineSepGives Q1 Q2 P →
+  CombineSepGives ⎡Q1⎤ ⎡Q2⎤ ⎡P⎤.
+Proof. by rewrite /CombineSepGives -embed_sep -embed_persistently => ->. Qed.
+
+Global Instance into_and_embed p P Q1 Q2 :
+  IntoAnd p P Q1 Q2 → IntoAnd p ⎡P⎤ ⎡Q1⎤ ⎡Q2⎤.
+Proof.
+  rewrite /IntoAnd -embed_and=> HP. apply intuitionistically_if_intro'.
+  by rewrite embed_intuitionistically_if_2 HP intuitionistically_if_elim.
+Qed.
+
+Global Instance into_sep_embed P Q1 Q2 :
+  IntoSep P Q1 Q2 → IntoSep ⎡P⎤ ⎡Q1⎤ ⎡Q2⎤.
+Proof. rewrite /IntoSep -embed_sep=> -> //. Qed.
+
+Global Instance from_or_embed P Q1 Q2 :
+  FromOr P Q1 Q2 → FromOr ⎡P⎤ ⎡Q1⎤ ⎡Q2⎤.
+Proof. by rewrite /FromOr -embed_or => <-. Qed.
+
+Global Instance into_or_embed P Q1 Q2 :
+  IntoOr P Q1 Q2 → IntoOr ⎡P⎤ ⎡Q1⎤ ⎡Q2⎤.
+Proof. by rewrite /IntoOr -embed_or => <-. Qed.
+
+Global Instance from_exist_embed {A} P (Φ : A → PROP) :
+  FromExist P Φ → FromExist ⎡P⎤ (λ a, ⎡Φ a⎤%I).
+Proof. by rewrite /FromExist -embed_exist => <-. Qed.
+
+Global Instance into_exist_embed {A} P (Φ : A → PROP) name :
+  IntoExist P Φ name → IntoExist ⎡P⎤ (λ a, ⎡Φ a⎤%I) name.
+Proof. by rewrite /IntoExist -embed_exist => <-. Qed.
+
+Global Instance into_forall_embed {A} P (Φ : A → PROP) :
+  IntoForall P Φ → IntoForall ⎡P⎤ (λ a, ⎡Φ a⎤%I).
+Proof. by rewrite /IntoForall -embed_forall => <-. Qed.
+
+Global Instance from_forall_embed {A} P (Φ : A → PROP) name :
+  FromForall P Φ name → FromForall ⎡P⎤ (λ a, ⎡Φ a⎤%I) name.
+Proof. by rewrite /FromForall -embed_forall => <-. Qed.
+
+Global Instance into_inv_embed P N : IntoInv P N → IntoInv ⎡P⎤ N := {}.
+
+Global Instance is_except_0_embed `{!BiEmbedLater PROP PROP'} P :
+  IsExcept0 P → IsExcept0 ⎡P⎤.
+Proof. by rewrite /IsExcept0 -embed_except_0=>->. Qed.
+
+Global Instance from_modal_later_embed `{!BiEmbedLater PROP PROP'} φ `(sel : A) n P Q :
+  FromModal φ (modality_laterN n) sel P Q →
+  FromModal φ (modality_laterN n) sel ⎡P⎤ ⎡Q⎤.
+Proof. rewrite /FromModal /= =>HPQ ?. by rewrite -HPQ // embed_laterN. Qed.
+
+Global Instance from_modal_plainly_embed
+    `{!BiPlainly PROP, !BiPlainly PROP', !BiEmbedPlainly PROP PROP'} φ `(sel : A) P Q :
+  FromModal φ modality_plainly sel P Q →
+  FromModal φ (PROP2:=PROP') modality_plainly sel ⎡P⎤ ⎡Q⎤ | 100.
+Proof. rewrite /FromModal /= =>HPQ ?. by rewrite -HPQ // embed_plainly. Qed.
+
+Global Instance into_internal_eq_embed
+    `{!BiInternalEq PROP, !BiInternalEq PROP', !BiEmbedInternalEq PROP PROP'}
+    {A : ofe} (x y : A) (P : PROP) :
+  IntoInternalEq P x y → IntoInternalEq (⎡P⎤ : PROP')%I x y.
+Proof. rewrite /IntoInternalEq=> ->. by rewrite embed_internal_eq. Qed.
+
+Global Instance into_except_0_embed `{!BiEmbedLater PROP PROP'} P Q :
+  IntoExcept0 P Q → IntoExcept0 ⎡P⎤ ⎡Q⎤.
+Proof. rewrite /IntoExcept0=> ->. by rewrite embed_except_0. Qed.
+
+Global Instance elim_modal_embed_bupd_goal
+    `{!BiBUpd PROP, !BiBUpd PROP', !BiEmbedBUpd PROP PROP'}
+    p p' φ (P P' : PROP') (Q Q' : PROP) :
+  ElimModal φ p p' P P' (|==> ⎡Q⎤)%I (|==> ⎡Q'⎤)%I →
+  ElimModal φ p p' P P' ⎡|==> Q⎤ ⎡|==> Q'⎤.
+Proof. by rewrite /ElimModal !embed_bupd. Qed.
+Global Instance elim_modal_embed_bupd_hyp
+    `{!BiBUpd PROP, !BiBUpd PROP', !BiEmbedBUpd PROP PROP'}
+    p p' φ (P : PROP) (P' Q Q' : PROP') :
+  ElimModal φ p p' (|==> ⎡P⎤)%I P' Q Q' →
+  ElimModal φ p p' ⎡|==> P⎤ P' Q Q'.
+Proof. by rewrite /ElimModal !embed_bupd. Qed.
+
+Global Instance elim_modal_embed_fupd_goal
+    `{!BiFUpd PROP, !BiFUpd PROP', !BiEmbedFUpd PROP PROP'}
+    p p' φ E1 E2 E3 (P P' : PROP') (Q Q' : PROP) :
+  ElimModal φ p p' P P' (|={E1,E3}=> ⎡Q⎤)%I (|={E2,E3}=> ⎡Q'⎤)%I →
+  ElimModal φ p p' P P' ⎡|={E1,E3}=> Q⎤ ⎡|={E2,E3}=> Q'⎤.
+Proof. by rewrite /ElimModal !embed_fupd. Qed.
+Global Instance elim_modal_embed_fupd_hyp
+    `{!BiFUpd PROP, !BiFUpd PROP', !BiEmbedFUpd PROP PROP'}
+    p p' φ E1 E2 (P : PROP) (P' Q Q' : PROP') :
+  ElimModal φ p p' (|={E1,E2}=> ⎡P⎤)%I P' Q Q' →
+  ElimModal φ p p' ⎡|={E1,E2}=> P⎤ P' Q Q'.
+Proof. by rewrite /ElimModal embed_fupd. Qed.
+
+Global Instance add_modal_embed_bupd_goal
+    `{!BiBUpd PROP, !BiBUpd PROP', !BiEmbedBUpd PROP PROP'}
+    (P P' : PROP') (Q : PROP) :
+  AddModal P P' (|==> ⎡Q⎤)%I → AddModal P P' ⎡|==> Q⎤.
+Proof. by rewrite /AddModal !embed_bupd. Qed.
+
+Global Instance add_modal_embed_fupd_goal
+    `{!BiFUpd PROP, !BiFUpd PROP', !BiEmbedFUpd PROP PROP'}
+    E1 E2 (P P' : PROP') (Q : PROP) :
+  AddModal P P' (|={E1,E2}=> ⎡Q⎤)%I → AddModal P P' ⎡|={E1,E2}=> Q⎤.
+Proof. by rewrite /AddModal !embed_fupd. Qed.
+
+Global Instance into_embed_embed P : IntoEmbed ⎡P⎤ P.
+Proof. by rewrite /IntoEmbed. Qed.
+Global Instance into_embed_affinely
+    `{!BiBUpd PROP, !BiBUpd PROP', !BiEmbedBUpd PROP PROP'} (P : PROP') (Q : PROP) :
+  IntoEmbed P Q → IntoEmbed (<affine> P) (<affine> Q).
+Proof. rewrite /IntoEmbed=> ->. by rewrite embed_affinely_2. Qed.
+
+Global Instance into_later_embed `{!BiEmbedLater PROP PROP'} n P Q :
+  IntoLaterN false n P Q → IntoLaterN false n ⎡P⎤ ⎡Q⎤.
+Proof. rewrite /IntoLaterN /MaybeIntoLaterN=> ->. by rewrite embed_laterN. Qed.
+End class_instances_embedding.

iris/proofmode/class_instances_frame.v

+From iris.bi Require Import telescopes.
+From iris.proofmode Require Import classes classes_make.
+From iris.prelude Require Import options.
+Import bi.
+
+(** This file defines the instances that make up the framing machinery. *)
+
+Section class_instances_frame.
+Context {PROP : bi}.
+Implicit Types P Q R : PROP.
+
+(** When framing [R] against itself, we leave [True] if possible (via
+[frame_here_absorbing] or [frame_affinely_here_absorbing]) since it is a weaker
+goal. Otherwise we leave [emp] via [frame_here].
+Only if all those options fail, we start decomposing [R], via instances like
+[frame_exist]. To ensure that, all other instances must have cost > 1. *)
+Global Instance frame_here_absorbing p R :
+  QuickAbsorbing R → Frame p R R True | 0.
+Proof.
+  rewrite /QuickAbsorbing /Frame. intros.
+  by rewrite intuitionistically_if_elim sep_elim_l.
+Qed.
+Global Instance frame_here p R : Frame p R R emp | 1.
+Proof. intros. by rewrite /Frame intuitionistically_if_elim sep_elim_l. Qed.
+Global Instance frame_affinely_here_absorbing p R :
+  QuickAbsorbing R → Frame p (<affine> R) R True | 0.
+Proof.
+  rewrite /QuickAbsorbing /Frame. intros.
+  rewrite intuitionistically_if_elim affinely_elim. apply sep_elim_l, _.
+Qed.
+Global Instance frame_affinely_here p R : Frame p (<affine> R) R emp | 1.
+Proof.
+  intros. rewrite /Frame intuitionistically_if_elim affinely_elim.
+  apply sep_elim_l, _.
+Qed.
+
+Global Instance frame_here_pure_persistent a φ Q :
+  FromPure a Q φ → Frame true ⌜φ⌝ Q emp | 2.
+Proof.
+  rewrite /FromPure /Frame /= => <-. rewrite right_id.
+  by rewrite -affinely_affinely_if intuitionistically_affinely.
+Qed.
+Global Instance frame_here_pure a φ Q :
+  FromPure a Q φ →
+  TCOr (TCEq a false) (BiAffine PROP) →
+  Frame false ⌜φ⌝ Q emp | 2. (* Same cost as default. *)
+Proof.
+  rewrite /FromPure /Frame => <- [->|?] /=.
+  - by rewrite right_id.
+  - by rewrite right_id -affinely_affinely_if affine_affinely.
+Qed.
+
+Global Instance frame_embed `{!BiEmbed PROP PROP'} p P Q (Q' : PROP') R :
+  Frame p R P Q → MakeEmbed Q Q' →
+  Frame p ⎡R⎤ ⎡P⎤ Q' | 2. (* Same cost as default. *)
+Proof.
+  rewrite /Frame /MakeEmbed => <- <-.
+  rewrite embed_sep embed_intuitionistically_if_2 => //.
+Qed.
+Global Instance frame_pure_embed `{!BiEmbed PROP PROP'} p P Q (Q' : PROP') φ :
+  Frame p ⌜φ⌝ P Q → MakeEmbed Q Q' →
+  Frame p ⌜φ⌝ ⎡P⎤ Q' | 2. (* Same cost as default. *)
+Proof. rewrite /Frame /MakeEmbed -embed_pure. apply (frame_embed p P Q). Qed.
+
+Global Instance frame_sep_persistent_l progress R P1 P2 Q1 Q2 Q' :
+  Frame true R P1 Q1 →
+  MaybeFrame true R P2 Q2 progress →
+  MakeSep Q1 Q2 Q' →
+  Frame true R (P1 ∗ P2) Q' | 9.
+Proof.
+  rewrite /Frame /MaybeFrame' /MakeSep /= => <- [<-] <-.
+  rewrite {1}(intuitionistically_sep_dup R).
+  by rewrite !assoc -(assoc _ _ _ Q1) -(comm _ Q1) assoc -(comm _ Q1).
+Qed.
+Global Instance frame_sep_l R P1 P2 Q Q' :
+  Frame false R P1 Q → MakeSep Q P2 Q' → Frame false R (P1 ∗ P2) Q' | 9.
+Proof. rewrite /Frame /MakeSep => <- <-. by rewrite assoc. Qed.
+Global Instance frame_sep_r p R P1 P2 Q Q' :
+  Frame p R P2 Q → MakeSep P1 Q Q' → Frame p R (P1 ∗ P2) Q' | 10.
+Proof.
+  rewrite /Frame /MakeSep => <- <-. by rewrite assoc -(comm _ P1) assoc.
+Qed.
+
+Global Instance frame_big_sepL_cons {A} p (Φ : nat → A → PROP) R Q l x l' :
+  IsCons l x l' →
+  Frame p R (Φ 0 x ∗ [∗ list] k ↦ y ∈ l', Φ (S k) y) Q →
+  Frame p R ([∗ list] k ↦ y ∈ l, Φ k y) Q | 2. (* Same cost as default. *)
+Proof. rewrite /IsCons=>->. by rewrite /Frame big_sepL_cons. Qed.
+Global Instance frame_big_sepL_app {A} p (Φ : nat → A → PROP) R Q l l1 l2 :
+  IsApp l l1 l2 →
+  Frame p R (([∗ list] k ↦ y ∈ l1, Φ k y) ∗
+           [∗ list] k ↦ y ∈ l2, Φ (length l1 + k) y) Q →
+  Frame p R ([∗ list] k ↦ y ∈ l, Φ k y) Q | 2. (* Same cost as default. *)
+Proof. rewrite /IsApp=>->. by rewrite /Frame big_sepL_app. Qed.
+
+Global Instance frame_big_sepL2_cons {A B} p (Φ : nat → A → B → PROP)
+    R Q l1 x1 l1' l2 x2 l2' :
+  IsCons l1 x1 l1' → IsCons l2 x2 l2' →
+  Frame p R (Φ 0 x1 x2 ∗ [∗ list] k ↦ y1;y2 ∈ l1';l2', Φ (S k) y1 y2) Q →
+  Frame p R ([∗ list] k ↦ y1;y2 ∈ l1;l2, Φ k y1 y2) Q. (* Default cost > 1. *)
+Proof. rewrite /IsCons=>-> ->. by rewrite /Frame big_sepL2_cons. Qed.
+Global Instance frame_big_sepL2_app {A B} p (Φ : nat → A → B → PROP)
+    R Q l1 l1' l1'' l2 l2' l2'' :
+  IsApp l1 l1' l1'' → IsApp l2 l2' l2'' →
+  Frame p R (([∗ list] k ↦ y1;y2 ∈ l1';l2', Φ k y1 y2) ∗
+           [∗ list] k ↦ y1;y2 ∈ l1'';l2'', Φ (length l1' + k) y1 y2) Q →
+  Frame p R ([∗ list] k ↦ y1;y2 ∈ l1;l2, Φ k y1 y2) Q.
+Proof. rewrite /IsApp /Frame=>-> -> ->. apply wand_elim_l', big_sepL2_app. Qed.
+
+Global Instance frame_big_sepMS_disj_union `{Countable A} p (Φ : A → PROP) R Q X X1 X2 :
+  IsDisjUnion X X1 X2 ->
+  Frame p R (([∗ mset] y ∈ X1, Φ y) ∗ [∗ mset] y ∈ X2, Φ y) Q →
+  Frame p R ([∗ mset] y ∈ X, Φ y) Q | 2.
+Proof. rewrite /IsDisjUnion=>->. by rewrite /Frame big_sepMS_disj_union. Qed.
+
+(** The instances that allow framing under [∨] and [∧] need to be carefully
+constructed. Such instances should make progress on at least one, but
+possibly _both_ sides of the connective---unlike [∗], where we want to make
+progress on exactly one side.
+
+Naive implementations of this idea can cause Coq to do multiple searches
+for [Frame] instances of the subterms. For terms with nested [∧]s or [∨]s,
+this can cause an exponential blowup in the time it takes for Coq to
+_fail_ to construct a [Frame] instance. This happens especially when the
+resource we are framing in contains evars, since Coq's typeclass search
+does more backtracking in this case.
+
+To combat this, the [∧] and [∨] instances use [MaybeFrame] classes---
+a notation for [MaybeFrame'] guarded by a [TCNoBackTrack]. The [MaybeFrame]
+clauses for the subterms output a boolean [progress] indicator, on which some
+condition is posed. The [TCNoBackTrack] ensures that when this condition is not
+met, Coq will not backtrack on the [MaybeFrame] clauses to consider different
+[progress]es. *)
+
+(* For framing below [∧], we can frame [R] away in *both* conjuncts
+(unlike with [∗] where we can only frame it in one conjunct).
+We require at least one of those to make progress though. *)
+Global Instance frame_and p progress1 progress2 R P1 P2 Q1 Q2 Q' :
+  MaybeFrame p R P1 Q1 progress1 →
+  MaybeFrame p R P2 Q2 progress2 →
+  (** If below [TCEq] fails, the [frame_and] instance is immediately abandoned:
+    the [TCNoBackTrack]s above prevent Coq from considering other ways to
+    construct [MaybeFrame] instances. *)
+  TCEq (progress1 || progress2) true →
+  MakeAnd Q1 Q2 Q' →
+  Frame p R (P1 ∧ P2) Q' | 9.
+Proof.
+  rewrite /MaybeFrame' /Frame /MakeAnd => [[<-]] [<-] _ <-.
+  apply and_intro; [rewrite and_elim_l|rewrite and_elim_r]; done.
+Qed.
+
+(** We could in principle write the instance [frame_or_spatial] by a bunch of
+instances (omitting the parameter [p = false]):
+
+  Frame R P1 Q1 → Frame R P2 Q2 → Frame R (P1 ∨ P2) (Q1 ∨ Q2)
+  Frame R P1 True → Frame R (P1 ∨ P2) P2
+  Frame R P2 True → Frame R (P1 ∨ P2) P1
+
+The problem here is that Coq will try to infer [Frame R P1 ?] and [Frame R P2 ?]
+multiple times, whereas the current solution makes sure that said inference
+appears at most once.
+
+If Coq would memorize the results of type class resolution, the solution with
+multiple instances would be preferred (and more Prolog-like). *)
+
+(** Framing a spatial resource [R] under [∨] is done only when:
+  - [R] can be framed on both sides of the [∨]; or
+  - [R] completely solves one side of the [∨], reducing it to [True].
+This instance does _not_ framing spatial resources when they can be framed in
+exactly one side, since that can make your goal unprovable. *)
+Global Instance frame_or_spatial progress1 progress2 R P1 P2 Q1 Q2 Q :
+  MaybeFrame false R P1 Q1 progress1 →
+  MaybeFrame false R P2 Q2 progress2 →
+  (** Below [TCOr] encodes the condition described above. If this condition
+    cannot be satisfied, the [frame_or_spatial] instance is immediately
+    abandoned: the [TCNoBackTrack]s present in the [MaybeFrame] notation
+    prevent Coq from considering other ways to construct [MaybeFrame']
+    instances. *)
+  TCOr (TCEq (progress1 && progress2) true) (TCOr
+    (TCAnd (TCEq progress1 true) (TCEq Q1 True%I))
+    (TCAnd (TCEq progress2 true) (TCEq Q2 True%I))) →
+  MakeOr Q1 Q2 Q →
+  Frame false R (P1 ∨ P2) Q | 9.
+Proof. rewrite /Frame /MakeOr => [[<-]] [<-] _ <-. by rewrite -sep_or_l. Qed.
+
+(** Framing a persistent resource [R] under [∨] is done when [R] can be framed
+on _at least_ one side. This does not affect provability of your goal,
+since you can keep the resource after framing. *)
+Global Instance frame_or_persistent progress1 progress2 R P1 P2 Q1 Q2 Q :
+  MaybeFrame true R P1 Q1 progress1 →
+  MaybeFrame true R P2 Q2 progress2 →
+  (** If below [TCEq] fails, the [frame_or_persistent] instance is immediately
+    abandoned: the [TCNoBackTrack]s present in the [MaybeFrame] notation
+    prevent Coq from considering other ways to construct [MaybeFrame']
+    instances. *)
+  TCEq (progress1 || progress2) true →
+  MakeOr Q1 Q2 Q → Frame true R (P1 ∨ P2) Q | 9.
+Proof. rewrite /Frame /MakeOr => [[<-]] [<-] _ <-. by rewrite -sep_or_l. Qed.
+
+Global Instance frame_wand p R P1 P2 Q2 :
+  (FrameInstantiateExistDisabled → Frame p R P2 Q2) →
+  Frame p R (P1 -∗ P2) (P1 -∗ Q2) | 2.
+Proof.
+  rewrite /Frame=> /(_ ltac:(constructor)) ?. apply wand_intro_l.
+  by rewrite assoc (comm _ P1) -assoc wand_elim_r.
+Qed.
+
+Global Instance frame_affinely p R P Q Q' :
+  TCOr (TCEq p true) (QuickAffine R) →
+  Frame p R P Q → MakeAffinely Q Q' →
+  Frame p R (<affine> P) Q'. (* Default cost > 1 *)
+Proof.
+  rewrite /QuickAffine /Frame /MakeAffinely=> -[->|?] <- <- /=;
+    by rewrite -{1}(affine_affinely (_ R)) affinely_sep_2.
+Qed.
+
+Global Instance frame_intuitionistically R P Q Q' :
+  Frame true R P Q → MakeIntuitionistically Q Q' →
+  Frame true R (□ P) Q' | 2. (* Same cost as default. *)
+Proof.
+  rewrite /Frame /MakeIntuitionistically=> <- <- /=.
+  rewrite -intuitionistically_sep_2 intuitionistically_idemp //.
+Qed.
+
+Global Instance frame_absorbingly p R P Q Q' :
+  Frame p R P Q → MakeAbsorbingly Q Q' →
+  Frame p R (<absorb> P) Q' | 2. (* Same cost as default. *)
+Proof.
+  rewrite /Frame /MakeAbsorbingly=> <- <- /=. by rewrite absorbingly_sep_r.
+Qed.
+
+Global Instance frame_persistently R P Q Q' :
+  Frame true R P Q → MakePersistently Q Q' →
+  Frame true R (<pers> P) Q' | 2. (* Same cost as default. *)
+Proof.
+  rewrite /Frame /MakePersistently=> <- <- /=.
+  rewrite -persistently_and_intuitionistically_sep_l.
+  by rewrite -persistently_sep_2 -persistently_and_sep_l_1
+    persistently_affinely_elim persistently_idemp.
+Qed.
+
+(** We construct an instance for [Frame]ing under existentials that can both
+instantiate the existential and leave it untouched:
+
+- If we have [H : P a] and goal [∃ b, P b ∗ Q b], framing [H] turns the goal
+  into [Q a], i.e., instantiates the existential.
+- If we have [H : P] and goal [∃ b, P ∗ Q b], framing [H] turns the goal
+  into [∃ b, Q b], i.e., leaves the existential untouched.
+
+Below we describe the instances. More information can be found in the paper
+https://doi.org/10.1145/3636501.3636950 The general lemma is: *)
+Local Lemma frame_exist_helper {A} p R (Φ : A → PROP)
+    {C} (g : C → A) (Ψ : C → PROP) :
+  (∀ c, Frame p R (Φ $ g c) (Ψ c)) →
+  Frame p R (∃ a, Φ a) (∃ c, Ψ c).
+Proof.
+  rewrite /Frame=> HΨ. rewrite sep_exist_l.
+  apply bi.exist_elim=> c. rewrite HΨ. apply exist_intro.
+Qed.
+(** [frame_exist_helper] captures the two common usecases:
+- To instantiate the existential with witness [a], take [C = unit] and
+  use [g = λ _, a].
+- To keep the existential quantification untouched, take [C = A] and [g = id]
+Note that having separate instances for these two cases is a bad idea:
+typeclass search for [n] existential quantifiers would have [2^n] possibilities!
+
+We cannot use [frame_exist] directly in type class search. One reason
+is that we do not want to present the user with a useless existential
+quantification on [unit]. This means we want to replace [∃ c, Φ c] with
+the telescopic quantification [∃.. c, Φ c].
+Another reason is that [frame_exist] does not indicate how [C] and [g] should
+be inferred, so type class search would simply fail.
+
+We want to infer these as follows. On a goal [Frame p R (∃ a, Φ a) _]:
+- We first run type class search on [Frame p R (Φ ?a) _].
+  If an instance is found, [?a] is a term that might still contain evars.
+  The idea is to turn these evars back into existential quantifiers,
+  whenever that is possible.
+- To do so, choose [C] to be the telescope with types for each of the evars
+  in [?a].
+- This means [c : C] is (morally) a tuple with an element for each of the
+  evars in [?a]---so we can unify all evars to be a projection of [c].
+- After this unification, [?a] is an explicit function of [c], which means
+  we have found [g].
+*)
+
+(** To perform above inference, we introduce a separate equality type class. *)
+Inductive GatherEvarsEq {A} (x : A) : A → Prop := 
+  GatherEvarsEq_refl : GatherEvarsEq x x.
+Existing Class GatherEvarsEq.
+(** The goal [GatherEvarsEq a (?g c)] with [a : A] and [g : ?C → A] is solved
+in the way described above. This is done by tactic [solve_gather_evars_eq],
+given at the end of this section, with an accompanying [Hint Extern]. *)
+
+(** We are now able to state a lemma for building [Frame] instances directly:
+
+[Lemma frame_exist_slow {A} p R (Φ : A → PROP)
+    (TT : tele) (g : TT → A) (Ψ : TT → PROP) :
+  (∀ c, ∃ a' G,
+    Frame p R (Φ a') G ∧
+    GatherEvarsEq a' (g c) ∧
+    TCEq G (Ψ c)) →
+  Frame p R (∃ a, Φ a) (∃.. c, Ψ c)%I.]
+
+Although this would function as intended, the two inner [ex] and [conj]s
+repeat terms in the implicit arguments; in particular, they repeat the
+quantified goal [Φ] a bunch of times. This means the term size can get quite
+big, and make type checking slower than need. We therefore make an effort to
+reduce term size and type-checking time by creating a tailored [Class], which
+furthermore can be solved automatically by type class search. *)
+#[projections(primitive)] Class FrameExistRequirements
+    (p : bool) (R : PROP) {A} (Φ : A → PROP) (a' : A) (G' : PROP) := {
+  frame_exist_witness : A;
+  frame_exist_resource : PROP;
+  frame_exist_proof : Frame p R (Φ frame_exist_witness) frame_exist_resource;
+  frame_exist_witness_eq : GatherEvarsEq frame_exist_witness a';
+  frame_exist_resource_eq : TCEq frame_exist_resource G'
+}.
+Global Existing Instance Build_FrameExistRequirements.
+
+(* This class is used so that we can [cbn] away the [bi_texist] in the result
+of framing. This is done by the [Hint Extern] at the bottom of the file. *)
+Inductive TCCbnTele {A} (x : A) : A → Prop :=
+  TCCbnTele_refl : TCCbnTele x x.
+Existing Class TCCbnTele.
+Global Hint Mode TCCbnTele ! - - : typeclass_instances.
+
+(* We include a dependency on [FrameInstantiateExistEnabled] so as to disable
+this instance when framing beneath [∀], [-∗] and [→] *)
+Global Instance frame_exist {A} p R (Φ : A → PROP)
+    (TT : tele) (g : TT → A) (Ψ : TT → PROP) Q :
+  FrameInstantiateExistEnabled →
+  (∀ c, FrameExistRequirements p R Φ (g c) (Ψ c)) →
+  TCCbnTele (∃.. c, Ψ c)%I Q →
+  Frame p R (∃ a, Φ a) Q.
+Proof.
+  move=> _ H <-. rewrite /Frame bi_texist_exist.
+  eapply frame_exist_helper=> c.
+  by specialize (H c) as [a G HG -> ->].
+Qed.
+(* If [FrameInstantiateExistDisabled] holds we are not allowed to instantiate
+existentials, so we just frame below the quantifier without instantiating
+anything. *)
+Global Instance frame_exist_no_instantiate {A} p R (Φ Ψ : A → PROP) :
+  FrameInstantiateExistDisabled →
+  (∀ a, Frame p R (Φ a) (Ψ a)) →
+  Frame p R (∃ a, Φ a) (∃ a, Ψ a).
+Proof. move=> _ H. eapply frame_exist_helper, H. Qed.
+
+Global Instance frame_texist {TT : tele} p R (Φ Ψ : TT → PROP) :
+  (∀ x, Frame p R (Φ x) (Ψ x)) → Frame p R (∃.. x, Φ x) (∃.. x, Ψ x) | 2.
+Proof. rewrite /Frame !bi_texist_exist. apply frame_exist_helper. Qed.
+Global Instance frame_forall {A} p R (Φ Ψ : A → PROP) :
+  (FrameInstantiateExistDisabled → ∀ a, Frame p R (Φ a) (Ψ a)) →
+  Frame p R (∀ x, Φ x) (∀ x, Ψ x) | 2.
+Proof.
+  rewrite /Frame=> /(_ ltac:(constructor)) ?.
+  by rewrite sep_forall_l; apply forall_mono.
+Qed.
+Global Instance frame_tforall {TT : tele} p R (Φ Ψ : TT → PROP) :
+  (FrameInstantiateExistDisabled → (∀ x, Frame p R (Φ x) (Ψ x))) →
+  Frame p R (∀.. x, Φ x) (∀.. x, Ψ x) | 2.
+Proof. rewrite /Frame !bi_tforall_forall. apply frame_forall. Qed.
+
+Global Instance frame_impl_persistent R P1 P2 Q2 :
+  (FrameInstantiateExistDisabled → Frame true R P2 Q2) →
+  Frame true R (P1 → P2) (P1 → Q2) | 2.
+Proof.
+  rewrite /Frame /= => /(_ ltac:(constructor)) ?. apply impl_intro_l.
+  by rewrite -persistently_and_intuitionistically_sep_l assoc (comm _ P1) -assoc impl_elim_r
+             persistently_and_intuitionistically_sep_l.
+Qed.
+(** You may wonder why this uses [Persistent] and not [QuickPersistent].
+The reason is that [QuickPersistent] is not needed anywhere else, and
+even without [QuickPersistent], this instance avoids quadratic complexity:
+we usually use the [Quick*] classes to not traverse the same term over and over
+again, but here [P1] is encountered at most once. It is hence not worth adding
+a new typeclass just for this extremely rarely used instance. *)
+Global Instance frame_impl R P1 P2 Q2 :
+  Persistent P1 → QuickAbsorbing P1 →
+  (FrameInstantiateExistDisabled → Frame false R P2 Q2) →
+  Frame false R (P1 → P2) (P1 → Q2). (* Default cost > 1 *)
+Proof.
+  rewrite /Frame /QuickAbsorbing /==> ?? /(_ ltac:(constructor)) ?.
+  apply impl_intro_l.
+  rewrite {1}(persistent P1) persistently_and_intuitionistically_sep_l assoc.
+  rewrite (comm _ (□ P1)%I) -assoc -persistently_and_intuitionistically_sep_l.
+  rewrite persistently_elim impl_elim_r //.
+Qed.
+
+Global Instance frame_eq_embed `{!BiEmbed PROP PROP', !BiInternalEq PROP,
+    !BiInternalEq PROP', !BiEmbedInternalEq PROP PROP'}
+    p P Q (Q' : PROP') {A : ofe} (a b : A) :
+  Frame p (a ≡ b) P Q → MakeEmbed Q Q' →
+  Frame p (a ≡ b) ⎡P⎤ Q'. (* Default cost > 1 *)
+Proof. rewrite /Frame /MakeEmbed -embed_internal_eq. apply (frame_embed p P Q). Qed.
+
+Global Instance frame_later p R R' P Q Q' :
+  TCNoBackTrack (MaybeIntoLaterN true 1 R' R) →
+  Frame p R P Q → MakeLaterN 1 Q Q' →
+  Frame p R' (▷ P) Q'. (* Default cost > 1 *)
+Proof.
+  rewrite /Frame /MakeLaterN /MaybeIntoLaterN=>-[->] <- <-.
+  by rewrite later_intuitionistically_if_2 later_sep.
+Qed.
+Global Instance frame_laterN p n R R' P Q Q' :
+  TCNoBackTrack (MaybeIntoLaterN true n R' R) →
+  Frame p R P Q → MakeLaterN n Q Q' →
+  Frame p R' (▷^n P) Q'. (* Default cost > 1 *)
+Proof.
+  rewrite /Frame /MakeLaterN /MaybeIntoLaterN=>-[->] <- <-.
+  by rewrite laterN_intuitionistically_if_2 laterN_sep.
+Qed.
+
+Global Instance frame_bupd `{!BiBUpd PROP} p R P Q :
+  Frame p R P Q → Frame p R (|==> P) (|==> Q) | 2.
+Proof. rewrite /Frame=><-. by rewrite bupd_frame_l. Qed.
+Global Instance frame_fupd `{!BiFUpd PROP} p E1 E2 R P Q :
+  Frame p R P Q → Frame p R (|={E1,E2}=> P) (|={E1,E2}=> Q) | 2.
+Proof. rewrite /Frame=><-. by rewrite fupd_frame_l. Qed.
+
+Global Instance frame_except_0 p R P Q Q' :
+  Frame p R P Q → MakeExcept0 Q Q' →
+  Frame p R (◇ P) Q' | 2. (* Same cost as default *)
+Proof.
+  rewrite /Frame /MakeExcept0=><- <-.
+  by rewrite except_0_sep -(except_0_intro (□?p R)).
+Qed.
+End class_instances_frame.
+
+(** We now write the tactic for constructing [GatherEvarsEq] instances.
+We want to prove goals of shape [GatherEvarsEq a (?g c)] with [a : A],
+and [g : ?C → A]. We need to infer both the function [g] and [C : tele].*)
+Ltac solve_gather_evars_eq :=
+  lazymatch goal with
+  | |- GatherEvarsEq ?a (?g ?c) =>
+    let rec retcon_tele T arg :=
+      (* [retcon_tele] takes two arguments:
+      - [T], an evar that has type [tele]
+      - [arg], a term that has type [tele_arg T]
+        (recall that [tele_arg] is the [tele → Type] coercion)
+      [retcon_tele] will find all the evars occurring in [a], and unify [T]
+      to be the telescope with types for all these evars. These evars will be
+      unified with projections of [arg].
+      In effect, it ensures 'retro-active continuity', namely that the
+      telescope [T] was appropriately chosen all along. *)
+      match a with
+      | context [?term] =>
+        is_evar term;
+        let X := type of term in
+        lazymatch X with
+        | tele => fail (* Shortcircuit, since nesting telescopes is a bad idea *)
+        | _ => idtac
+        end;
+        let T' := open_constr:(_) in (* creates a new evar *)
+        unify T (TeleS (λ _ : X, T')); 
+        (* The evar telescope [T'] is used for any remaining evars *)
+        unify term (tele_arg_head (λ _ : X, T') arg);
+        (* [tele_arg_head] is the first projection of [arg] *)
+        retcon_tele T' (tele_arg_tail (λ _ : X, T') arg)
+        (* recurse with the tail projection of [arg] *)
+      | _ => 
+        (* no more evars: unify [T] with the empty telescope *)
+        unify T TeleO
+      end
+    in
+    let T' := lazymatch (type of c) with tele_arg ?T => T end in
+    retcon_tele T' c;
+    exact (GatherEvarsEq_refl _)
+  end.
+
+Global Hint Extern 0 (GatherEvarsEq _ _) =>
+  solve_gather_evars_eq : typeclass_instances.
+
+Global Hint Extern 0 (TCCbnTele _ _) =>
+  cbn [bi_texist tele_fold tele_bind tele_arg_head tele_arg_tail];
+  exact (TCCbnTele_refl _) : typeclass_instances.

iris/proofmode/class_instances_internal_eq.v

+From stdpp Require Import nat_cancel.
+From iris.proofmode Require Import modality_instances classes.
+From iris.prelude Require Import options.
+Import bi.
+
+Section class_instances_internal_eq.
+Context `{!BiInternalEq PROP}.
+Implicit Types P Q R : PROP.
+
+(* When a user calls [iPureIntro] on [⊢ a ≡ b], the following instance turns
+  turns this into the pure goal [a ≡ b : Prop].
+  If [a, b : A] with [LeibnizEquiv A], another candidate would be [a = b]. While
+  this does not lead to information loss, [=] is harder to prove than [≡]. We thus
+  leave such simplifications to the user (e.g. they can call [fold_leibniz]). *)
+Global Instance from_pure_internal_eq {A : ofe} (a b : A) :
+  @FromPure PROP false (a ≡ b) (a ≡ b).
+Proof. by rewrite /FromPure pure_internal_eq. Qed.
+
+(* On the other hand, when a user calls [iIntros "%H"] on [⊢ (a ≡ b) -∗ P],
+  it is most convenient if [H] is as strong as possible---meaning, the user would
+  rather get [H : a = b] than [H : a ≡ b]. This is only possible if the
+  equivalence on [A] implies Leibniz equality (i.e., we have [LeibnizEquiv A]).
+  If the equivalence on [A] does not imply Leibniz equality, we cannot simplify
+  [a ≡ b] any further.
+  The following instance implements above logic, while avoiding a double search
+  for [Discrete a]. *)
+Global Instance into_pure_eq {A : ofe} (a b : A) (P : Prop) :
+  Discrete a →
+  TCOr (TCAnd (LeibnizEquiv A) (TCEq P (a = b)))
+       (TCEq P (a ≡ b)) →
+  @IntoPure PROP (a ≡ b) P.
+Proof.
+  move=> ? [[? ->]|->]; rewrite /IntoPure discrete_eq; last done.
+  by rewrite leibniz_equiv_iff.
+Qed.
+
+Global Instance from_modal_Next {A : ofe} (x y : A) :
+  FromModal (PROP1:=PROP) (PROP2:=PROP) True (modality_laterN 1)
+    (▷^1 (x ≡ y) : PROP)%I (Next x ≡ Next y) (x ≡ y).
+Proof. by rewrite /FromModal /= later_equivI. Qed.
+
+Global Instance into_laterN_Next {A : ofe} only_head n n' (x y : A) :
+  NatCancel n 1 n' 0 →
+  IntoLaterN (PROP:=PROP) only_head n (Next x ≡ Next y) (x ≡ y) | 2.
+Proof.
+  rewrite /IntoLaterN /MaybeIntoLaterN /NatCancel Nat.add_0_r.
+  move=> <-. rewrite later_equivI. by rewrite Nat.add_comm /= -laterN_intro.
+Qed.
+
+Global Instance into_internal_eq_internal_eq {A : ofe} (x y : A) :
+  @IntoInternalEq PROP _ A (x ≡ y) x y.
+Proof. by rewrite /IntoInternalEq. Qed.
+Global Instance into_internal_eq_affinely {A : ofe} (x y : A) P :
+  IntoInternalEq P x y → IntoInternalEq (<affine> P) x y.
+Proof. rewrite /IntoInternalEq=> ->. by rewrite affinely_elim. Qed.
+Global Instance into_internal_eq_intuitionistically {A : ofe} (x y : A) P :
+  IntoInternalEq P x y → IntoInternalEq (□ P) x y.
+Proof. rewrite /IntoInternalEq=> ->. by rewrite intuitionistically_elim. Qed.
+Global Instance into_internal_eq_absorbingly {A : ofe} (x y : A) P :
+  IntoInternalEq P x y → IntoInternalEq (<absorb> P) x y.
+Proof. rewrite /IntoInternalEq=> ->. by rewrite absorbingly_internal_eq. Qed.
+Global Instance into_internal_eq_plainly `{!BiPlainly PROP} {A : ofe} (x y : A) P :
+  IntoInternalEq P x y → IntoInternalEq (■ P) x y.
+Proof. rewrite /IntoInternalEq=> ->. by rewrite plainly_elim. Qed.
+Global Instance into_internal_eq_persistently {A : ofe} (x y : A) P :
+  IntoInternalEq P x y → IntoInternalEq (<pers> P) x y.
+Proof. rewrite /IntoInternalEq=> ->. by rewrite persistently_elim. Qed.
+End class_instances_internal_eq.

iris/proofmode/class_instances_later.v

+From stdpp Require Import nat_cancel.
+From iris.proofmode Require Import classes classes_make modality_instances.
+From iris.prelude Require Import options.
+Import bi.
+
+Section class_instances_later.
+Context {PROP : bi}.
+Implicit Types P Q R : PROP.
+
+(** FromAssumption *)
+Global Instance from_assumption_later p P Q :
+  FromAssumption p P Q → KnownRFromAssumption p P (▷ Q).
+Proof. rewrite /KnownRFromAssumption /FromAssumption=>->. apply later_intro. Qed.
+Global Instance from_assumption_laterN n p P Q :
+  FromAssumption p P Q → KnownRFromAssumption p P (▷^n Q).
+Proof. rewrite /KnownRFromAssumption /FromAssumption=>->. apply laterN_intro. Qed.
+Global Instance from_assumption_except_0 p P Q :
+  FromAssumption p P Q → KnownRFromAssumption p P (◇ Q).
+Proof. rewrite /KnownRFromAssumption /FromAssumption=>->. apply except_0_intro. Qed.
+
+(** FromPure *)
+Global Instance from_pure_later a P φ : FromPure a P φ → FromPure a (▷ P) φ.
+Proof. rewrite /FromPure=> ->. apply later_intro. Qed.
+Global Instance from_pure_laterN a n P φ : FromPure a P φ → FromPure a (▷^n P) φ.
+Proof. rewrite /FromPure=> ->. apply laterN_intro. Qed.
+Global Instance from_pure_except_0 a P φ : FromPure a P φ → FromPure a (◇ P) φ.
+Proof. rewrite /FromPure=> ->. apply except_0_intro. Qed.
+
+(** IntoWand *)
+Global Instance into_wand_later p q R P Q :
+  IntoWand p q R P Q → IntoWand p q (▷ R) (▷ P) (▷ Q).
+Proof.
+  rewrite /IntoWand /= => HR.
+  by rewrite !later_intuitionistically_if_2 -later_wand HR.
+Qed.
+Global Instance into_wand_later_args p q R P Q :
+  IntoWand p q R P Q → IntoWand' p q R (▷ P) (▷ Q).
+Proof.
+  rewrite /IntoWand' /IntoWand /= => HR.
+  by rewrite !later_intuitionistically_if_2
+             (later_intro (□?p R)) -later_wand HR.
+Qed.
+Global Instance into_wand_laterN n p q R P Q :
+  IntoWand p q R P Q → IntoWand p q (▷^n R) (▷^n P) (▷^n Q).
+Proof.
+  rewrite /IntoWand /= => HR.
+  by rewrite !laterN_intuitionistically_if_2 -laterN_wand HR.
+Qed.
+Global Instance into_wand_laterN_args n p q R P Q :
+  IntoWand p q R P Q → IntoWand' p q R (▷^n P) (▷^n Q).
+Proof.
+  rewrite /IntoWand' /IntoWand /= => HR.
+  by rewrite !laterN_intuitionistically_if_2
+             (laterN_intro _ (□?p R)) -laterN_wand HR.
+Qed.
+
+(** FromAnd *)
+Global Instance from_and_later P Q1 Q2 :
+  FromAnd P Q1 Q2 → FromAnd (▷ P) (▷ Q1) (▷ Q2).
+Proof. rewrite /FromAnd=> <-. by rewrite later_and. Qed.
+Global Instance from_and_laterN n P Q1 Q2 :
+  FromAnd P Q1 Q2 → FromAnd (▷^n P) (▷^n Q1) (▷^n Q2).
+Proof. rewrite /FromAnd=> <-. by rewrite laterN_and. Qed.
+Global Instance from_and_except_0 P Q1 Q2 :
+  FromAnd P Q1 Q2 → FromAnd (◇ P) (◇ Q1) (◇ Q2).
+Proof. rewrite /FromAnd=><-. by rewrite except_0_and. Qed.
+
+(** FromSep *)
+Global Instance from_sep_later P Q1 Q2 :
+  FromSep P Q1 Q2 → FromSep (▷ P) (▷ Q1) (▷ Q2).
+Proof. rewrite /FromSep=> <-. by rewrite later_sep. Qed.
+Global Instance from_sep_laterN n P Q1 Q2 :
+  FromSep P Q1 Q2 → FromSep (▷^n P) (▷^n Q1) (▷^n Q2).
+Proof. rewrite /FromSep=> <-. by rewrite laterN_sep. Qed.
+Global Instance from_sep_except_0 P Q1 Q2 :
+  FromSep P Q1 Q2 → FromSep (◇ P) (◇ Q1) (◇ Q2).
+Proof. rewrite /FromSep=><-. by rewrite except_0_sep. Qed.
+
+(** MaybeCombineSepAs *)
+Global Instance maybe_combine_sep_as_later Q1 Q2 P progress :
+  MaybeCombineSepAs Q1 Q2 P progress →
+  MaybeCombineSepAs (▷ Q1) (▷ Q2) (▷ P) progress.
+Proof. by rewrite /MaybeCombineSepAs -later_sep => <-. Qed.
+Global Instance maybe_combine_sep_as_laterN n Q1 Q2 P progress :
+  MaybeCombineSepAs Q1 Q2 P progress →
+  MaybeCombineSepAs (▷^n Q1) (▷^n Q2) (▷^n P) progress.
+Proof. by rewrite /MaybeCombineSepAs -laterN_sep => <-. Qed.
+Global Instance maybe_combine_sep_as_except_0 Q1 Q2 P progress :
+  MaybeCombineSepAs Q1 Q2 P progress →
+  MaybeCombineSepAs (◇ Q1) (◇ Q2) (◇ P) progress.
+Proof. by rewrite /MaybeCombineSepAs -except_0_sep => <-. Qed.
+
+(** MaybeCombineSepGives *)
+Global Instance maybe_combine_sep_gives_later Q1 Q2 P :
+  CombineSepGives Q1 Q2 P →
+  CombineSepGives (▷ Q1) (▷ Q2) (▷ P).
+Proof. by rewrite /CombineSepGives -later_sep -later_persistently => ->. Qed.
+Global Instance maybe_combine_sep_gives_laterN n Q1 Q2 P :
+  CombineSepGives Q1 Q2 P →
+  CombineSepGives (▷^n Q1) (▷^n Q2) (▷^n P).
+Proof. by rewrite /CombineSepGives -laterN_sep -laterN_persistently => ->. Qed.
+Global Instance maybe_combine_sep_gives_except_0 Q1 Q2 P :
+  CombineSepGives Q1 Q2 P →
+  CombineSepGives (◇ Q1) (◇ Q2) (◇ P).
+Proof.
+  by rewrite /CombineSepGives -except_0_sep -except_0_persistently => ->.
+Qed.
+
+(** IntoAnd *)
+Global Instance into_and_later p P Q1 Q2 :
+  IntoAnd p P Q1 Q2 → IntoAnd p (▷ P) (▷ Q1) (▷ Q2).
+Proof.
+  rewrite /IntoAnd=> HP. apply intuitionistically_if_intro'.
+  by rewrite later_intuitionistically_if_2 HP
+             intuitionistically_if_elim later_and.
+Qed.
+Global Instance into_and_laterN n p P Q1 Q2 :
+  IntoAnd p P Q1 Q2 → IntoAnd p (▷^n P) (▷^n Q1) (▷^n Q2).
+Proof.
+  rewrite /IntoAnd=> HP. apply intuitionistically_if_intro'.
+  by rewrite laterN_intuitionistically_if_2 HP
+             intuitionistically_if_elim laterN_and.
+Qed.
+Global Instance into_and_except_0 p P Q1 Q2 :
+  IntoAnd p P Q1 Q2 → IntoAnd p (◇ P) (◇ Q1) (◇ Q2).
+Proof.
+  rewrite /IntoAnd=> HP. apply intuitionistically_if_intro'.
+  by rewrite except_0_intuitionistically_if_2 HP
+             intuitionistically_if_elim except_0_and.
+Qed.
+
+(** IntoSep *)
+Global Instance into_sep_later P Q1 Q2 :
+  IntoSep P Q1 Q2 → IntoSep (▷ P) (▷ Q1) (▷ Q2).
+Proof. rewrite /IntoSep=> ->. by rewrite later_sep. Qed.
+Global Instance into_sep_laterN n P Q1 Q2 :
+  IntoSep P Q1 Q2 → IntoSep (▷^n P) (▷^n Q1) (▷^n Q2).
+Proof. rewrite /IntoSep=> ->. by rewrite laterN_sep. Qed.
+Global Instance into_sep_except_0 P Q1 Q2 :
+  IntoSep P Q1 Q2 → IntoSep (◇ P) (◇ Q1) (◇ Q2).
+Proof. rewrite /IntoSep=> ->. by rewrite except_0_sep. Qed.
+
+(* FIXME: This instance is overly specific, generalize it. *)
+Global Instance into_sep_affinely_later `{!Timeless (PROP:=PROP) emp} P Q1 Q2 :
+  IntoSep P Q1 Q2 → Affine Q1 → Affine Q2 →
+  IntoSep (<affine> ▷ P) (<affine> ▷ Q1) (<affine> ▷ Q2).
+Proof.
+  rewrite /IntoSep /= => -> ??.
+  rewrite -{1}(affine_affinely Q1) -{1}(affine_affinely Q2) later_sep !later_affinely_1.
+  rewrite -except_0_sep /bi_except_0 affinely_or. apply or_elim, affinely_elim.
+  rewrite -(idemp bi_and (<affine> ▷ False)%I) persistent_and_sep_1.
+  by rewrite -(False_elim Q1) -(False_elim Q2).
+Qed.
+
+(** FromOr *)
+Global Instance from_or_later P Q1 Q2 :
+  FromOr P Q1 Q2 → FromOr (▷ P) (▷ Q1) (▷ Q2).
+Proof. rewrite /FromOr=><-. by rewrite later_or. Qed.
+Global Instance from_or_laterN n P Q1 Q2 :
+  FromOr P Q1 Q2 → FromOr (▷^n P) (▷^n Q1) (▷^n Q2).
+Proof. rewrite /FromOr=><-. by rewrite laterN_or. Qed.
+Global Instance from_or_except_0 P Q1 Q2 :
+  FromOr P Q1 Q2 → FromOr (◇ P) (◇ Q1) (◇ Q2).
+Proof. rewrite /FromOr=><-. by rewrite except_0_or. Qed.
+
+(** IntoOr *)
+Global Instance into_or_later P Q1 Q2 :
+  IntoOr P Q1 Q2 → IntoOr (▷ P) (▷ Q1) (▷ Q2).
+Proof. rewrite /IntoOr=>->. by rewrite later_or. Qed.
+Global Instance into_or_laterN n P Q1 Q2 :
+  IntoOr P Q1 Q2 → IntoOr (▷^n P) (▷^n Q1) (▷^n Q2).
+Proof. rewrite /IntoOr=>->. by rewrite laterN_or. Qed.
+Global Instance into_or_except_0 P Q1 Q2 :
+  IntoOr P Q1 Q2 → IntoOr (◇ P) (◇ Q1) (◇ Q2).
+Proof. rewrite /IntoOr=>->. by rewrite except_0_or. Qed.
+
+(** FromExist *)
+Global Instance from_exist_later {A} P (Φ : A → PROP) :
+  FromExist P Φ → FromExist (▷ P) (λ a, ▷ (Φ a))%I.
+Proof.
+  rewrite /FromExist=> <-. apply exist_elim=>x. apply later_mono, exist_intro.
+Qed.
+Global Instance from_exist_laterN {A} n P (Φ : A → PROP) :
+  FromExist P Φ → FromExist (▷^n P) (λ a, ▷^n (Φ a))%I.
+Proof.
+  rewrite /FromExist=> <-. apply exist_elim=>x. apply laterN_mono, exist_intro.
+Qed.
+Global Instance from_exist_except_0 {A} P (Φ : A → PROP) :
+  FromExist P Φ → FromExist (◇ P) (λ a, ◇ (Φ a))%I.
+Proof. rewrite /FromExist=> <-. by rewrite except_0_exist_2. Qed.
+
+(** IntoExist *)
+Global Instance into_exist_later {A} P (Φ : A → PROP) name :
+  IntoExist P Φ name → Inhabited A → IntoExist (▷ P) (λ a, ▷ (Φ a))%I name.
+Proof. rewrite /IntoExist=> HP ?. by rewrite HP later_exist. Qed.
+Global Instance into_exist_laterN {A} n P (Φ : A → PROP) name :
+  IntoExist P Φ name → Inhabited A → IntoExist (▷^n P) (λ a, ▷^n (Φ a))%I name.
+Proof. rewrite /IntoExist=> HP ?. by rewrite HP laterN_exist. Qed.
+Global Instance into_exist_except_0 {A} P (Φ : A → PROP) name :
+  IntoExist P Φ name → Inhabited A → IntoExist (◇ P) (λ a, ◇ (Φ a))%I name.
+Proof. rewrite /IntoExist=> HP ?. by rewrite HP except_0_exist. Qed.
+
+(** IntoForall *)
+Global Instance into_forall_later {A} P (Φ : A → PROP) :
+  IntoForall P Φ → IntoForall (▷ P) (λ a, ▷ (Φ a))%I.
+Proof. rewrite /IntoForall=> HP. by rewrite HP later_forall. Qed.
+
+Global Instance into_forall_laterN {A} P (Φ : A → PROP) n :
+  IntoForall P Φ → IntoForall (▷^n P) (λ a, ▷^n (Φ a))%I.
+Proof. rewrite /IntoForall=> HP. by rewrite HP laterN_forall. Qed.
+
+Global Instance into_forall_except_0 {A} P (Φ : A → PROP) :
+  IntoForall P Φ → IntoForall (◇ P) (λ a, ◇ (Φ a))%I.
+Proof. rewrite /IntoForall=> HP. by rewrite HP except_0_forall. Qed.
+
+(** FromForall *)
+Global Instance from_forall_later {A} P (Φ : A → PROP) name :
+  FromForall P Φ name → FromForall (▷ P) (λ a, ▷ (Φ a))%I name.
+Proof. rewrite /FromForall=> <-. by rewrite later_forall. Qed.
+
+Global Instance from_forall_laterN {A} P (Φ : A → PROP) n name :
+  FromForall P Φ name → FromForall (▷^n P) (λ a, ▷^n (Φ a))%I name.
+Proof. rewrite /FromForall => <-. by rewrite laterN_forall. Qed.
+
+Global Instance from_forall_except_0 {A} P (Φ : A → PROP) name :
+  FromForall P Φ name → FromForall (◇ P) (λ a, ◇ (Φ a))%I name.
+Proof. rewrite /FromForall=> <-. by rewrite except_0_forall. Qed.
+
+(** IsExcept0 *)
+Global Instance is_except_0_except_0 P : IsExcept0 (◇ P).
+Proof. by rewrite /IsExcept0 except_0_idemp. Qed.
+Global Instance is_except_0_later P : IsExcept0 (▷ P).
+Proof. by rewrite /IsExcept0 except_0_later. Qed.
+
+(** FromModal *)
+Global Instance from_modal_later P :
+  FromModal True (modality_laterN 1) (▷^1 P) (▷ P) P.
+Proof. by rewrite /FromModal. Qed.
+Global Instance from_modal_laterN n P :
+  FromModal True (modality_laterN n) (▷^n P) (▷^n P) P.
+Proof. by rewrite /FromModal. Qed.
+Global Instance from_modal_except_0 P :
+  FromModal True modality_id (◇ P) (◇ P) P.
+Proof. by rewrite /FromModal /= -except_0_intro. Qed.
+
+(** IntoExcept0 *)
+Global Instance into_except_0_except_0 P : IntoExcept0 (◇ P) P.
+Proof. by rewrite /IntoExcept0. Qed.
+Global Instance into_except_0_later P : Timeless P → IntoExcept0 (▷ P) P.
+Proof. by rewrite /IntoExcept0. Qed.
+Global Instance into_except_0_later_if p P : Timeless P → IntoExcept0 (▷?p P) P.
+Proof. rewrite /IntoExcept0. destruct p; auto using except_0_intro. Qed.
+
+Global Instance into_except_0_affinely P Q :
+  IntoExcept0 P Q → IntoExcept0 (<affine> P) (<affine> Q).
+Proof. rewrite /IntoExcept0=> ->. by rewrite except_0_affinely_2. Qed.
+Global Instance into_except_0_intuitionistically P Q :
+  IntoExcept0 P Q → IntoExcept0 (□ P) (□ Q).
+Proof. rewrite /IntoExcept0=> ->. by rewrite except_0_intuitionistically_2. Qed.
+Global Instance into_except_0_absorbingly P Q :
+  IntoExcept0 P Q → IntoExcept0 (<absorb> P) (<absorb> Q).
+Proof. rewrite /IntoExcept0=> ->. by rewrite except_0_absorbingly. Qed.
+Global Instance into_except_0_persistently P Q :
+  IntoExcept0 P Q → IntoExcept0 (<pers> P) (<pers> Q).
+Proof. rewrite /IntoExcept0=> ->. by rewrite except_0_persistently. Qed.
+
+(** ElimModal *)
+Global Instance elim_modal_timeless p P P' Q :
+  IntoExcept0 P P' → IsExcept0 Q → ElimModal True p p P P' Q Q.
+Proof.
+  intros. rewrite /ElimModal (except_0_intro (_ -∗ _)) (into_except_0 P).
+  by rewrite except_0_intuitionistically_if_2 -except_0_sep wand_elim_r.
+Qed.
+
+(** AddModal *)
+(* Low cost to add a [▷] rather than a [◇] when [P] is timeless. *)
+Global Instance add_modal_later_except_0 P Q :
+  Timeless P → AddModal (▷ P) P (◇ Q) | 0.
+Proof.
+  intros. rewrite /AddModal (except_0_intro (_ -∗ _)) (timeless P).
+  by rewrite -except_0_sep wand_elim_r except_0_idemp.
+Qed.
+Global Instance add_modal_later P Q :
+  Timeless P → AddModal (▷ P) P (▷ Q) | 0.
+Proof.
+  intros. rewrite /AddModal (except_0_intro (_ -∗ _)) (timeless P).
+  by rewrite -except_0_sep wand_elim_r except_0_later.
+Qed.
+Global Instance add_modal_except_0 P Q : AddModal (◇ P) P (◇ Q) | 1.
+Proof.
+  intros. rewrite /AddModal (except_0_intro (_ -∗ _)).
+  by rewrite -except_0_sep wand_elim_r except_0_idemp.
+Qed.
+Global Instance add_modal_except_0_later P Q : AddModal (◇ P) P (▷ Q) | 1.
+Proof.
+  intros. rewrite /AddModal (except_0_intro (_ -∗ _)).
+  by rewrite -except_0_sep wand_elim_r except_0_later.
+Qed.
+
+(** IntoAcc *)
+(* TODO: We could have instances from "unfolded" accessors with or without
+   the first binder. *)
+
+(** IntoLater *)
+Global Instance into_laterN_0 only_head P : IntoLaterN only_head 0 P P.
+Proof. by rewrite /IntoLaterN /MaybeIntoLaterN. Qed.
+Global Instance into_laterN_later only_head n n' m' P Q lQ :
+  NatCancel n 1 n' m' →
+  (** If canceling has failed (i.e. [1 = m']), we should make progress deeper
+  into [P], as such, we continue with the [IntoLaterN] class, which is required
+  to make progress. If canceling has succeeded, we do not need to make further
+  progress, but there may still be a left-over (i.e. [n']) to cancel more deeply
+  into [P], as such, we continue with [MaybeIntoLaterN]. *)
+  TCIf (TCEq 1 m') (IntoLaterN only_head n' P Q) (MaybeIntoLaterN only_head n' P Q) →
+  (* Similar to [iFrame], the [iNext] tactic also performs a traversal through a
+  term (a hypothesis) to find laters to strip. And like [iFrame] we don't want
+  this to be excessively smart. So we use the same typeclass as [iFrame] here.
+  *)
+  MakeLaterN m' Q lQ →
+  IntoLaterN only_head n (▷ P) lQ | 2.
+Proof.
+  rewrite /MakeLaterN /IntoLaterN /MaybeIntoLaterN /NatCancel.
+  move=> Hn [_ ->|->] <-;
+    by rewrite -later_laterN -laterN_add -Hn Nat.add_comm.
+Qed.
+Global Instance into_laterN_laterN only_head n m n' m' P Q lQ :
+  NatCancel n m n' m' →
+  TCIf (TCEq m m') (IntoLaterN only_head n' P Q) (MaybeIntoLaterN only_head n' P Q) →
+  MakeLaterN m' Q lQ →
+  IntoLaterN only_head n (▷^m P) lQ | 1.
+Proof.
+  rewrite /MakeLaterN /IntoLaterN /MaybeIntoLaterN /NatCancel.
+  move=> Hn [_ ->|->] <-; by rewrite -!laterN_add -Hn Nat.add_comm.
+Qed.
+
+Global Instance into_laterN_and_l n P1 P2 Q1 Q2 :
+  IntoLaterN false n P1 Q1 → MaybeIntoLaterN false n P2 Q2 →
+  IntoLaterN false n (P1 ∧ P2) (Q1 ∧ Q2) | 10.
+Proof. rewrite /IntoLaterN /MaybeIntoLaterN=> -> ->. by rewrite laterN_and. Qed.
+Global Instance into_laterN_and_r n P P2 Q2 :
+  IntoLaterN false n P2 Q2 → IntoLaterN false n (P ∧ P2) (P ∧ Q2) | 11.
+Proof.
+  rewrite /IntoLaterN /MaybeIntoLaterN=> ->. by rewrite laterN_and -(laterN_intro _ P).
+Qed.
+
+Global Instance into_laterN_forall {A} n (Φ Ψ : A → PROP) :
+  (∀ x, IntoLaterN false n (Φ x) (Ψ x)) →
+  IntoLaterN false n (∀ x, Φ x) (∀ x, Ψ x).
+Proof. rewrite /IntoLaterN /MaybeIntoLaterN laterN_forall=> ?. by apply forall_mono. Qed.
+Global Instance into_laterN_exist {A} n (Φ Ψ : A → PROP) :
+  (∀ x, IntoLaterN false n (Φ x) (Ψ x)) →
+  IntoLaterN false n (∃ x, Φ x) (∃ x, Ψ x).
+Proof. rewrite /IntoLaterN /MaybeIntoLaterN -laterN_exist_2=> ?. by apply exist_mono. Qed.
+
+Global Instance into_laterN_or_l n P1 P2 Q1 Q2 :
+  IntoLaterN false n P1 Q1 → MaybeIntoLaterN false n P2 Q2 →
+  IntoLaterN false n (P1 ∨ P2) (Q1 ∨ Q2) | 10.
+Proof. rewrite /IntoLaterN /MaybeIntoLaterN=> -> ->. by rewrite laterN_or. Qed.
+Global Instance into_laterN_or_r n P P2 Q2 :
+  IntoLaterN false n P2 Q2 →
+  IntoLaterN false n (P ∨ P2) (P ∨ Q2) | 11.
+Proof.
+  rewrite /IntoLaterN /MaybeIntoLaterN=> ->. by rewrite laterN_or -(laterN_intro _ P).
+Qed.
+
+Global Instance into_later_affinely n P Q :
+  IntoLaterN false n P Q → IntoLaterN false n (<affine> P) (<affine> Q).
+Proof. rewrite /IntoLaterN /MaybeIntoLaterN=> ->. by rewrite laterN_affinely_2. Qed.
+Global Instance into_later_intuitionistically n P Q :
+  IntoLaterN false n P Q → IntoLaterN false n (□ P) (□ Q).
+Proof. rewrite /IntoLaterN /MaybeIntoLaterN=> ->. by rewrite laterN_intuitionistically_2. Qed.
+Global Instance into_later_absorbingly n P Q :
+  IntoLaterN false n P Q → IntoLaterN false n (<absorb> P) (<absorb> Q).
+Proof. rewrite /IntoLaterN /MaybeIntoLaterN=> ->. by rewrite laterN_absorbingly. Qed.
+Global Instance into_later_persistently n P Q :
+  IntoLaterN false n P Q → IntoLaterN false n (<pers> P) (<pers> Q).
+Proof. rewrite /IntoLaterN /MaybeIntoLaterN=> ->. by rewrite laterN_persistently. Qed.
+
+Global Instance into_laterN_sep_l n P1 P2 Q1 Q2 :
+  IntoLaterN false n P1 Q1 → MaybeIntoLaterN false n P2 Q2 →
+  IntoLaterN false n (P1 ∗ P2) (Q1 ∗ Q2) | 10.
+Proof. rewrite /IntoLaterN /MaybeIntoLaterN=> -> ->. by rewrite laterN_sep. Qed.
+Global Instance into_laterN_sep_r n P P2 Q2 :
+  IntoLaterN false n P2 Q2 →
+  IntoLaterN false n (P ∗ P2) (P ∗ Q2) | 11.
+Proof.
+  rewrite /IntoLaterN /MaybeIntoLaterN=> ->. by rewrite laterN_sep -(laterN_intro _ P).
+Qed.
+
+Global Instance into_laterN_big_sepL n {A} (Φ Ψ : nat → A → PROP) (l: list A) :
+  (∀ x k, IntoLaterN false n (Φ k x) (Ψ k x)) →
+  IntoLaterN false n ([∗ list] k ↦ x ∈ l, Φ k x) ([∗ list] k ↦ x ∈ l, Ψ k x).
+Proof.
+  rewrite /IntoLaterN /MaybeIntoLaterN=> ?.
+  rewrite big_opL_commute. by apply big_sepL_mono.
+Qed.
+Global Instance into_laterN_big_sepL2 n {A B} (Φ Ψ : nat → A → B → PROP) l1 l2 :
+  (∀ x1 x2 k, IntoLaterN false n (Φ k x1 x2) (Ψ k x1 x2)) →
+  IntoLaterN false n ([∗ list] k ↦ y1;y2 ∈ l1;l2, Φ k y1 y2)
+    ([∗ list] k ↦ y1;y2 ∈ l1;l2, Ψ k y1 y2).
+Proof.
+  rewrite /IntoLaterN /MaybeIntoLaterN=> ?.
+  rewrite -big_sepL2_laterN_2. by apply big_sepL2_mono.
+Qed.
+Global Instance into_laterN_big_sepM n `{Countable K} {A}
+    (Φ Ψ : K → A → PROP) (m : gmap K A) :
+  (∀ x k, IntoLaterN false n (Φ k x) (Ψ k x)) →
+  IntoLaterN false n ([∗ map] k ↦ x ∈ m, Φ k x) ([∗ map] k ↦ x ∈ m, Ψ k x).
+Proof.
+  rewrite /IntoLaterN /MaybeIntoLaterN=> ?.
+  rewrite big_opM_commute. by apply big_sepM_mono.
+Qed.
+Global Instance into_laterN_big_sepM2 n `{Countable K} {A B}
+    (Φ Ψ : K → A → B → PROP) (m1 : gmap K A) (m2 : gmap K B) :
+  (∀ x1 x2 k, IntoLaterN false n (Φ k x1 x2) (Ψ k x1 x2)) →
+  IntoLaterN false n ([∗ map] k ↦ x1;x2 ∈ m1;m2, Φ k x1 x2) ([∗ map] k ↦ x1;x2 ∈ m1;m2, Ψ k x1 x2).
+Proof.
+  rewrite /IntoLaterN /MaybeIntoLaterN=> HΦΨ.
+  rewrite -big_sepM2_laterN_2. by apply big_sepM2_mono.
+Qed.
+Global Instance into_laterN_big_sepS n `{Countable A}
+    (Φ Ψ : A → PROP) (X : gset A) :
+  (∀ x, IntoLaterN false n (Φ x) (Ψ x)) →
+  IntoLaterN false n ([∗ set] x ∈ X, Φ x) ([∗ set] x ∈ X, Ψ x).
+Proof.
+  rewrite /IntoLaterN /MaybeIntoLaterN=> ?.
+  rewrite big_opS_commute. by apply big_sepS_mono.
+Qed.
+Global Instance into_laterN_big_sepMS n `{Countable A}
+    (Φ Ψ : A → PROP) (X : gmultiset A) :
+  (∀ x, IntoLaterN false n (Φ x) (Ψ x)) →
+  IntoLaterN false n ([∗ mset] x ∈ X, Φ x) ([∗ mset] x ∈ X, Ψ x).
+Proof.
+  rewrite /IntoLaterN /MaybeIntoLaterN=> ?.
+  rewrite big_opMS_commute. by apply big_sepMS_mono.
+Qed.
+End class_instances_later.

iris/proofmode/class_instances_make.v

+(** IMPORTANT: Read the comment in [classes_make] about the "constant time"
+requirements of these instances. *)
+From iris.proofmode Require Export classes_make.
+From iris.prelude Require Import options.
+Import bi.
+
+Section class_instances_make.
+Context {PROP : bi}.
+Implicit Types P Q R : PROP.
+
+(** Affine *)
+Global Instance bi_affine_quick_affine P : BiAffine PROP → QuickAffine P.
+Proof. rewrite /QuickAffine. apply _. Qed.
+Global Instance False_quick_affine : @QuickAffine PROP False.
+Proof. rewrite /QuickAffine. apply _. Qed.
+Global Instance emp_quick_affine : @QuickAffine PROP emp.
+Proof. rewrite /QuickAffine. apply _. Qed.
+Global Instance affinely_quick_affine P : QuickAffine (<affine> P).
+Proof. rewrite /QuickAffine. apply _. Qed.
+Global Instance intuitionistically_quick_affine P : QuickAffine (□ P).
+Proof. rewrite /QuickAffine. apply _. Qed.
+
+(** Absorbing *)
+Global Instance bi_affine_quick_absorbing P : BiAffine PROP → QuickAbsorbing P.
+Proof. rewrite /QuickAbsorbing. apply _. Qed.
+Global Instance pure_quick_absorbing φ : @QuickAbsorbing PROP ⌜ φ ⌝.
+Proof. rewrite /QuickAbsorbing. apply _. Qed.
+Global Instance absorbingly_quick_absorbing P : QuickAbsorbing (<absorb> P).
+Proof. rewrite /QuickAbsorbing. apply _. Qed.
+Global Instance persistently_quick_absorbing P : QuickAbsorbing (<pers> P).
+Proof. rewrite /QuickAbsorbing. apply _. Qed.
+
+(** Embed *)
+Global Instance make_embed_pure {PROP'} `{!BiEmbed PROP PROP'} φ :
+  KnownMakeEmbed (PROP:=PROP) ⌜φ⌝ ⌜φ⌝.
+Proof. apply embed_pure. Qed.
+Global Instance make_embed_emp {PROP'} `{!BiEmbed PROP PROP'} `{!BiEmbedEmp PROP PROP'} :
+  KnownMakeEmbed (PROP:=PROP) emp emp.
+Proof. apply embed_emp. Qed.
+Global Instance make_embed_default {PROP'} `{!BiEmbed PROP PROP'} P :
+  MakeEmbed P ⎡P⎤ | 100.
+Proof. by rewrite /MakeEmbed. Qed.
+
+(** Sep *)
+Global Instance make_sep_emp_l P : KnownLMakeSep emp P P.
+Proof. apply left_id, _. Qed.
+Global Instance make_sep_emp_r P : KnownRMakeSep P emp P.
+Proof. apply right_id, _. Qed.
+Global Instance make_sep_true_l P : QuickAbsorbing P → KnownLMakeSep True P P.
+Proof. rewrite /QuickAbsorbing /KnownLMakeSep /MakeSep=> ?. by apply True_sep. Qed.
+Global Instance make_sep_true_r P : QuickAbsorbing P →  KnownRMakeSep P True P.
+Proof. rewrite /QuickAbsorbing /KnownLMakeSep /MakeSep=> ?. by apply sep_True. Qed.
+Global Instance make_sep_default P Q : MakeSep P Q (P ∗ Q) | 100.
+Proof. by rewrite /MakeSep. Qed.
+
+(** And *)
+Global Instance make_and_true_l P : KnownLMakeAnd True P P.
+Proof. apply left_id, _. Qed.
+Global Instance make_and_true_r P : KnownRMakeAnd P True P.
+Proof. by rewrite /KnownRMakeAnd /MakeAnd right_id. Qed.
+Global Instance make_and_emp_l P : QuickAffine P → KnownLMakeAnd emp P P.
+Proof. apply emp_and. Qed.
+Global Instance make_and_emp_r P : QuickAffine P → KnownRMakeAnd P emp P.
+Proof. apply and_emp. Qed.
+Global Instance make_and_false_l P : KnownLMakeAnd False P False.
+Proof. apply left_absorb, _. Qed.
+Global Instance make_and_false_r P : KnownRMakeAnd P False False.
+Proof. by rewrite /KnownRMakeAnd /MakeAnd right_absorb. Qed.
+Global Instance make_and_default P Q : MakeAnd P Q (P ∧ Q) | 100.
+Proof. by rewrite /MakeAnd. Qed.
+
+(** Or *)
+Global Instance make_or_true_l P : KnownLMakeOr True P True.
+Proof. apply left_absorb, _. Qed.
+Global Instance make_or_true_r P : KnownRMakeOr P True True.
+Proof. by rewrite /KnownRMakeOr /MakeOr right_absorb. Qed.
+Global Instance make_or_emp_l P : QuickAffine P → KnownLMakeOr emp P emp.
+Proof. apply emp_or. Qed.
+Global Instance make_or_emp_r P : QuickAffine P → KnownRMakeOr P emp emp.
+Proof. apply or_emp. Qed.
+Global Instance make_or_false_l P : KnownLMakeOr False P P.
+Proof. apply left_id, _. Qed.
+Global Instance make_or_false_r P : KnownRMakeOr P False P.
+Proof. by rewrite /KnownRMakeOr /MakeOr right_id. Qed.
+Global Instance make_or_default P Q : MakeOr P Q (P ∨ Q) | 100.
+Proof. by rewrite /MakeOr. Qed.
+
+(** Affinely
+
+- [make_affinely_affine] adds no modality, but only if the argument is affine.
+- [make_affinely_True] turns [True] into [emp]. For an affine BI this instance
+  overlaps with [make_affinely_affine], since [True] is affine. Since we prefer
+  to avoid [emp] in goals involving affine BIs, we give [make_affinely_affine]
+  a lower cost than [make_affinely_True].
+- [make_affinely_default] adds the modality. This is the default instance since
+  it can always be used, and thus has the highest cost.
+  (For this last point, the cost of the [KnownMakeAffinely] instances does not
+  actually matter, since this is a [MakeAffinely] instance, i.e. an instance of
+  a different class. What really matters is that the [known_make_affinely]
+  instance has a lower cost than [make_affinely_default].) *)
+
+Global Instance make_affinely_affine P :
+  QuickAffine P → KnownMakeAffinely P P | 0.
+Proof. apply affine_affinely. Qed.
+Global Instance make_affinely_True : @KnownMakeAffinely PROP True emp | 1.
+Proof. by rewrite /KnownMakeAffinely /MakeAffinely affinely_True_emp. Qed.
+Global Instance make_affinely_default P : MakeAffinely P (<affine> P) | 100.
+Proof. by rewrite /MakeAffinely. Qed.
+
+(** Absorbingly
+
+- [make_absorbingly_absorbing] adds no modality, but only if the argument is
+  absorbing.
+- [make_absorbingly_emp] turns [emp] into [True]. For an affine BI this instance
+  overlaps with [make_absorbingly_absorbing], since [emp] is absorbing. For
+  consistency, we give this instance the same cost as [make_affinely_True], but
+  it does not really matter since goals in affine BIs typically do not contain
+  occurrences of [emp] to start with.
+- [make_absorbingly_default] adds the modality. This is the default instance
+  since it can always be used, and thus has the highest cost.
+  (For this last point, the cost of the [KnownMakeAbsorbingly] instances does not
+  actually matter, since this is a [MakeAbsorbingly] instance, i.e. an instance of
+  a different class. What really matters is that the [known_make_absorbingly]
+  instance has a lower cost than [make_absorbingly_default].) *)
+
+Global Instance make_absorbingly_absorbing P :
+  QuickAbsorbing P → KnownMakeAbsorbingly P P | 0.
+Proof. apply absorbing_absorbingly. Qed.
+Global Instance make_absorbingly_emp : @KnownMakeAbsorbingly PROP emp True | 1.
+Proof.
+  by rewrite /KnownMakeAbsorbingly /MakeAbsorbingly -absorbingly_emp_True.
+Qed.
+Global Instance make_absorbingly_default P : MakeAbsorbingly P (<absorb> P) | 100.
+Proof. by rewrite /MakeAbsorbingly. Qed.
+
+(** Persistently *)
+Global Instance make_persistently_emp :
+  @KnownMakePersistently PROP emp True | 0.
+Proof.
+  by rewrite /KnownMakePersistently /MakePersistently
+     -persistently_True_emp persistently_pure.
+Qed.
+Global Instance make_persistently_True :
+  @KnownMakePersistently PROP True True | 0.
+Proof. by rewrite /KnownMakePersistently /MakePersistently persistently_pure. Qed.
+Global Instance make_persistently_default P :
+  MakePersistently P (<pers> P) | 100.
+Proof. by rewrite /MakePersistently. Qed.
+
+(** Intuitionistically *)
+Global Instance make_intuitionistically_emp :
+  @KnownMakeIntuitionistically PROP emp emp | 0.
+Proof.
+  by rewrite /KnownMakeIntuitionistically /MakeIntuitionistically
+    intuitionistically_emp.
+Qed.
+(** For affine BIs, we would prefer [□ True] to become [True] rather than [emp],
+so we have this instance with lower cost than the next. *)
+Global Instance make_intuitionistically_True_affine :
+  BiAffine PROP →
+  @KnownMakeIntuitionistically PROP True True | 0.
+Proof.
+  intros. rewrite /KnownMakeIntuitionistically /MakeIntuitionistically
+    intuitionistically_True_emp True_emp //.
+Qed.
+Global Instance make_intuitionistically_True :
+  @KnownMakeIntuitionistically PROP True emp | 1.
+Proof.
+  by rewrite /KnownMakeIntuitionistically /MakeIntuitionistically
+    intuitionistically_True_emp.
+Qed.
+Global Instance make_intuitionistically_default P :
+  MakeIntuitionistically P (□ P) | 100.
+Proof. by rewrite /MakeIntuitionistically. Qed.
+
+(** Later *)
+Global Instance make_laterN_true n : @KnownMakeLaterN PROP n True True | 0.
+Proof. by rewrite /KnownMakeLaterN /MakeLaterN laterN_True. Qed.
+Global Instance make_laterN_emp `{!BiAffine PROP} n :
+  @KnownMakeLaterN PROP n emp emp | 0.
+Proof. by rewrite /KnownMakeLaterN /MakeLaterN laterN_emp. Qed.
+Global Instance make_laterN_default n P : MakeLaterN n P (▷^n P) | 100.
+Proof. by rewrite /MakeLaterN. Qed.
+
+(** Except-0 *)
+Global Instance make_except_0_True : @KnownMakeExcept0 PROP True True.
+Proof. by rewrite /KnownMakeExcept0 /MakeExcept0 except_0_True. Qed.
+Global Instance make_except_0_default P : MakeExcept0 P (◇ P) | 100.
+Proof. by rewrite /MakeExcept0. Qed.
+End class_instances_make.

iris/proofmode/class_instances_plainly.v

+From iris.bi Require Import bi.
+From iris.proofmode Require Import modality_instances classes.
+From iris.prelude Require Import options.
+Import bi.
+
+Section class_instances_plainly.
+Context {PROP} `{!BiPlainly PROP}.
+Implicit Types P Q R : PROP.
+
+Global Instance from_assumption_plainly_l_true P Q :
+  FromAssumption true P Q → KnownLFromAssumption true (■ P) Q.
+Proof.
+  rewrite /KnownLFromAssumption /FromAssumption /= =><-.
+  rewrite intuitionistically_plainly_elim //.
+Qed.
+Global Instance from_assumption_plainly_l_false `{!BiAffine PROP} P Q :
+  FromAssumption true P Q → KnownLFromAssumption false (■ P) Q.
+Proof.
+  rewrite /KnownLFromAssumption /FromAssumption /= =><-.
+  rewrite plainly_elim_persistently intuitionistically_into_persistently //.
+Qed.
+
+Global Instance from_pure_plainly P φ :
+  FromPure false P φ → FromPure false (■ P) φ.
+Proof. rewrite /FromPure=> <-. by rewrite plainly_pure. Qed.
+
+Global Instance into_pure_plainly P φ :
+  IntoPure P φ → IntoPure (■ P) φ.
+Proof. rewrite /IntoPure=> ->. apply: plainly_elim. Qed.
+
+Global Instance into_wand_plainly_true q R P Q :
+  IntoWand true q R P Q → IntoWand true q (■ R) P Q.
+Proof. rewrite /IntoWand /= intuitionistically_plainly_elim //. Qed.
+Global Instance into_wand_plainly_false q R P Q :
+  Absorbing R → IntoWand false q R P Q → IntoWand false q (■ R) P Q.
+Proof. intros ?. by rewrite /IntoWand plainly_elim. Qed.
+
+Global Instance from_and_plainly P Q1 Q2 :
+  FromAnd P Q1 Q2 → FromAnd (■ P) (■ Q1) (■ Q2).
+Proof. rewrite /FromAnd=> <-. by rewrite plainly_and. Qed.
+
+Global Instance from_sep_plainly P Q1 Q2 :
+  FromSep P Q1 Q2 → FromSep (■ P) (■ Q1) (■ Q2).
+Proof. rewrite /FromSep=> <-. by rewrite plainly_sep_2. Qed.
+
+Global Instance into_and_plainly p P Q1 Q2 :
+  IntoAnd p P Q1 Q2 → IntoAnd p (■ P) (■ Q1) (■ Q2).
+Proof.
+  rewrite /IntoAnd /=. destruct p; simpl.
+  - rewrite -plainly_and -[(□ ■ P)%I]intuitionistically_idemp intuitionistically_plainly =>->.
+    rewrite [(□ (_ ∧ _))%I]intuitionistically_elim //.
+  - intros ->. by rewrite plainly_and.
+Qed.
+
+Global Instance into_sep_plainly `{!BiPositive PROP} P Q1 Q2 :
+  IntoSep P Q1 Q2 → IntoSep (■ P) (■ Q1) (■ Q2).
+Proof. rewrite /IntoSep /= => ->. by rewrite plainly_sep. Qed.
+Global Instance into_sep_plainly_affine P Q1 Q2 :
+  IntoSep P Q1 Q2 →
+  TCOr (Affine Q1) (Absorbing Q2) → TCOr (Affine Q2) (Absorbing Q1) →
+  IntoSep (■ P) (■ Q1) (■ Q2).
+Proof.
+  rewrite /IntoSep /= => -> ??. by rewrite sep_and plainly_and plainly_and_sep_l_1.
+Qed.
+
+Global Instance from_or_plainly P Q1 Q2 :
+  FromOr P Q1 Q2 → FromOr (■ P) (■ Q1) (■ Q2).
+Proof. rewrite /FromOr=> <-. by rewrite -plainly_or_2. Qed.
+
+Global Instance into_or_plainly `{!BiPlainlyExist PROP} P Q1 Q2 :
+  IntoOr P Q1 Q2 → IntoOr (■ P) (■ Q1) (■ Q2).
+Proof. rewrite /IntoOr=>->. by rewrite plainly_or. Qed.
+
+Global Instance from_exist_plainly {A} P (Φ : A → PROP) :
+  FromExist P Φ → FromExist (■ P) (λ a, ■ (Φ a))%I.
+Proof. rewrite /FromExist=> <-. by rewrite -plainly_exist_2. Qed.
+
+Global Instance into_exist_plainly `{!BiPlainlyExist PROP} {A} P (Φ : A → PROP) name :
+  IntoExist P Φ name → IntoExist (■ P) (λ a, ■ (Φ a))%I name.
+Proof. rewrite /IntoExist=> HP. by rewrite HP plainly_exist. Qed.
+
+Global Instance into_forall_plainly {A} P (Φ : A → PROP) :
+  IntoForall P Φ → IntoForall (■ P) (λ a, ■ (Φ a))%I.
+Proof. rewrite /IntoForall=> HP. by rewrite HP plainly_forall. Qed.
+
+Global Instance from_forall_plainly {A} P (Φ : A → PROP) name :
+  FromForall P Φ name → FromForall (■ P) (λ a, ■ (Φ a))%I name.
+Proof. rewrite /FromForall=> <-. by rewrite plainly_forall. Qed.
+
+Global Instance from_modal_plainly P :
+  FromModal True modality_plainly (■ P) (■ P) P | 2.
+Proof. by rewrite /FromModal. Qed.
+
+Global Instance into_except_0_plainly `{!BiPlainlyExist PROP} P Q :
+  IntoExcept0 P Q → IntoExcept0 (■ P) (■ Q).
+Proof. rewrite /IntoExcept0=> ->. by rewrite except_0_plainly. Qed.
+
+Global Instance into_later_plainly n P Q :
+  IntoLaterN false n P Q → IntoLaterN false n (■ P) (■ Q).
+Proof. rewrite /IntoLaterN /MaybeIntoLaterN=> ->. by rewrite laterN_plainly. Qed.
+End class_instances_plainly.

iris/proofmode/class_instances_updates.v

+From stdpp Require Import nat_cancel.
+From iris.bi Require Import bi.
+From iris.proofmode Require Import modality_instances classes.
+From iris.proofmode Require Import ltac_tactics class_instances.
+From iris.prelude Require Import options.
+Import bi.
+
+Section class_instances_updates.
+Context {PROP : bi}.
+Implicit Types P Q R : PROP.
+
+Global Instance from_assumption_bupd `{!BiBUpd PROP} p P Q :
+  FromAssumption p P Q → KnownRFromAssumption p P (|==> Q).
+Proof. rewrite /KnownRFromAssumption /FromAssumption=>->. apply bupd_intro. Qed.
+Global Instance from_assumption_fupd
+    `{!BiBUpd PROP, !BiFUpd PROP, !BiBUpdFUpd PROP} E p P Q :
+  FromAssumption p P (|==> Q) → KnownRFromAssumption p P (|={E}=> Q).
+Proof. rewrite /KnownRFromAssumption /FromAssumption=>->. apply bupd_fupd. Qed.
+
+Global Instance from_pure_bupd `{!BiBUpd PROP} a P φ :
+  FromPure a P φ → FromPure a (|==> P) φ.
+Proof. rewrite /FromPure=> <-. apply bupd_intro. Qed.
+Global Instance from_pure_fupd `{!BiFUpd PROP} a E P φ :
+  FromPure a P φ → FromPure a (|={E}=> P) φ.
+Proof. rewrite /FromPure=> <-. apply fupd_intro. Qed.
+
+Global Instance into_wand_bupd `{!BiBUpd PROP} p q R P Q :
+  IntoWand false false R P Q → IntoWand p q (|==> R) (|==> P) (|==> Q).
+Proof.
+  rewrite /IntoWand /= => HR. rewrite !intuitionistically_if_elim HR.
+  apply wand_intro_l. by rewrite bupd_sep wand_elim_r.
+Qed.
+Global Instance into_wand_fupd `{!BiFUpd PROP} E p q R P Q :
+  IntoWand false false R P Q →
+  IntoWand p q (|={E}=> R) (|={E}=> P) (|={E}=> Q).
+Proof.
+  rewrite /IntoWand /= => HR. rewrite !intuitionistically_if_elim HR.
+  apply wand_intro_l. by rewrite fupd_sep wand_elim_r.
+Qed.
+
+Global Instance into_wand_bupd_persistent `{!BiBUpd PROP} p q R P Q :
+  IntoWand false q R P Q → IntoWand p q (|==> R) P (|==> Q).
+Proof.
+  rewrite /IntoWand /= => HR. rewrite intuitionistically_if_elim HR.
+  apply wand_intro_l. by rewrite bupd_frame_l wand_elim_r.
+Qed.
+Global Instance into_wand_fupd_persistent `{!BiFUpd PROP} E1 E2 p q R P Q :
+  IntoWand false q R P Q → IntoWand p q (|={E1,E2}=> R) P (|={E1,E2}=> Q).
+Proof.
+  rewrite /IntoWand /= => HR. rewrite intuitionistically_if_elim HR.
+  apply wand_intro_l. by rewrite fupd_frame_l wand_elim_r.
+Qed.
+
+Global Instance into_wand_bupd_args `{!BiBUpd PROP} p q R P Q :
+  IntoWand p false R P Q → IntoWand' p q R (|==> P) (|==> Q).
+Proof.
+  rewrite /IntoWand' /IntoWand /= => ->.
+  apply wand_intro_l. by rewrite intuitionistically_if_elim bupd_wand_r.
+Qed.
+Global Instance into_wand_fupd_args `{!BiFUpd PROP} E1 E2 p q R P Q :
+  IntoWand p false R P Q → IntoWand' p q R (|={E1,E2}=> P) (|={E1,E2}=> Q).
+Proof.
+  rewrite /IntoWand' /IntoWand /= => ->.
+  apply wand_intro_l. by rewrite intuitionistically_if_elim fupd_wand_r.
+Qed.
+
+Global Instance from_sep_bupd `{!BiBUpd PROP} P Q1 Q2 :
+  FromSep P Q1 Q2 → FromSep (|==> P) (|==> Q1) (|==> Q2).
+Proof. rewrite /FromSep=><-. apply bupd_sep. Qed.
+Global Instance from_sep_fupd `{!BiFUpd PROP} E P Q1 Q2 :
+  FromSep P Q1 Q2 → FromSep (|={E}=> P) (|={E}=> Q1) (|={E}=> Q2).
+Proof. rewrite /FromSep =><-. apply fupd_sep. Qed.
+
+Global Instance from_or_bupd `{!BiBUpd PROP} P Q1 Q2 :
+  FromOr P Q1 Q2 → FromOr (|==> P) (|==> Q1) (|==> Q2).
+Proof. rewrite /FromOr=><-. apply bupd_or. Qed.
+Global Instance from_or_fupd `{!BiFUpd PROP} E1 E2 P Q1 Q2 :
+  FromOr P Q1 Q2 → FromOr (|={E1,E2}=> P) (|={E1,E2}=> Q1) (|={E1,E2}=> Q2).
+Proof. rewrite /FromOr=><-. apply fupd_or. Qed.
+
+Global Instance into_and_bupd `{!BiBUpd PROP} P Q1 Q2 :
+  IntoAnd false P Q1 Q2 → IntoAnd false (|==> P) (|==> Q1) (|==> Q2).
+Proof. rewrite /IntoAnd/==>->. apply bupd_and. Qed.
+Global Instance into_and_fupd `{!BiFUpd PROP} E1 E2 P Q1 Q2 :
+  IntoAnd false P Q1 Q2 → IntoAnd false (|={E1,E2}=> P) (|={E1,E2}=> Q1) (|={E1,E2}=> Q2).
+Proof. rewrite /IntoAnd/==>->. apply fupd_and. Qed.
+
+Global Instance from_exist_bupd `{!BiBUpd PROP} {A} P (Φ : A → PROP) :
+  FromExist P Φ → FromExist (|==> P) (λ a, |==> Φ a)%I.
+Proof. rewrite /FromExist=><-. apply bupd_exist. Qed.
+Global Instance from_exist_fupd `{!BiFUpd PROP} {A} E1 E2 P (Φ : A → PROP) :
+  FromExist P Φ → FromExist (|={E1,E2}=> P) (λ a, |={E1,E2}=> Φ a)%I.
+Proof. rewrite /FromExist=><-. apply fupd_exist. Qed.
+
+Global Instance into_forall_bupd `{!BiBUpd PROP} {A} P (Φ : A → PROP) :
+  IntoForall P Φ → IntoForall (|==> P) (λ a, |==> Φ a)%I.
+Proof. rewrite /IntoForall=>->. apply bupd_forall. Qed.
+Global Instance into_forall_fupd `{!BiFUpd PROP} {A} E1 E2 P (Φ : A → PROP) :
+  IntoForall P Φ → IntoForall (|={E1,E2}=> P) (λ a, |={E1,E2}=> Φ a)%I.
+Proof. rewrite /IntoForall=>->. apply fupd_forall. Qed.
+
+Global Instance from_forall_fupd
+    `{!BiFUpd PROP, !BiPlainly PROP, !BiFUpdPlainly PROP} E1 E2 {A} P (Φ : A → PROP) name :
+  (* Some cases in which [E2 ⊆ E1] holds *)
+  TCOr (TCEq E1 E2) (TCOr (TCEq E1 ⊤) (TCEq E2 ∅)) →
+  FromForall P Φ name → (∀ x, Plain (Φ x)) →
+  FromForall (|={E1,E2}=> P) (λ a, |={E1,E2}=> (Φ a))%I name.
+Proof.
+  rewrite /FromForall=> -[->|[->|->]] <- ?; rewrite fupd_plain_forall; set_solver.
+Qed.
+Global Instance from_forall_step_fupd
+    `{!BiFUpd PROP, !BiPlainly PROP, !BiFUpdPlainly PROP} E1 E2 {A} P (Φ : A → PROP) name :
+  (* Some cases in which [E2 ⊆ E1] holds *)
+  TCOr (TCEq E1 E2) (TCOr (TCEq E1 ⊤) (TCEq E2 ∅)) →
+  FromForall P Φ name → (∀ x, Plain (Φ x)) →
+  FromForall (|={E1}[E2]▷=> P) (λ a, |={E1}[E2]▷=> (Φ a))%I name.
+Proof.
+  rewrite /FromForall=> -[->|[->|->]] <- ?; rewrite step_fupd_plain_forall; set_solver.
+Qed.
+
+Global Instance is_except_0_bupd `{!BiBUpd PROP} P : IsExcept0 P → IsExcept0 (|==> P).
+Proof.
+  rewrite /IsExcept0=> HP.
+  by rewrite -{2}HP -(except_0_idemp P) -except_0_bupd -(except_0_intro P).
+Qed.
+Global Instance is_except_0_fupd `{!BiFUpd PROP} E1 E2 P :
+  IsExcept0 (|={E1,E2}=> P).
+Proof. by rewrite /IsExcept0 except_0_fupd. Qed.
+
+Global Instance from_modal_bupd `{!BiBUpd PROP} P :
+  FromModal True modality_id (|==> P) (|==> P) P.
+Proof. by rewrite /FromModal /= -bupd_intro. Qed.
+Global Instance from_modal_fupd E P `{!BiFUpd PROP} :
+  FromModal True modality_id (|={E}=> P) (|={E}=> P) P.
+Proof. by rewrite /FromModal /= -fupd_intro. Qed.
+Global Instance from_modal_fupd_wrong_mask E1 E2 P `{!BiFUpd PROP} :
+  FromModal
+        (pm_error "Only non-mask-changing update modalities can be introduced directly.
+Use [iApply fupd_mask_intro] to introduce mask-changing update modalities")
+    modality_id (|={E1,E2}=> P) (|={E1,E2}=> P) P | 100.
+Proof. by intros []. Qed.
+
+Global Instance elim_modal_bupd `{!BiBUpd PROP} p P Q :
+  ElimModal True p false (|==> P) P (|==> Q) (|==> Q).
+Proof.
+  by rewrite /ElimModal
+    intuitionistically_if_elim bupd_frame_r wand_elim_r bupd_trans.
+Qed.
+
+Global Instance elim_modal_bupd_plain_goal
+    `{!BiBUpd PROP, !BiPlainly PROP, !BiBUpdPlainly PROP} p P Q :
+  Plain Q → ElimModal True p false (|==> P) P Q Q.
+Proof.
+  intros. by rewrite /ElimModal intuitionistically_if_elim
+    bupd_frame_r wand_elim_r bupd_elim.
+Qed.
+Global Instance elim_modal_bupd_plain
+    `{!BiBUpd PROP, !BiPlainly PROP, !BiBUpdPlainly PROP} p P Q :
+  Plain P → ElimModal True p p (|==> P) P Q Q.
+Proof. intros. by rewrite /ElimModal bupd_elim wand_elim_r. Qed.
+Global Instance elim_modal_bupd_fupd
+    `{!BiBUpd PROP, !BiFUpd PROP, !BiBUpdFUpd PROP} p E1 E2 P Q :
+  ElimModal True p false (|==> P) P (|={E1,E2}=> Q) (|={E1,E2}=> Q) | 10.
+Proof.
+  by rewrite /ElimModal intuitionistically_if_elim
+    (bupd_fupd E1) fupd_frame_r wand_elim_r fupd_trans.
+Qed.
+Global Instance elim_modal_fupd_fupd `{!BiFUpd PROP} p E1 E2 E3 P Q :
+  ElimModal True p false (|={E1,E2}=> P) P (|={E1,E3}=> Q) (|={E2,E3}=> Q).
+Proof.
+  by rewrite /ElimModal intuitionistically_if_elim
+    fupd_frame_r wand_elim_r fupd_trans.
+Qed.
+Global Instance elim_modal_fupd_fupd_wrong_mask `{!BiFUpd PROP} p E0 E1 E2 E3 P Q :
+  ElimModal
+    (pm_error "Goal and eliminated modality must have the same mask.
+Use [iMod (fupd_mask_subseteq E2)] to adjust the mask of your goal to [E2]")
+    p false
+    (|={E1,E2}=> P) False (|={E0,E3}=> Q) False | 100.
+Proof. intros []. Qed.
+
+Global Instance add_modal_bupd `{!BiBUpd PROP} P Q : AddModal (|==> P) P (|==> Q).
+Proof. by rewrite /AddModal bupd_frame_r wand_elim_r bupd_trans. Qed.
+
+Global Instance add_modal_fupd `{!BiFUpd PROP} E1 E2 P Q :
+  AddModal (|={E1}=> P) P (|={E1,E2}=> Q).
+Proof. by rewrite /AddModal fupd_frame_r wand_elim_r fupd_trans. Qed.
+
+Global Instance elim_acc_bupd `{!BiBUpd PROP} {X} α β mγ Q :
+  ElimAcc (X:=X) True bupd bupd α β mγ
+          (|==> Q)
+          (λ x, |==> β x ∗ (mγ x -∗? |==> Q))%I.
+Proof.
+  iIntros (_) "Hinner >Hacc". iDestruct "Hacc" as (x) "[Hα Hclose]".
+  iMod ("Hinner" with "Hα") as "[Hβ Hfin]".
+  iMod ("Hclose" with "Hβ") as "Hγ". by iApply "Hfin".
+Qed.
+Global Instance elim_acc_fupd `{!BiFUpd PROP} {X} E1 E2 E α β mγ Q :
+  ElimAcc (X:=X) True (fupd E1 E2) (fupd E2 E1) α β mγ
+          (|={E1,E}=> Q)
+          (λ x, |={E2}=> β x ∗ (mγ x -∗? |={E1,E}=> Q))%I.
+Proof.
+  iIntros (_) "Hinner >Hacc". iDestruct "Hacc" as (x) "[Hα Hclose]".
+  iMod ("Hinner" with "Hα") as "[Hβ Hfin]".
+  iMod ("Hclose" with "Hβ") as "Hγ". by iApply "Hfin".
+Qed.
+End class_instances_updates.

iris/proofmode/classes.v

+From stdpp Require Import namespaces.
+From iris.bi Require Export bi.
+From iris.proofmode Require Import base.
+From iris.proofmode Require Export ident_name modalities.
+From iris.prelude Require Import options.
+Import bi.
+
+(** Use this as precondition on "failing" instances of typeclasses that have
+pure preconditions (such as [ElimModal]), if you want a nice error to be shown
+when this instances is picked as part of some proof mode tactic. *)
+Inductive pm_error (s : string) := .
+
+Class FromAssumption {PROP : bi} (p : bool) (P Q : PROP) :=
+  from_assumption : □?p P ⊢ Q.
+Global Arguments FromAssumption {_} _ _%_I _%_I : simpl never.
+Global Arguments from_assumption {_} _ _%_I _%_I {_}.
+Global Hint Mode FromAssumption + + - - : typeclass_instances.
+
+Class KnownLFromAssumption {PROP : bi} (p : bool) (P Q : PROP) :=
+  #[global] knownl_from_assumption :: FromAssumption p P Q.
+Global Arguments KnownLFromAssumption {_} _ _%_I _%_I : simpl never.
+Global Arguments knownl_from_assumption {_} _ _%_I _%_I {_}.
+Global Hint Mode KnownLFromAssumption + + ! - : typeclass_instances.
+
+Class KnownRFromAssumption {PROP : bi} (p : bool) (P Q : PROP) :=
+  #[global] knownr_from_assumption :: FromAssumption p P Q.
+Global Arguments KnownRFromAssumption {_} _ _%_I _%_I : simpl never.
+Global Arguments knownr_from_assumption {_} _ _%_I _%_I {_}.
+Global Hint Mode KnownRFromAssumption + + - ! : typeclass_instances.
+
+Class IntoPure {PROP : bi} (P : PROP) (φ : Prop) :=
+  into_pure : P ⊢ ⌜φ⌝.
+Global Arguments IntoPure {_} _%_I _%_type_scope : simpl never.
+Global Arguments into_pure {_} _%_I _%_type_scope {_}.
+Global Hint Mode IntoPure + ! - : typeclass_instances.
+
+(* [IntoPureT] is a variant of [IntoPure] with the argument in [Type] to avoid
+some shortcoming of unification in Coq's type class search. An example where we
+use this workaround is to repair the following instance:
+
+  Global Instance into_exist_and_pure P Q (φ : Prop) :
+    IntoPure P φ → IntoExist (P ∧ Q) (λ _ : φ, Q).
+
+Coq is unable to use this instance: [class_apply] -- which is used by type class
+search -- fails with the error that it cannot unify [Prop] and [Type]. This is
+probably caused because [class_apply] uses an ancient unification algorith. The
+[refine] tactic -- which uses a better unification algorithm -- succeeds to
+apply the above instance.
+
+Since we do not want to define [Hint Extern] declarations using [refine] for
+any instance like [into_exist_and_pure], we factor this out in the class
+[IntoPureT]. This way, we only have to declare a [Hint Extern] using [refine]
+once, and use [IntoPureT] in any instance like [into_exist_and_pure].
+
+TODO: Report this as a Coq bug, or wait for https://github.com/coq/coq/pull/991
+to be finished and merged someday. *)
+Class IntoPureT {PROP : bi} (P : PROP) (φ : Type) :=
+  into_pureT : ∃ ψ : Prop, φ = ψ ∧ IntoPure P ψ.
+Lemma into_pureT_hint {PROP : bi} (P : PROP) (φ : Prop) : IntoPure P φ → IntoPureT P φ.
+Proof. by exists φ. Qed.
+Global Hint Extern 0 (IntoPureT _ _) =>
+  notypeclasses refine (into_pureT_hint _ _ _) : typeclass_instances.
+
+(** [FromPure a P φ] is used when introducing a pure assertion. It is used by
+[iPureIntro] and the [[%]] specialization pattern.
+
+The Boolean [a] specifies whether introduction of [P] needs [emp] in addition
+to [φ]. Concretely, for the [iPureIntro] tactic, this means it specifies whether
+the spatial context should be empty or not.
+
+Note that the Boolean [a] is not needed for the (dual) [IntoPure] class, because
+there we can just ask that [P] is [Affine]. *)
+Class FromPure {PROP : bi} (a : bool) (P : PROP) (φ : Prop) :=
+  from_pure : <affine>?a ⌜φ⌝ ⊢ P.
+Global Arguments FromPure {_} _ _%_I _%_type_scope : simpl never.
+Global Arguments from_pure {_} _ _%_I _%_type_scope {_}.
+Global Hint Mode FromPure + - ! - : typeclass_instances.
+
+Class FromPureT {PROP : bi} (a : bool) (P : PROP) (φ : Type) :=
+  from_pureT : ∃ ψ : Prop, φ = ψ ∧ FromPure a P ψ.
+Lemma from_pureT_hint {PROP : bi} (a : bool) (P : PROP) (φ : Prop) :
+  FromPure a P φ → FromPureT a P φ.
+Proof. by exists φ. Qed.
+Global Hint Extern 0 (FromPureT _ _ _) =>
+  notypeclasses refine (from_pureT_hint _ _ _ _) : typeclass_instances.
+
+Class IntoInternalEq `{BiInternalEq PROP} {A : ofe} (P : PROP) (x y : A) :=
+  into_internal_eq : P ⊢ x ≡ y.
+Global Arguments IntoInternalEq {_ _ _} _%_I _%_type_scope _%_type_scope : simpl never.
+Global Arguments into_internal_eq {_ _ _} _%_I _%_type_scope _%_type_scope {_}.
+Global Hint Mode IntoInternalEq + - - ! - - : typeclass_instances.
+
+Class IntoPersistent {PROP : bi} (p : bool) (P Q : PROP) :=
+  into_persistent : <pers>?p P ⊢ <pers> Q.
+Global Arguments IntoPersistent {_} _ _%_I _%_I : simpl never.
+Global Arguments into_persistent {_} _ _%_I _%_I {_}.
+Global Hint Mode IntoPersistent + + ! - : typeclass_instances.
+
+(** The [FromModal φ M sel P Q] class is used by the [iModIntro] tactic to
+transform a goal [P] into a modality [M] and proposition [Q], under additional
+pure assumptions [φ].
+
+The inputs are [P] and [sel] and the outputs are [M] and [Q].
+
+The input [sel] can be used to specify which modality to introduce in case there
+are multiple choices to turn [P] into a modality. For example, given [⎡|==> R⎤],
+[sel] can be either [|==> ?e] or [⎡ ?e ⎤], which turn it into an update modality
+or embedding, respectively. In case there is no need to specify the modality to
+introduce, [sel] should be an evar.
+
+For modalities [N] that do not need to augment the proof mode environment, one
+can define an instance [FromModal True modality_id (N P) P]. Defining such an
+instance only imposes the proof obligation [P ⊢ N P]. Examples of such
+modalities [N] are [bupd], [fupd], [except_0], [monPred_subjectively] and
+[bi_absorbingly]. *)
+Class FromModal {PROP1 PROP2 : bi} {A}
+    (φ : Prop) (M : modality PROP1 PROP2) (sel : A) (P : PROP2) (Q : PROP1) :=
+  from_modal : φ → M Q ⊢ P.
+Global Arguments FromModal {_ _ _} _ _ _%_I _%_I _%_I : simpl never.
+Global Arguments from_modal {_ _ _} _ _ _ _%_I _%_I {_}.
+Global Hint Mode FromModal - + - - - - ! - : typeclass_instances.
+
+(** The [FromAffinely P Q] class is used to add an [<affine>] modality to the
+proposition [Q].
+
+The input is [Q] and the output is [P]. *)
+Class FromAffinely {PROP : bi} (P Q : PROP) :=
+  from_affinely : <affine> Q ⊢ P.
+Global Arguments FromAffinely {_} _%_I _%_I : simpl never.
+Global Arguments from_affinely {_} _%_I _%_I {_}.
+Global Hint Mode FromAffinely + - ! : typeclass_instances.
+
+(** The [IntoAbsorbingly P Q] class is used to add an [<absorb>] modality to
+the proposition [Q].
+
+The input is [Q] and the output is [P]. *)
+Class IntoAbsorbingly {PROP : bi} (P Q : PROP) :=
+  into_absorbingly : P ⊢ <absorb> Q.
+Global Arguments IntoAbsorbingly {_} _%_I _%_I.
+Global Arguments into_absorbingly {_} _%_I _%_I {_}.
+Global Hint Mode IntoAbsorbingly + - ! : typeclass_instances.
+
+(** Converting an assumption [R] into a wand [P -∗ Q] is done in three stages:
+
+- Strip modalities and universal quantifiers of [R] until an arrow or a wand
+  has been obtained.
+- Balance modalities in the arguments [P] and [Q] to match the goal (which used
+  for [iApply]) or the premise (when used with [iSpecialize] and a specific
+  hypothesis).
+- Instantiate the premise of the wand or implication. *)
+Class IntoWand {PROP : bi} (p q : bool) (R P Q : PROP) :=
+  into_wand : □?p R ⊢ □?q P -∗ Q.
+Global Arguments IntoWand {_} _ _ _%_I _%_I _%_I : simpl never.
+Global Arguments into_wand {_} _ _ _%_I _%_I _%_I {_}.
+Global Hint Mode IntoWand + + + ! - - : typeclass_instances.
+
+Class IntoWand' {PROP : bi} (p q : bool) (R P Q : PROP) :=
+  into_wand' : IntoWand p q R P Q.
+Global Arguments IntoWand' {_} _ _ _%_I _%_I _%_I : simpl never.
+Global Hint Mode IntoWand' + + + ! ! - : typeclass_instances.
+Global Hint Mode IntoWand' + + + ! - ! : typeclass_instances.
+
+Class FromWand {PROP : bi} (P Q1 Q2 : PROP) := from_wand : (Q1 -∗ Q2) ⊢ P.
+Global Arguments FromWand {_} _%_I _%_I _%_I : simpl never.
+Global Arguments from_wand {_} _%_I _%_I _%_I {_}.
+Global Hint Mode FromWand + ! - - : typeclass_instances.
+
+Class FromImpl {PROP : bi} (P Q1 Q2 : PROP) := from_impl : (Q1 → Q2) ⊢ P.
+Global Arguments FromImpl {_} _%_I _%_I _%_I : simpl never.
+Global Arguments from_impl {_} _%_I _%_I _%_I {_}.
+Global Hint Mode FromImpl + ! - - : typeclass_instances.
+
+Class FromSep {PROP : bi} (P Q1 Q2 : PROP) := from_sep : Q1 ∗ Q2 ⊢ P.
+Global Arguments FromSep {_} _%_I _%_I _%_I : simpl never.
+Global Arguments from_sep {_} _%_I _%_I _%_I {_}.
+Global Hint Mode FromSep + ! - - : typeclass_instances. (* For iSplit{L,R} *)
+
+Class FromAnd {PROP : bi} (P Q1 Q2 : PROP) := from_and : Q1 ∧ Q2 ⊢ P.
+Global Arguments FromAnd {_} _%_I _%_I _%_I : simpl never.
+Global Arguments from_and {_} _%_I _%_I _%_I {_}.
+Global Hint Mode FromAnd + ! - - : typeclass_instances.
+
+(** The [IntoAnd p P Q1 Q2] class is used to handle some [[H1 H2]] intro
+patterns:
+- [IntoAnd true] is used for such patterns in the intuitionistic context
+- [IntoAnd false] is used for such patterns where one of the two sides is
+  discarded (e.g. [[_ H]]) or where the left-hand side is pure as in [[% H]]
+  (via an [IntoExist] fallback).
+
+The inputs are [p P] and the outputs are [Q1 Q2]. *)
+Class IntoAnd {PROP : bi} (p : bool) (P Q1 Q2 : PROP) :=
+  into_and : □?p P ⊢ □?p (Q1 ∧ Q2).
+Global Arguments IntoAnd {_} _ _%_I _%_I _%_I : simpl never.
+Global Arguments into_and {_} _ _%_I _%_I _%_I {_}.
+Global Hint Mode IntoAnd + + ! - - : typeclass_instances.
+
+(** The [IntoSep P Q1 Q2] class is used to handle [[H1 H2]] intro patterns in
+the spatial context, except:
+- when one side is [_], then [IntoAnd] is tried first (but [IntoSep] is used as
+  fallback)
+- when the left-hand side is [%], then [IntoExist] is used)
+
+The input is [P] and the outputs are [Q1 Q2]. *)
+Class IntoSep {PROP : bi} (P Q1 Q2 : PROP) :=
+  into_sep : P ⊢ Q1 ∗ Q2.
+Global Arguments IntoSep {_} _%_I _%_I _%_I : simpl never.
+Global Arguments into_sep {_} _%_I _%_I _%_I {_}.
+Global Hint Mode IntoSep + ! - - : typeclass_instances.
+
+Class FromOr {PROP : bi} (P Q1 Q2 : PROP) := from_or : Q1 ∨ Q2 ⊢ P.
+Global Arguments FromOr {_} _%_I _%_I _%_I : simpl never.
+Global Arguments from_or {_} _%_I _%_I _%_I {_}.
+Global Hint Mode FromOr + ! - - : typeclass_instances.
+
+Class IntoOr {PROP : bi} (P Q1 Q2 : PROP) := into_or : P ⊢ Q1 ∨ Q2.
+Global Arguments IntoOr {_} _%_I _%_I _%_I : simpl never.
+Global Arguments into_or {_} _%_I _%_I _%_I {_}.
+Global Hint Mode IntoOr + ! - - : typeclass_instances.
+
+Class FromExist {PROP : bi} {A} (P : PROP) (Φ : A → PROP) :=
+  from_exist : (∃ x, Φ x) ⊢ P.
+Global Arguments FromExist {_ _} _%_I _%_I : simpl never.
+Global Arguments from_exist {_ _} _%_I _%_I {_}.
+Global Hint Mode FromExist + - ! - : typeclass_instances.
+
+Class IntoExist {PROP : bi} {A} (P : PROP) (Φ : A → PROP) (name: ident_name) :=
+  into_exist : P ⊢ ∃ x, Φ x.
+Global Arguments IntoExist {_ _} _%_I _%_I _ : simpl never.
+Global Arguments into_exist {_ _} _%_I _%_I _ {_}.
+Global Hint Mode IntoExist + - ! - - : typeclass_instances.
+
+Class IntoForall {PROP : bi} {A} (P : PROP) (Φ : A → PROP) :=
+  into_forall : P ⊢ ∀ x, Φ x.
+Global Arguments IntoForall {_ _} _%_I _%_I : simpl never.
+Global Arguments into_forall {_ _} _%_I _%_I {_}.
+Global Hint Mode IntoForall + - ! - : typeclass_instances.
+
+Class FromForall {PROP : bi} {A} (P : PROP) (Φ : A → PROP) (name : ident_name) :=
+  from_forall : (∀ x, Φ x) ⊢ P.
+Global Arguments FromForall {_ _} _%_I _%_I _ : simpl never.
+Global Arguments from_forall {_ _} _%_I _%_I _ {_}.
+Global Hint Mode FromForall + - ! - - : typeclass_instances.
+
+Class IsExcept0 {PROP : bi} (Q : PROP) := is_except_0 : ◇ Q ⊢ Q.
+Global Arguments IsExcept0 {_} _%_I : simpl never.
+Global Arguments is_except_0 {_} _%_I {_}.
+Global Hint Mode IsExcept0 + ! : typeclass_instances.
+
+(** [CombineSepAs], [MaybeCombineSepAs] and [CombineSepGives] are all used for
+  the [iCombine] tactic.
+
+These three classes take two hypotheses [P] and [Q] as input, and return a
+(possibly simplified) new hypothesis [R]. [CombineSepAs P Q R] means that [R]
+may be obtained by deleting both [P] and [Q], and that [R] is not a trivial
+combination. [MaybeCombineSepAs P Q R progress] is like [CombineSepAs], but
+[R] can be the trivial combination [P ∗ Q], and the [progress] parameter
+indicates whether this trivial combination is used. [CombineSepGives P Q R]
+means that [□ R] may be obtained 'for free' from [P] and [Q]. The result [R] of
+[CombineSepAs] and [MaybeCombineSepAs] will not contain the observations
+from [CombineSepGives].
+
+We deliberately use separate typeclasses [CombineSepAs] and [CombineSepGives].
+This allows one to (1) combine hypotheses and get additional persistent
+information, (2) only combine the hypotheses, without the additional persistent
+information, (3) only get the additional persistent information, while keeping
+the original hypotheses. A possible alternative would have been something like
+[CombineSepAsGives P1 P2 P R := combine_as_gives : P1 ∗ P2 ⊢ P ∗ □ R],
+but this was deemed to be harder to use. Specifically, this would force you to
+always specify both [P] and [R], even though one might only have a good
+candidate for [P], but not [R], or the other way around.
+
+Note that [FromSep] and [CombineSepAs] have nearly the same definition. However,
+they have different Hint Modes and are used for different tactics. [FromSep] is
+used to compute the two new goals obtained after applying [iSplitL]/[iSplitR],
+taking the current goal as input. [CombineSepAs] is used to combine two
+hypotheses into one.
+
+In terms of costs, note that the [AsFractional] instance for [CombineSepAs]
+has cost 50. If that instance should take priority over yours, make sure to use
+a higher cost. *)
+Class CombineSepAs {PROP : bi} (P Q R : PROP) := combine_sep_as : P ∗ Q ⊢ R.
+Global Arguments CombineSepAs {_} _%_I _%_I _%_I : simpl never.
+Global Arguments combine_sep_as {_} _%_I _%_I _%_I {_}.
+Global Hint Mode CombineSepAs + ! ! - : typeclass_instances.
+
+(** The [progress] parameter is of the following [progress_indicator] type: *)
+Inductive progress_indicator := MadeProgress | NoProgress.
+(** This aims to make [MaybeCombineSepAs] instances easier to read than if we
+had used Booleans. [NoProgress] indicates that the default instance
+[maybe_combine_sep_as_default] below has been used, while [MadeProgress]
+indicates that a [CombineSepAs] instance was used. *)
+Class MaybeCombineSepAs {PROP : bi}
+    (P Q R : PROP) (progress : progress_indicator) :=
+  maybe_combine_sep_as : P ∗ Q ⊢ R.
+Global Arguments MaybeCombineSepAs {_} _%_I _%_I _%_I _ : simpl never.
+Global Arguments maybe_combine_sep_as {_} _%_I _%_I _%_I _ {_}.
+Global Hint Mode MaybeCombineSepAs + ! ! - - : typeclass_instances.
+
+Global Instance maybe_combine_sep_as_combine_sep_as {PROP : bi} (R P Q : PROP) :
+  CombineSepAs P Q R → MaybeCombineSepAs P Q R MadeProgress | 20.
+Proof. done. Qed.
+
+Global Instance maybe_combine_sep_as_default {PROP : bi} (P Q : PROP) :
+  MaybeCombineSepAs P Q (P ∗ Q) NoProgress | 100.
+Proof. intros. by rewrite /MaybeCombineSepAs. Qed.
+
+(** We do not have this Maybe construction for [CombineSepGives], nor do we
+provide the trivial [CombineSepGives P Q True]. This is by design: when the user
+writes down a 'gives' clause in the [iCombine] tactic, they intend to receive
+non-trivial information. If such information cannot be found, we want to
+produce an error, instead of the trivial hypothesis [True]. *)
+Class CombineSepGives {PROP : bi} (P Q R : PROP) :=
+  combine_sep_gives : P ∗ Q ⊢ <pers> R.
+Global Arguments CombineSepGives {_} _%_I _%_I _%_I : simpl never.
+Global Arguments combine_sep_gives {_} _%_I _%_I _%_I {_}.
+Global Hint Mode CombineSepGives + ! ! - : typeclass_instances.
+
+(** The [ElimModal φ p p' P P' Q Q'] class is used by the [iMod] tactic.
+
+The inputs are [p], [P] and [Q], and the outputs are [φ], [p'], [P'] and [Q'].
+
+The class is used to transform a hypothesis [P] into a hypothesis [P'], given
+a goal [Q], which is simultaneously transformed into [Q']. The Booleans [p]
+and [p'] indicate whether the original, respectively, updated hypothesis reside
+in the persistent context (iff [true]). The proposition [φ] can be used to
+express a side-condition that [iMod] will generate (if not [True]).
+
+An example instance is:
+
+  ElimModal True p false (|={E1,E2}=> P) P (|={E1,E3}=> Q) (|={E2,E3}=> Q).
+
+This instance expresses that to eliminate [|={E1,E2}=> P] the goal is
+transformed from [|={E1,E3}=> Q] into [|={E2,E3}=> Q], and the resulting
+hypothesis is moved into the spatial context (regardless of where it was
+originally). A corresponding [ElimModal] instance for the Iris 1/2-style update
+modality, would have a side-condition [φ] on the masks. *)
+Class ElimModal {PROP : bi} (φ : Prop) (p p' : bool) (P P' : PROP) (Q Q' : PROP) :=
+  elim_modal : φ → □?p P ∗ (□?p' P' -∗ Q') ⊢ Q.
+Global Arguments ElimModal {_} _ _ _ _%_I _%_I _%_I _%_I : simpl never.
+Global Arguments elim_modal {_} _ _ _ _%_I _%_I _%_I _%_I {_}.
+Global Hint Mode ElimModal + - ! - ! - ! - : typeclass_instances.
+
+(* Used by the specialization pattern [ > ] in [iSpecialize] and [iAssert] to
+add a modality to the goal corresponding to a premise/asserted proposition. *)
+Class AddModal {PROP : bi} (P P' : PROP) (Q : PROP) :=
+  add_modal : P ∗ (P' -∗ Q) ⊢ Q.
+Global Arguments AddModal {_} _%_I _%_I _%_I : simpl never.
+Global Arguments add_modal {_} _%_I _%_I _%_I {_}.
+Global Hint Mode AddModal + - ! ! : typeclass_instances.
+
+Lemma add_modal_id {PROP : bi} (P Q : PROP) : AddModal P P Q.
+Proof. by rewrite /AddModal wand_elim_r. Qed.
+
+(** We use the classes [IsCons] and [IsApp] to make sure that instances such as
+[frame_big_sepL_cons] and [frame_big_sepL_app] cannot be applied repeatedly
+often when having [ [∗ list] k ↦ x ∈ ?e, Φ k x] with [?e] an evar. *)
+Class IsCons {A} (l : list A) (x : A) (k : list A) := is_cons : l = x :: k.
+Class IsApp {A} (l k1 k2 : list A) := is_app : l = k1 ++ k2.
+Global Hint Mode IsCons + ! - - : typeclass_instances.
+Global Hint Mode IsApp + ! - - : typeclass_instances.
+
+Global Instance is_cons_cons {A} (x : A) (l : list A) : IsCons (x :: l) x l.
+Proof. done. Qed.
+Global Instance is_app_app {A} (l1 l2 : list A) : IsApp (l1 ++ l2) l1 l2.
+Proof. done. Qed.
+
+(** [IsDisjUnion] is similar to [IsCons] and [IsApp] but identifies the
+[disj_union] operator. *)
+Class IsDisjUnion `{DisjUnion A} (X X1 X2 : A) := is_disj_union : X = X1 ⊎ X2.
+Global Hint Mode IsDisjUnion + + ! - - : typeclass_instances.
+
+Global Instance is_disj_union_disj_union `{DisjUnion A} (X1 X2 : A) :
+  IsDisjUnion (X1 ⊎ X2) X1 X2.
+Proof. done. Qed.
+
+Class Frame {PROP : bi} (p : bool) (R P Q : PROP) := frame : □?p R ∗ Q ⊢ P.
+Global Arguments Frame {_} _ _%_I _%_I _%_I.
+Global Arguments frame {_} _ _%_I _%_I _%_I {_}.
+Global Hint Mode Frame + + ! ! - : typeclass_instances.
+
+(* The boolean [progress] indicates whether actual framing has been performed.
+If it is [false], then the default instance [maybe_frame_default] below has been
+used.
+[MaybeFrame'] instances should generally _not_ be used directly---instead, use
+the [MaybeFrame] notation defined below. *)
+Class MaybeFrame' {PROP : bi} (p : bool) (R P Q : PROP) (progress : bool) :=
+  maybe_frame : □?p R ∗ Q ⊢ P.
+Global Arguments MaybeFrame' {_} _ _%_I _%_I _%_I _.
+Global Arguments maybe_frame {_} _ _%_I _%_I _%_I _ {_}.
+Global Hint Mode MaybeFrame' + + ! - - - : typeclass_instances.
+
+Global Instance maybe_frame_frame {PROP : bi} p (R P Q : PROP) :
+  Frame p R P Q → MaybeFrame' p R P Q true.
+Proof. done. Qed.
+
+Global Instance maybe_frame_default_persistent {PROP : bi} (R P : PROP) :
+  MaybeFrame' true R P P false | 100.
+Proof. intros. rewrite /MaybeFrame' /=. by rewrite sep_elim_r. Qed.
+Global Instance maybe_frame_default {PROP : bi} (R P : PROP) :
+  TCOr (Affine R) (Absorbing P) → MaybeFrame' false R P P false | 100.
+Proof. intros. rewrite /MaybeFrame' /=. apply: sep_elim_r. Qed.
+
+(* We never want to backtrack on instances of [MaybeFrame']. We provide
+a notation for [MaybeFrame'] wrapped in the [TCNoBackTrack] construct.
+For more details, see also iris!989 and the [frame_and] and [frame_or_spatial]
+instances in [class_instances_frame.v] *)
+Notation MaybeFrame p R P Q progress := (TCNoBackTrack (MaybeFrame' p R P Q progress)).
+
+(* The [iFrame] tactic is able to instantiate witnesses for existential
+quantifiers. We need a way to disable this behavior beneath connectives
+like [∀], [-∗] and [→], since it is often unwanted in these cases.
+Also see iris#565.
+
+We implement this using two (notations for) type classes:
+[FrameInstantiateExistDisabled] and [FrameInstantiateExistEnabled]. These are
+essentially 'flags' for type class search, and do not carry any information:
+[FrameInstantiateExistDisabled] is equivalent to [True], but does not come with
+any instances. Recursive [Frame] instances can disable instantiating
+existentials in their recursive search by replacing the recursive [Frame ...]
+premise with [(FrameInstantiateExistDisabled → Frame ...)]. This explicitly
+adds a [FrameInstantiateExistDisabled] hypothesis to the recursive [Frame]
+search, causing [FrameInstantiateExistDisabled] to have instances in that
+recursive search. This will disable the 'strong' instance that instantiates
+existential quantifiers, and instead enable a weaker instance that looks
+for a [Frame] that works for all possible instantiations. The weaker is enabled
+since we made [FrameInstantiateExistDisabled] one of its premises. *)
+Class FrameInstantiateExistDisabled : Prop := frame_instantiate_exist_disabled {}.
+(* The strong instance also has a new premise: an instance of
+the [FrameInstantiateExistEnabled] type class, defined using stdpp's [TCUnless]. *)
+Notation FrameInstantiateExistEnabled := (TCUnless FrameInstantiateExistDisabled).
+(* Since [TCUnless P] will only find an instance if no instance of [P] can be
+found, the addition of [FrameInstantiateExistDisabled] to the context disables
+the instantiation of existential quantifiers. *)
+
+Class IntoExcept0 {PROP : bi} (P Q : PROP) := into_except_0 : P ⊢ ◇ Q.
+Global Arguments IntoExcept0 {_} _%_I _%_I : simpl never.
+Global Arguments into_except_0 {_} _%_I _%_I {_}.
+Global Hint Mode IntoExcept0 + ! - : typeclass_instances.
+Global Hint Mode IntoExcept0 + - ! : typeclass_instances.
+
+(* The class [MaybeIntoLaterN] has only two instances:
+
+- The default instance [MaybeIntoLaterN n P P], i.e. [▷^n P -∗ P]
+- The instance [IntoLaterN n P Q → MaybeIntoLaterN n P Q], where [IntoLaterN]
+  is identical to [MaybeIntoLaterN], but is supposed to make progress, i.e. it
+  should actually strip a later.
+
+The point of using the auxilary class [IntoLaterN] is to ensure that the
+default instance is not applied deeply inside a term, which may result in too
+many definitions being unfolded (see issue #55).
+
+For binary connectives we have the following instances:
+
+<<
+IntoLaterN n P P'       MaybeIntoLaterN n Q Q'
+------------------------------------------
+     IntoLaterN n (P /\ Q) (P' /\ Q')
+
+
+      IntoLaterN n Q Q'
+-------------------------------
+IntoLaterN n (P /\ Q) (P /\ Q')
+>>
+
+The Boolean [only_head] indicates whether laters should only be stripped in
+head position or also below other logical connectives. For [iNext] it should
+strip laters below other logical connectives, but this should not happen while
+framing, e.g. the following should succeed:
+
+<<
+Lemma test_iFrame_later_1 P Q : P ∗ ▷ Q -∗ ▷ (P ∗ ▷ Q).
+Proof. iIntros "H". iFrame "H". Qed.
+>>
+*)
+Class MaybeIntoLaterN {PROP : bi} (only_head : bool) (n : nat) (P Q : PROP) :=
+  maybe_into_laterN : P ⊢ ▷^n Q.
+Global Arguments MaybeIntoLaterN {_} _ _%_nat_scope _%_I _%_I.
+Global Arguments maybe_into_laterN {_} _ _%_nat_scope _%_I _%_I {_}.
+Global Hint Mode MaybeIntoLaterN + + + - - : typeclass_instances.
+
+Class IntoLaterN {PROP : bi} (only_head : bool) (n : nat) (P Q : PROP) :=
+  #[global] into_laterN :: MaybeIntoLaterN only_head n P Q.
+Global Arguments IntoLaterN {_} _ _%_nat_scope _%_I _%_I.
+Global Hint Mode IntoLaterN + + + ! - : typeclass_instances.
+
+Global Instance maybe_into_laterN_default {PROP : bi} only_head n (P : PROP) :
+  MaybeIntoLaterN only_head n P P | 1000.
+Proof. apply laterN_intro. Qed.
+(* In the case both parameters are evars and n=0, we have to stop the
+   search and unify both evars immediately instead of looping using
+   other instances. *)
+Global Instance maybe_into_laterN_default_0 {PROP : bi} only_head (P : PROP) :
+  MaybeIntoLaterN only_head 0 P P | 0.
+Proof. apply _. Qed.
+
+(** The class [IntoEmbed P Q] is used to transform hypotheses while introducing
+embeddings using [iModIntro].
+
+Input: the proposition [P], output: the proposition [Q] so that [P ⊢ ⎡Q⎤]. *)
+Class IntoEmbed {PROP PROP' : bi} `{BiEmbed PROP PROP'} (P : PROP') (Q : PROP) :=
+  into_embed : P ⊢ ⎡Q⎤.
+Global Arguments IntoEmbed {_ _ _} _%_I _%_I.
+Global Arguments into_embed {_ _ _} _%_I _%_I {_}.
+Global Hint Mode IntoEmbed + + + ! -  : typeclass_instances.
+
+(* We use two type classes for [AsEmpValid], in order to avoid loops in
+   typeclass search. Indeed, the [as_emp_valid_embed] instance would try
+   to add an arbitrary number of embeddings. To avoid this, the
+   [AsEmpValid0] type class cannot handle embeddings, and therefore
+   [as_emp_valid_embed] only tries to add one embedding, and we never try
+   to insert nested embeddings. This has the additional advantage of
+   always trying [as_emp_valid_embed] as a second option, so that this
+   instance is never used when the BI is unknown.
+
+   No Hint Modes are declared here. The appropriate one would be
+   [Hint Mode - + ! -], but the fact that Coq ignores primitive
+   projections for hints modes would make this fail.
+
+   The direction [d] specifies whether [φ] can be converted to resp. from [⊢ P].
+   [iPoseProof] requires [AsEmpValid DirectionIntoEmpValid], while [iStartProof]
+   requires [AsEmpValid DirectionFromEmpValid]. We nevertheless use a single
+   type class to represent both directions since most instances can be parametric
+   in the direction.
+*)
+Inductive as_emp_valid_direction :=
+  | DirectionIntoEmpValid
+  | DirectionFromEmpValid.
+
+(** We define [AsEmpValid] using a conjunction (instead of a [match] or a record
+with two fields) to make it possible to "unfold" [AsEmpValid] and handle both
+directions in a uniform manner (e.g., using [rewrite]).
+See [as_emp_valid_tforall] for an example. *)
+Class AsEmpValid {PROP : bi} (d : as_emp_valid_direction) (φ : Prop) (P : PROP) :=
+  as_emp_valid : (d = DirectionIntoEmpValid → φ → ⊢ P) ∧
+                 (d = DirectionFromEmpValid → (⊢ P) → φ).
+Global Arguments AsEmpValid {_} _ _%_type _%_I.
+Class AsEmpValid0 {PROP : bi} (d : as_emp_valid_direction) (φ : Prop) (P : PROP) :=
+  as_emp_valid_0 : AsEmpValid d φ P.
+Global Arguments AsEmpValid0 {_} _ _%_type _%_I.
+Global Existing Instance as_emp_valid_0 | 0.
+
+Lemma as_emp_valid_1 (φ : Prop) {PROP : bi} (P : PROP)
+    `{!AsEmpValid DirectionIntoEmpValid φ P} :
+  φ → ⊢ P.
+Proof. by apply as_emp_valid. Qed.
+Lemma as_emp_valid_2 (φ : Prop) {PROP : bi} (P : PROP)
+    `{!AsEmpValid DirectionFromEmpValid φ P} :
+  (⊢ P) → φ.
+Proof. by apply as_emp_valid. Qed.
+
+(* Input: [P]; Outputs: [N],
+   Extracts the namespace associated with an invariant assertion. Used for [iInv]. *)
+Class IntoInv {PROP : bi} (P: PROP) (N: namespace).
+Global Arguments IntoInv {_} _%_I _.
+Global Hint Mode IntoInv + ! - : typeclass_instances.
+
+(** Accessors.
+    This definition only exists for the purpose of the proof mode; a truly
+    usable and general form would use telescopes and also allow binders for the
+    closing view shift.  [γ] is an [option] to make it easy for ElimAcc
+    instances to recognize the [emp] case and make it look nicer. *)
+Definition accessor {PROP : bi} {X : Type} (M1 M2 : PROP → PROP)
+           (α β : X → PROP) (mγ : X → option PROP) : PROP :=
+  M1 (∃ x, α x ∗ (β x -∗ M2 (default emp (mγ x))))%I.
+
+(* Typeclass for assertions around which accessors can be eliminated.
+   Inputs: [Q], [E1], [E2], [α], [β], [γ]
+   Outputs: [Q'], [φ]
+
+   Elliminates an accessor [accessor E1 E2 α β γ] in goal [Q'], turning the goal
+   into [Q'] with a new assumption [α x], where [φ] is a side-condition at the
+   Cow level that needs to hold. *)
+Class ElimAcc {PROP : bi} {X : Type} (φ : Prop) (M1 M2 : PROP → PROP)
+      (α β : X → PROP) (mγ : X → option PROP)
+      (Q : PROP) (Q' : X → PROP) :=
+  elim_acc : φ → ((∀ x, α x -∗ Q' x) -∗ accessor M1 M2 α β mγ -∗ Q).
+Global Arguments ElimAcc {_} {_} _ _%_I _%_I _%_I _%_I _%_I _%_I : simpl never.
+Global Arguments elim_acc {_} {_} _ _%_I _%_I _%_I _%_I _%_I _%_I {_}.
+Global Hint Mode ElimAcc + ! - ! ! ! ! ! ! - : typeclass_instances.
+
+(* Turn [P] into an accessor.
+   Inputs:
+   - [Pacc]: the assertion to be turned into an accessor (e.g. an invariant)
+   Outputs:
+   - [Pin]: additional logic assertion needed for starting the accessor.
+   - [φ]: additional Coq assertion needed for starting the accessor.
+   - [X] [α], [β], [γ]: the accessor parameters.
+   - [M1], [M2]: the two accessor modalities (they will typically still have
+     some evars though, e.g. for the masks)
+*)
+Class IntoAcc {PROP : bi} {X : Type} (Pacc : PROP) (φ : Prop) (Pin : PROP)
+      (M1 M2 : PROP → PROP) (α β : X → PROP) (mγ : X → option PROP) :=
+  into_acc : φ → Pacc -∗ Pin -∗ accessor M1 M2 α β mγ.
+Global Arguments IntoAcc {_} {_} _%_I _ _%_I _%_I _%_I _%_I _%_I _%_I : simpl never.
+Global Arguments into_acc {_} {_} _%_I _ _%_I _%_I _%_I _%_I _%_I _%_I {_} : simpl never.
+Global Hint Mode IntoAcc + - ! - - - - - - - : typeclass_instances.
+
+(* The typeclass used for the [iInv] tactic.
+   Input: [Pinv]
+   Other Arguments:
+   - [Pinv] is an invariant assertion
+   - [Pin] is an additional logic assertion needed for opening an invariant
+   - [φ] is an additional Coq assertion needed for opening an invariant
+   - [Pout] is the assertion obtained by opening the invariant
+   - [Pclose] is the closing view shift.  It must be (Some _) or None
+     when doing typeclass search as instances are allowed to make a
+     case distinction on whether the user wants a closing view-shift or not.
+   - [Q] is a goal on which iInv may be invoked
+   - [Q'] is the transformed goal that must be proved after opening the invariant.
+
+   Most users will never want to instantiate this; there is a general instance
+   based on [ElimAcc] and [IntoAcc].  However, logics like Iris 2 that support
+   invariants but not mask-changing fancy updates can use this class directly to
+   still benefit from [iInv].
+*)
+Class ElimInv {PROP : bi} {X : Type} (φ : Prop)
+      (Pinv Pin : PROP) (Pout : X → PROP) (mPclose : option (X → PROP))
+      (Q : PROP) (Q' : X → PROP) :=
+  elim_inv : φ → Pinv ∗ Pin ∗ (∀ x, Pout x ∗ (default (λ _, emp) mPclose) x -∗ Q' x) ⊢ Q.
+Global Arguments ElimInv {_} {_} _ _%_I _%_I _%_I _%_I _%_I _%_I : simpl never.
+Global Arguments elim_inv {_} {_} _ _%_I _%_I _%_I _%_I _%_I _%_I {_}.
+Global Hint Mode ElimInv + - - ! - - ! ! - : typeclass_instances.
+
+(** We make sure that tactics that perform actions on *specific* hypotheses or
+parts of the goal look through the [tc_opaque] connective, which is used to make
+definitions opaque for type class search. For example, when using [iDestruct],
+an explicit hypothesis is affected, and as such, we should look through opaque
+definitions. However, when using [iFrame] or [iNext], arbitrary hypotheses or
+parts of the goal are affected, and as such, type class opacity should be
+respected.
+
+This means that there are [tc_opaque] instances for all proofmode type classes
+with the exception of:
+
+- [FromAssumption] used by [iAssumption]
+- [Frame] and [MaybeFrame] used by [iFrame]
+- [MaybeIntoLaterN] and [FromLaterN] used by [iNext]
+- [IntoPersistent] used by [iIntuitionistic]
+*)
+Global Instance into_pure_tc_opaque {PROP : bi} (P : PROP) φ :
+  IntoPure P φ → IntoPure (tc_opaque P) φ := id.
+Global Instance from_pure_tc_opaque {PROP : bi} (a : bool) (P : PROP) φ :
+  FromPure a P φ → FromPure a (tc_opaque P) φ := id.
+Global Instance from_wand_tc_opaque {PROP : bi} (P Q1 Q2 : PROP) :
+  FromWand P Q1 Q2 → FromWand (tc_opaque P) Q1 Q2 := id.
+Global Instance into_wand_tc_opaque {PROP : bi} p q (R P Q : PROP) :
+  IntoWand p q R P Q → IntoWand p q (tc_opaque R) P Q := id.
+
+(* This instance has a very high cost. The tactic [iCombine] will look for
+[FromSep ?P Q1 Q2]. If the cost of this instance is low (and in particular,
+lower than the default instance [from_sep_sep], which picks [?P := Q1 * Q2]),
+then TC search would diverge. *)
+Global Instance from_sep_tc_opaque {PROP : bi} (P Q1 Q2 : PROP) :
+  FromSep P Q1 Q2 → FromSep (tc_opaque P) Q1 Q2 | 102 := id.
+
+Global Instance from_and_tc_opaque {PROP : bi} (P Q1 Q2 : PROP) :
+  FromAnd P Q1 Q2 → FromAnd (tc_opaque P) Q1 Q2 := id.
+Global Instance into_and_tc_opaque {PROP : bi} p (P Q1 Q2 : PROP) :
+  IntoAnd p P Q1 Q2 → IntoAnd p (tc_opaque P) Q1 Q2 := id.
+Global Instance into_sep_tc_opaque {PROP : bi} (P Q1 Q2 : PROP) :
+  IntoSep P Q1 Q2 → IntoSep (tc_opaque P) Q1 Q2 := id.
+Global Instance from_or_tc_opaque {PROP : bi} (P Q1 Q2 : PROP) :
+  FromOr P Q1 Q2 → FromOr (tc_opaque P) Q1 Q2 := id.
+Global Instance into_or_tc_opaque {PROP : bi} (P Q1 Q2 : PROP) :
+  IntoOr P Q1 Q2 → IntoOr (tc_opaque P) Q1 Q2 := id.
+Global Instance from_exist_tc_opaque {PROP : bi} {A} (P : PROP) (Φ : A → PROP) :
+  FromExist P Φ → FromExist (tc_opaque P) Φ := id.
+Global Instance into_exist_tc_opaque {PROP : bi} {A} (P : PROP) (Φ : A → PROP) (name: ident_name) :
+  IntoExist P Φ name → IntoExist (tc_opaque P) Φ name := id.
+Global Instance from_forall_tc_opaque {PROP : bi} {A} (P : PROP) (Φ : A → PROP) (name : ident_name) :
+  FromForall P Φ name → FromForall (tc_opaque P) Φ name := id.
+Global Instance into_forall_tc_opaque {PROP : bi} {A} (P : PROP) (Φ : A → PROP) :
+  IntoForall P Φ → IntoForall (tc_opaque P) Φ := id.
+Global Instance from_modal_tc_opaque {PROP1 PROP2 : bi} {A}
+    φ M (sel : A) (P : PROP2) (Q : PROP1) :
+  FromModal φ M sel P Q → FromModal φ M sel (tc_opaque P) Q := id.
+Global Instance elim_modal_tc_opaque {PROP : bi} φ p p' (P P' Q Q' : PROP) :
+  ElimModal φ p p' P P' Q Q' → ElimModal φ p p' (tc_opaque P) P' Q Q' := id.
+Global Instance into_inv_tc_opaque {PROP : bi} (P : PROP) N :
+  IntoInv P N → IntoInv (tc_opaque P) N := id.
+Global Instance elim_inv_tc_opaque {PROP : bi} {X} φ Pinv Pin Pout Pclose Q Q' :
+  ElimInv (PROP:=PROP) (X:=X) φ Pinv Pin Pout Pclose Q Q' →
+  ElimInv φ (tc_opaque Pinv) Pin Pout Pclose Q Q' := id.