theories/program_logic/ectxi_language.v → 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.algebra Require Export base.
+From iris.prelude Require Export prelude.
 From iris.program_logic Require Import language ectx_language.
-Set Default Proof Using "Type".
+From iris.prelude Require Import options.
 
-(* TAKE CARE: When you define an [ectxiLanguage] canonical structure for your
+(** 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
@@ -17,7 +17,7 @@ Below you can find the relevant parts:
   Module heap_lang.
     (* Your language definition *)
 
-    Lemma heap_lang_mixin : EctxiLanguageMixin of_val to_val fill_item head_step.
+    Lemma heap_lang_mixin : EctxiLanguageMixin of_val to_val fill_item base_step.
     Proof. (* ... *) Qed.
   End heap_lang.
 
@@ -31,21 +31,29 @@ Section ectxi_language_mixin.
   Context (of_val : val → expr).
   Context (to_val : expr → option val).
   Context (fill_item : ectx_item → expr → expr).
-  Context (head_step : expr → state → list observation → expr → state → list expr → Prop).
+  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 : head_step e1 σ1 κ e2 σ2 efs → to_val e1 = None;
+    mixin_val_stuck e1 σ1 κ e2 σ2 efs : base_step e1 σ1 κ e2 σ2 efs → to_val e1 = None;
 
-    mixin_fill_item_inj Ki : Inj (=) (=) (fill_item Ki);
     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;
 
-    mixin_head_ctx_step_val Ki e σ1 κ e2 σ2 efs :
-      head_step (fill_item Ki e) σ1 κ e2 σ2 efs → is_Some (to_val e);
+    (** 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.
 
@@ -59,17 +67,20 @@ Structure ectxiLanguage := EctxiLanguage {
   of_val : val → expr;
   to_val : expr → option val;
   fill_item : ectx_item → expr → expr;
-  head_step : expr → state → list observation → expr → state → list expr → Prop;
+  base_step : expr → state → list observation → expr → state → list expr → Prop;
 
   ectxi_language_mixin :
-    EctxiLanguageMixin of_val to_val fill_item head_step
+    EctxiLanguageMixin of_val to_val fill_item base_step
 }.
 
-Arguments EctxiLanguage {_ _ _ _ _ _ _ _ _} _.
-Arguments of_val {_} _%V.
-Arguments to_val {_} _%E.
-Arguments fill_item {_} _ _%E.
-Arguments head_step {_} _%E _ _ _%E _ _.
+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}.
@@ -85,8 +96,8 @@ Section ectxi_language.
     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 head_ctx_step_val Ki e σ1 κ e2 σ2 efs :
-    head_step (fill_item Ki e) σ1 κ e2 σ2 efs → is_Some (to_val e).
+  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.
@@ -95,7 +106,7 @@ Section ectxi_language.
   Proof. apply foldl_app. Qed.
 
   Definition ectxi_lang_ectx_mixin :
-    EctxLanguageMixin of_val to_val [] (flip (++)) fill head_step.
+    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. }
@@ -109,18 +120,21 @@ Section ectxi_language.
     - intros K1 K2 e. by rewrite /fill /= foldl_app.
     - intros K; induction K as [|Ki K IH]; rewrite /Inj; naive_solver.
     - done.
-    - by intros [] [].
     - 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 head_ctx_step_val in Hstep.
+      { 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_head_stuck.
+      { 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.
@@ -141,13 +155,14 @@ Section ectxi_language.
   Proof. change (LanguageCtx (fill [Ki])). apply _. Qed.
 End ectxi_language.
 
-Arguments fill {_} _ _%E.
-Arguments ectxi_lang_ectx : clear implicits.
-Arguments ectxi_lang : clear implicits.
+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 head mix := Λ in
+  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 head mix)).
+    (@ectxi_lang_ectx_mixin (@EctxiLanguage E V C St K of_val to_val fill base mix)).
+
+Global Arguments EctxLanguageOfEctxi : simpl never.

theories/program_logic/language.v → iris/program_logic/language.v

 From iris.algebra Require Export ofe.
-Set Default Proof Using "Type".
+From iris.bi Require Export weakestpre.
+From iris.prelude Require Import options.
 
 Section language_mixin.
   Context {expr val state observation : Type}.
@@ -27,19 +28,18 @@ Structure language := Language {
   prim_step : expr → state → list observation → expr → state → list expr → Prop;
   language_mixin : LanguageMixin of_val to_val prim_step
 }.
-Delimit Scope expr_scope with E.
-Delimit Scope val_scope with V.
+
 Bind Scope expr_scope with expr.
 Bind Scope val_scope with val.
 
-Arguments Language {_ _ _ _ _ _ _} _.
-Arguments of_val {_} _.
-Arguments to_val {_} _.
-Arguments prim_step {_} _ _ _ _ _ _.
+Global Arguments Language {_ _ _ _ _ _ _} _.
+Global Arguments of_val {_} _.
+Global Arguments to_val {_} _.
+Global Arguments prim_step {_} _ _ _ _ _ _.
 
-Canonical Structure stateC Λ := leibnizC (state Λ).
-Canonical Structure valC Λ := leibnizC (val Λ).
-Canonical Structure exprC Λ := leibnizC (expr Λ).
+Canonical Structure stateO Λ := leibnizO (state Λ).
+Canonical Structure valO Λ := leibnizO (val Λ).
+Canonical Structure exprO Λ := leibnizO (expr Λ).
 
 Definition cfg (Λ : language) := (list (expr Λ) * state Λ)%type.
 
@@ -54,11 +54,14 @@ Class LanguageCtx {Λ : language} (K : expr Λ → expr Λ) := {
     ∃ e2', e2 = K e2' ∧ prim_step e1' σ1 κ e2' σ2 efs
 }.
 
-Instance language_ctx_id Λ : LanguageCtx (@id (expr Λ)).
+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 Λ.
@@ -80,6 +83,8 @@ Section language.
     ∀ κ 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
@@ -103,7 +108,7 @@ Section language.
        ρ2 = (t1 ++ e2 :: t2 ++ efs, σ2) →
        prim_step e1 σ1 κ e2 σ2 efs →
        step ρ1 κ ρ2.
-  Hint Constructors step : core.
+  Local Hint Constructors step : core.
 
   Inductive nsteps : nat → cfg Λ → list (observation Λ) → cfg Λ → Prop :=
     | nsteps_refl ρ :
@@ -112,15 +117,19 @@ Section language.
        step ρ1 κ ρ2 →
        nsteps n ρ2 κs ρ3 →
        nsteps (S n) ρ1 (κ ++ κs) ρ3.
-  Hint Constructors nsteps : core.
+  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.
+    rtc erased_step ρ1 ρ2 ↔ ∃ n κs, nsteps n ρ1 κs ρ2.
   Proof.
-    induction 1; firstorder; eauto. (* FIXME: [naive_solver eauto] should be able to handle this *)
+    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.
@@ -136,18 +145,29 @@ Section language.
   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.
@@ -155,18 +175,45 @@ Section language.
   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.
+    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.
@@ -180,6 +227,8 @@ Section language.
       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 Λ) :=
@@ -200,7 +249,11 @@ Section language.
   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. induction 1; econstructor; eauto using pure_step_ctx. Qed.
+  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 :
@@ -220,7 +273,62 @@ Section language.
     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)).

theories/program_logic/lifting.v → 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.proofmode Require Import tactics.
-Set Default Proof Using "Type".
+From iris.prelude Require Import options.
 
 Section lifting.
-Context `{!irisG Λ Σ}.
+Context `{!irisGS_gen hlc Λ Σ}.
 Implicit Types s : stuckness.
 Implicit Types v : val Λ.
 Implicit Types e : expr Λ.
@@ -11,29 +14,46 @@ Implicit Types σ : state Λ.
 Implicit Types P Q : iProp Σ.
 Implicit Types Φ : val Λ → iProp Σ.
 
-Hint Resolve reducible_no_obs_reducible : core.
+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 κ κs n, state_interp σ1 (κ ++ κs) n ={E,∅}=∗
+  (∀ σ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⌝ ={∅,∅,E}▷=∗
-      state_interp σ2 κs (length efs + n) ∗
+    ∀ 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.
-  rewrite wp_unfold /wp_pre=>->. iIntros "H" (σ1 κ κs n) "Hσ".
-  iMod ("H" with "Hσ") as "(%&H)". iModIntro. iSplit. by destruct s.
-  iIntros (????). iApply "H". eauto.
+  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 →
-  (∀ σ κs n, state_interp σ κs n ={E,∅}=∗ ⌜stuck e σ⌝)
+  (∀ σ ns κs nt, state_interp σ ns κs nt ={E,∅}=∗ ⌜stuck e σ⌝)
   ⊢ WP e @ E ?{{ Φ }}.
 Proof.
-  rewrite wp_unfold /wp_pre=>->. iIntros "H" (σ1 κ κs n) "Hσ".
+  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.
@@ -41,33 +61,34 @@ Qed.
 (** Derived lifting lemmas. *)
 Lemma wp_lift_step s E Φ e1 :
   to_val e1 = None →
-  (∀ σ1 κ κs n, state_interp σ1 (κ ++ κs) n ={E,∅}=∗
+  (∀ σ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⌝ ={∅,E}=∗
-      state_interp σ2 κs (length efs + n) ∗
+    ▷ ∀ 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 "!> * % !> !>". by iApply "H".
+  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⌝ → WP e2 @ s; E {{ Φ }})
+  (|={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 κ κs n) "Hσ". iMod "H".
-  iMod fupd_intro_mask' as "Hclose"; last iModIntro; first by set_solver. iSplit.
+  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 ?).
+  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.
-  iDestruct ("H" with "[//]") as "H". simpl. iFrame.
+  by iDestruct ("H" with "[//] Hcred") as "$".
 Qed.
 
 Lemma wp_lift_pure_stuck `{!Inhabited (state Λ)} E Φ e :
@@ -77,28 +98,28 @@ Proof.
   iIntros (Hstuck) "_". iApply wp_lift_stuck.
   - destruct(to_val e) as [v|] eqn:He; last done.
     rewrite -He. by case: (Hstuck inhabitant).
-  - iIntros (σ κs n) "_". by iMod (fupd_intro_mask' E ∅) as "_"; first set_solver.
+  - 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 κ κs n, state_interp σ1 (κ ++ κs) n ={E1}=∗
+  (∀ σ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⌝ ={E1,E2}▷=∗
-      state_interp σ2 κs (length efs + n) ∗
+    ∀ 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 κ κs n) "Hσ1".
+  iApply (wp_lift_step_fupd s E1 _ e1)=>//; iIntros (σ1 ns κ κs nt) "Hσ1".
   iMod ("H" $! σ1 with "Hσ1") as "[$ H]".
-  iMod (fupd_intro_mask' E1 ∅) as "Hclose"; first set_solver.
-  iIntros "!>" (e2 σ2 efs ?). iMod "Hclose" as "_".
-  iMod ("H" $! e2 σ2 efs with "[#]") as "H"; [done|].
-  iMod (fupd_intro_mask' E2 ∅) as "Hclose"; [set_solver|]. iIntros "!> !>".
+  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.
@@ -106,17 +127,17 @@ Qed.
 
 Lemma wp_lift_atomic_step {s E Φ} e1 :
   to_val e1 = None →
-  (∀ σ1 κ κs n, state_interp σ1 (κ ++ κs) n ={E}=∗
+  (∀ σ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⌝ ={E}=∗
-      state_interp σ2 κs (length efs + n) ∗
+    ▷ ∀ 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) "!> !>".
+  iIntros (?????) "?". iMod ("H" with "[$]") as "[$ H]".
+  iIntros "!> *". iIntros (Hstep) "Hcred !> !>".
   by iApply "H".
 Qed.
 
@@ -124,7 +145,7 @@ 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'}▷=> WP e2 @ s; E {{ Φ }}) ⊢ WP e1 @ s; E {{ Φ }}.
+  (|={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. }
@@ -135,22 +156,28 @@ Qed.
 Lemma wp_pure_step_fupd `{!Inhabited (state Λ)} s E E' e1 e2 φ n Φ :
   PureExec φ n e1 e2 →
   φ →
-  (|={E,E'}▷=>^n WP e2 @ s; E {{ Φ }}) ⊢ WP e1 @ s; E {{ Φ }}.
+  (|={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; first done.
+  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.
-  - by iApply (step_fupd_wand with "Hwp").
+  - 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 WP e2 @ s; E {{ Φ }} ⊢ WP e1 @ s; E {{ Φ }}.
+  ▷^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.

theories/program_logic/ownp.v → 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.algebra Require Import auth.
-From iris.proofmode Require Import tactics classes.
-Set Default Proof Using "Type".
+From iris.prelude Require Import options.
 
 (**
 This module provides an interface to handling ownership of the global state that
@@ -14,86 +14,93 @@ a more interesting notion of ownership, such as the standard heap with disjoint
 union.
 *)
 
-Class ownPG (Λ : language) (Σ : gFunctors) := OwnPG {
-  ownP_invG : invG Σ;
-  ownP_inG :> inG Σ (authR (optionUR (exclR (stateC Λ))));
+Class ownPGS (Λ : language) (Σ : gFunctors) := OwnPGS {
+  ownP_invG : invGS Σ;
+  #[local] ownP_inG :: inG Σ (excl_authR (stateO Λ));
   ownP_name : gname;
 }.
 
-Instance ownPG_irisG `{!ownPG Λ Σ} : irisG Λ Σ := {
-  iris_invG := ownP_invG;
-  state_interp σ κs _ := own ownP_name (● (Excl' σ))%I;
+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_invG.
+Global Opaque iris_invGS.
 
 Definition ownPΣ (Λ : language) : gFunctors :=
   #[invΣ;
-    GFunctor (authR (optionUR (exclR (stateC Λ))))].
+    GFunctor (excl_authR (stateO Λ))].
 
-Class ownPPreG (Λ : language) (Σ : gFunctors) : Set := IrisPreG {
-  ownPPre_invG :> invPreG Σ;
-  ownPPre_state_inG :> inG Σ (authR (optionUR (exclR (stateC Λ))))
+Class ownPGpreS (Λ : language) (Σ : gFunctors) : Set := {
+  #[global] ownPPre_invG :: invGpreS Σ;
+  #[local] ownPPre_state_inG :: inG Σ (excl_authR (stateO Λ))
 }.
 
-Instance subG_ownPΣ {Λ Σ} : subG (ownPΣ Λ) Σ → ownPPreG Λ Σ.
+Global Instance subG_ownPΣ {Λ Σ} : subG (ownPΣ Λ) Σ → ownPGpreS Λ Σ.
 Proof. solve_inG. Qed.
 
 (** Ownership *)
-Definition ownP `{!ownPG Λ Σ} (σ : state Λ) : iProp Σ :=
-  own ownP_name (◯ (Excl' σ)).
-
-Typeclasses Opaque ownP.
-Instance: Params (@ownP) 3 := {}.
+Definition ownP `{!ownPGS Λ Σ} (σ : state Λ) : iProp Σ :=
+  own ownP_name (◯E σ).
+Global Typeclasses Opaque ownP.
+Global Instance: Params (@ownP) 3 := {}.
 
 (* Adequacy *)
-Theorem ownP_adequacy Σ `{!ownPPreG Λ Σ} s e σ φ :
-  (∀ `{!ownPG Λ Σ}, ownP σ ⊢ WP e @ s; ⊤ {{ v, ⌜φ v⌝ }}) →
+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 (● (Excl' σ) ⋅ ◯ (Excl' σ))) as (γσ) "[Hσ Hσf]"; first done.
-  iModIntro. iExists (λ σ κs, own γσ (● (Excl' σ)))%I.
+  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 (OwnPG _ _ _ _ γσ)). rewrite /ownP. iFrame.
+  iApply (Hwp (OwnPGS _ _ _ _ γσ)). rewrite /ownP. iFrame.
 Qed.
 
-Theorem ownP_invariance Σ `{!ownPPreG Λ Σ} s e σ1 t2 σ2 φ :
-  (∀ `{!ownPG Λ Σ},
+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 κs').
-  iMod (own_alloc (● (Excl' σ1) ⋅ ◯ (Excl' σ1))) as (γσ) "[Hσ Hσf]"; first done.
-  iExists (λ σ κs' _, own γσ (● (Excl' σ)))%I, (λ _, True%I).
+  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 (OwnPG _ _ _ _ γσ) with "[Hσf]") as "[$ H]";
+  iMod (Hwp (OwnPGS _ _ _ _ γσ) with "[Hσf]") as "[$ H]";
     first by rewrite /ownP; iFrame.
-  iIntros "!> Hσ". iMod "H" as (σ2') "[Hσf %]". rewrite /ownP.
-  iDestruct (own_valid_2 with "Hσ Hσf")
-    as %[Hp%Excl_included _]%auth_valid_discrete_2; simplify_eq; auto.
+  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 `{!ownPG Λ Σ}.
+  Context `{!ownPGS Λ Σ}.
   Implicit Types s : stuckness.
   Implicit Types e : expr Λ.
   Implicit Types Φ : val Λ → iProp Σ.
 
-  Lemma ownP_eq σ1 σ2 κs n : state_interp σ1 κs n -∗ ownP σ2 -∗ ⌜σ1 = σ2⌝.
+  Lemma ownP_eq σ1 ns σ2 κs nt :
+    state_interp σ1 ns κs nt -∗ ownP σ2 -∗ ⌜σ1 = σ2⌝.
   Proof.
     iIntros "Hσ● Hσ◯". rewrite /ownP.
-    iDestruct (own_valid_2 with "Hσ● Hσ◯") as %[Hps _]%auth_valid_discrete_2.
-    by pose proof (leibniz_equiv _ _ (Excl_included _ _ Hps)) as ->.
+    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 (?). Qed.
+  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.
 
@@ -110,14 +117,13 @@ Section lifting.
       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 κ κs n) "Hσκs".
+    - 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).
+      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 auth_update. apply: option_local_update.
-         by apply: (exclusive_local_update _ (Excl σ2)). }
+      { apply excl_auth_update. }
       iFrame "Hσ". iApply ("H" with "[]"); eauto with iFrame.
   Qed.
 
@@ -129,7 +135,7 @@ Section lifting.
     - 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 κs n) "Hσ".
+    - 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.
@@ -144,8 +150,8 @@ Section lifting.
     iIntros (Hsafe Hstep) "H"; iApply wp_lift_step.
     { specialize (Hsafe inhabitant). destruct s; last done.
       by eapply reducible_not_val. }
-    iIntros (σ1 κ κs n) "Hσ". iMod (fupd_intro_mask' E ∅) as "Hclose"; first set_solver.
-    iModIntro; iSplit; [by destruct s|]; iNext; iIntros (e2 σ2 efs ?).
+    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.
@@ -160,8 +166,8 @@ Section lifting.
     ⊢ WP e1 @ s; E {{ Φ }}.
   Proof.
     iIntros (?) "[Hσ H]"; iApply ownP_lift_step.
-    iMod (fupd_intro_mask' E ∅) as "Hclose"; first set_solver.
-    iModIntro; iExists σ1; iFrame; iSplit; first by destruct s.
+    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.
@@ -189,7 +195,7 @@ Section lifting.
     {{{ ▷ (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. apply bi.wand_intro_r. iIntros "[Hs Hs']".
+    rewrite big_sepL_nil right_id. iIntros "Hs Hs'".
     iSplitL "Hs"; first by iFrame. iModIntro. iIntros "Hσ2". iApply "Hs'". iFrame.
   Qed.
 
@@ -198,23 +204,25 @@ Section lifting.
     (∀ σ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) //; eauto.
+    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} `{!ownPG Λ Σ} {Hinh : Inhabited (state Λ)}.
+  Context {Λ : ectxLanguage} `{!ownPGS Λ Σ} {Hinh : Inhabited (state Λ)}.
   Implicit Types s : stuckness.
   Implicit Types Φ : val Λ → iProp Σ.
   Implicit Types e : expr Λ.
-  Hint Resolve head_prim_reducible head_reducible_prim_step : core.
-  Hint Resolve (reducible_not_val _ inhabitant) : core.
-  Hint Resolve head_stuck_stuck : core.
+  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_head_step s E Φ e1 :
-    (|={E,∅}=> ∃ σ1, ⌜head_reducible e1 σ1⌝ ∗ ▷ (ownP σ1) ∗
-            ▷ ∀ κ e2 σ2 efs, ⌜head_step e1 σ1 κ e2 σ2 efs⌝ -∗
+  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 {{ Φ }}.
@@ -226,19 +234,19 @@ Section ectx_lifting.
     iApply ("Hwp" with "[] Hσ2"); eauto.
   Qed.
 
-  Lemma ownP_lift_head_stuck E Φ e :
+  Lemma ownP_lift_base_stuck E Φ e :
     sub_redexes_are_values e →
-    (|={E,∅}=> ∃ σ, ⌜head_stuck e σ⌝ ∗ ▷ (ownP σ))
+    (|={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_head_step s E Φ e1 :
-    (∀ σ1, head_reducible e1 σ1) →
-    (∀ σ1 κ e2 σ2 efs, head_step e1 σ1 κ e2 σ2 efs → κ = [] ∧ σ2 = σ1) →
-    (▷ ∀ κ e2 efs σ, ⌜head_step e1 σ κ e2 σ efs⌝ →
+  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.
@@ -247,10 +255,10 @@ Section ectx_lifting.
     iNext. iIntros (?????). iApply "H"; eauto.
   Qed.
 
-  Lemma ownP_lift_atomic_head_step {s E Φ} e1 σ1 :
-    head_reducible e1 σ1 →
+  Lemma ownP_lift_atomic_base_step {s E Φ} e1 σ1 :
+    base_reducible e1 σ1 →
     ▷ (ownP σ1) ∗ ▷ (∀ κ e2 σ2 efs,
-    ⌜head_step e1 σ1 κ e2 σ2 efs⌝ -∗ ownP σ2 -∗
+    ⌜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.
@@ -260,9 +268,9 @@ Section ectx_lifting.
     iNext. iIntros (???? ?) "Hσ". iApply ("H" with "[] Hσ"); eauto.
   Qed.
 
-  Lemma ownP_lift_atomic_det_head_step {s E Φ e1} σ1 v2 σ2 efs :
-    head_reducible e1 σ1 →
-    (∀ κ' e2' σ2' efs', head_step e1 σ1 κ' e2' σ2' efs' →
+  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 }})
@@ -273,9 +281,9 @@ Section ectx_lifting.
     intros; eapply Hs; eauto 10.
   Qed.
 
-  Lemma ownP_lift_atomic_det_head_step_no_fork {s E e1} σ1 κ v2 σ2 :
-    head_reducible e1 σ1 →
-    (∀ κ' e2' σ2' efs', head_step e1 σ1 κ' e2' σ2' efs' →
+  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.
@@ -283,9 +291,9 @@ Section ectx_lifting.
     by destruct s; eauto using reducible_not_val.
   Qed.
 
-  Lemma ownP_lift_pure_det_head_step_no_fork {s E Φ} e1 e2 :
-    (∀ σ1, head_reducible e1 σ1) →
-    (∀ σ1 κ e2' σ2 efs', head_step e1 σ1 κ e2' σ2 efs' → κ = [] ∧ σ2 = σ1 ∧ e2' = e2 ∧ efs' = []) →
+  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.

theories/program_logic/total_adequacy.v → iris/program_logic/total_adequacy.v

-From iris.program_logic Require Export total_weakestpre adequacy.
 From iris.algebra Require Import gmap auth agree gset coPset list.
-From iris.bi Require Import big_op fixpoint.
-From iris.proofmode Require Import tactics.
-Set Default Proof Using "Type".
+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 `{!irisG Λ Σ}.
+Context `{!irisGS_gen HasNoLc Λ Σ}.
 Implicit Types e : expr Λ.
 
 Definition twptp_pre (twptp : list (expr Λ) → iProp Σ)
     (t1 : list (expr Λ)) : iProp Σ :=
-  (∀ t2 σ1 κ κs σ2 n, ⌜step (t1,σ1) κ (t2,σ2)⌝ -∗
-    state_interp σ1 κs n ={⊤}=∗ ∃ n', ⌜κ = []⌝ ∗ state_interp σ2 κs n' ∗ twptp t2)%I.
+  ∀ 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 Σ) :
-  (<pers> (∀ t, twptp1 t -∗ twptp2 t) →
-  ∀ t, twptp_pre twptp1 t -∗ twptp_pre twptp2 t)%I.
+  □ (∀ 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 κ κs σ2 n1) "Hstep Hσ".
+  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 apply twptp_pre_mono.
+  constructor; first (intros ????; apply twptp_pre_mono).
   intros wp Hwp n t1 t2 ?%(discrete_iff _ _)%leibniz_equiv; solve_proper.
 Qed.
 
@@ -37,21 +38,21 @@ 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)%I.
+  ⊢ (□ ∀ 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_strong_ind _ Ψ with "[] H").
-  iIntros "!#" (t') "H". by iApply "IH".
+  iApply (least_fixpoint_ind _ Ψ with "[] H").
+  iIntros "!>" (t') "H". by iApply "IH".
 Qed.
 
-Instance twptp_Permutation : Proper ((≡ₚ) ==> (⊢)) twptp.
+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 κ κs σ2 n Hstep) "Hσ".
-  destruct (step_Permutation t1' t1 t2 κ σ1 σ2) as (t2'&?&?); try done.
+  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.
@@ -59,22 +60,23 @@ 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".
+  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 κ κs σ2 n Hstep) "Hσ1".
+  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 with (t1:=[]). }
+      { 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 "!# * [_ ?] //". }
+        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.
@@ -85,28 +87,29 @@ 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' κ κs σ2' n Hstep) "Hσ1".
+  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 + n). iFrame "Hσ".
+  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 κ κs σ2 n1 Hstep).
+  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 n σ t :
-  state_interp σ [] n -∗ twptp t ={⊤}=∗ ▷ ⌜sn erased_step (t, σ)⌝.
+Lemma twptp_total σ ns nt t :
+  state_interp σ ns [] nt -∗ twptp t ={⊤}=∗ ⌜sn erased_step (t, σ)⌝.
 Proof.
-  iIntros "Hσ Ht". iRevert (σ n) "Hσ". iRevert (t) "Ht".
-  iApply twptp_ind; iIntros "!#" (t) "IH"; iIntros (σ n) "Hσ".
+  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 _]]".
@@ -114,18 +117,27 @@ Proof.
 Qed.
 End adequacy.
 
-Theorem twp_total Σ Λ `{!invPreG Σ} s e σ Φ :
-  (∀ `{Hinv : !invG Σ},
-     (|={⊤}=> ∃
-         (stateI : state Λ → list (observation Λ) → nat → iProp Σ)
-         (fork_post : val Λ → iProp Σ),
-       let _ : irisG Λ Σ := IrisG _ _ Hinv stateI fork_post in
-       stateI σ [] 0 ∗ WP e @ s; ⊤ [{ Φ }])%I) →
+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. apply (soundness (M:=iResUR Σ) _  2); simpl.
-  apply (fupd_plain_soundness ⊤ _)=> Hinv.
-  iMod (Hwp) as (stateI fork_post) "[Hσ H]".
-  iApply (@twptp_total _ _ (IrisG _ _ Hinv stateI fork_post) with "Hσ").
-  by iApply (@twp_twptp _ _ (IrisG _ _ Hinv stateI fork_post)).
+  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.

theories/program_logic/total_ectx_lifting.v → iris/program_logic/total_ectx_lifting.v

 (** Some derived lemmas for ectx-based languages *)
-From iris.program_logic Require Export ectx_language.
-From iris.program_logic Require Export total_weakestpre total_lifting.
-From iris.proofmode Require Import tactics.
-Set Default Proof Using "Type".
+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} `{!irisG Λ Σ} {Hinh : Inhabited (state Λ)}.
+Context {Λ : ectxLanguage} `{!irisGS_gen hlc Λ Σ} {Hinh : Inhabited (state Λ)}.
 Implicit Types P : iProp Σ.
 Implicit Types Φ : val Λ → iProp Σ.
 Implicit Types v : val Λ.
 Implicit Types e : expr Λ.
-Hint Resolve head_prim_reducible_no_obs head_reducible_prim_step
-  head_reducible_no_obs_reducible : core.
+Local Hint Resolve base_prim_reducible_no_obs base_reducible_prim_step
+  base_reducible_no_obs_reducible : core.
 
-Lemma twp_lift_head_step {s E Φ} e1 :
+Lemma twp_lift_base_step {s E Φ} e1 :
   to_val e1 = None →
-  (∀ σ1 κs n, state_interp σ1 κs n ={E,∅}=∗
-    ⌜head_reducible_no_obs e1 σ1⌝ ∗
-    ∀ κ e2 σ2 efs, ⌜head_step e1 σ1 κ e2 σ2 efs⌝ ={∅,E}=∗
+  (∀ σ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 (length efs + n) ∗
+      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 κs n) "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_head_step_no_fork {s E Φ} e1 :
-  (∀ σ1, head_reducible_no_obs e1 σ1) →
-  (∀ σ1 κ e2 σ2 efs, head_step e1 σ1 κ e2 σ2 efs → κ = [] ∧ σ2 = σ1 ∧ efs = []) →
-  (|={E}=> ∀ κ e2 efs σ, ⌜head_step e1 σ κ e2 σ efs⌝ → WP e2 @ s; E [{ Φ }] )
+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_head_step {s E Φ} e1 :
+Lemma twp_lift_atomic_base_step {s E Φ} e1 :
   to_val e1 = None →
-  (∀ σ1 κs n, state_interp σ1 κs n ={E}=∗
-    ⌜head_reducible_no_obs e1 σ1⌝ ∗
-    ∀ κ e2 σ2 efs, ⌜head_step e1 σ1 κ e2 σ2 efs⌝ ={E}=∗
+  (∀ σ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 (length efs + n) ∗
+      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 κs n) "Hσ1". iMod ("H" $! σ1 with "Hσ1") as "[% H]"; iModIntro.
+  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_head_step_no_fork {s E Φ} e1 :
+Lemma twp_lift_atomic_base_step_no_fork {s E Φ} e1 :
   to_val e1 = None →
-  (∀ σ1 κs n, state_interp σ1 κs n ={E}=∗
-    ⌜head_reducible_no_obs e1 σ1⌝ ∗
-    ∀ κ e2 σ2 efs, ⌜head_step e1 σ1 κ e2 σ2 efs⌝ ={E}=∗
-      ⌜κ = []⌝ ∗ ⌜efs = []⌝ ∗ state_interp σ2 κs n ∗ from_option Φ False (to_val e2))
+  (∀ σ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_head_step; eauto.
-  iIntros (σ1 κs n) "Hσ1". iMod ("H" $! σ1 with "Hσ1") as "[$ H]"; iModIntro.
+  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_head_step_no_fork {s E Φ} e1 e2 :
+Lemma twp_lift_pure_det_base_step_no_fork {s E Φ} e1 e2 :
   to_val e1 = None →
-  (∀ σ1, head_reducible_no_obs e1 σ1) →
+  (∀ σ1, base_reducible_no_obs e1 σ1) →
   (∀ σ1 κ e2' σ2 efs',
-    head_step e1 σ1 κ e2' σ2 efs' → κ = [] ∧ σ2 = σ1 ∧ e2' = e2 ∧ 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.

theories/program_logic/total_lifting.v → iris/program_logic/total_lifting.v

-From iris.program_logic Require Export total_weakestpre.
 From iris.bi Require Export big_op.
-From iris.proofmode Require Import tactics.
-Set Default Proof Using "Type".
+From iris.proofmode Require Import proofmode.
+From iris.program_logic Require Export total_weakestpre.
+From iris.prelude Require Import options.
 
 Section lifting.
-Context `{!irisG Λ Σ}.
+Context `{!irisGS_gen hlc Λ Σ}.
 Implicit Types v : val Λ.
 Implicit Types e : expr Λ.
 Implicit Types σ : state Λ.
 Implicit Types P Q : iProp Σ.
 Implicit Types Φ : val Λ → iProp Σ.
 
-Hint Resolve reducible_no_obs_reducible : core.
+Local Hint Resolve reducible_no_obs_reducible : core.
 
 Lemma twp_lift_step s E Φ e1 :
   to_val e1 = None →
-  (∀ σ1 κs n, state_interp σ1 κs n ={E,∅}=∗
+  (∀ σ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 (length efs + n) ∗
+      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 [{ Φ }].
@@ -34,11 +34,11 @@ Lemma twp_lift_pure_step_no_fork `{!Inhabited (state Λ)} s E Φ e1 :
 Proof.
   iIntros (Hsafe Hstep) ">H". iApply twp_lift_step.
   { eapply reducible_not_val, reducible_no_obs_reducible, (Hsafe inhabitant). }
-  iIntros (σ1 κs n) "Hσ".
-  iMod fupd_intro_mask' as "Hclose"; last iModIntro; first by set_solver. iSplit.
+  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 "Hclose" as "_". iModIntro.
+  iMod (state_interp_mono with "Hσ"). iMod "Hclose" as "_".
   iDestruct ("H" with "[//]") as "H". simpl. by iFrame.
 Qed.
 
@@ -46,20 +46,20 @@ Qed.
    use the generic lemmas here. *)
 Lemma twp_lift_atomic_step {s E Φ} e1 :
   to_val e1 = None →
-  (∀ σ1 κs n, state_interp σ1 κs n ={E}=∗
+  (∀ σ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 (length efs + n) ∗
+      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 κs n) "Hσ1".
+  iApply (twp_lift_step _ E _ e1)=>//; iIntros (σ1 ns κs nt) "Hσ1".
   iMod ("H" $! σ1 with "Hσ1") as "[$ H]".
-  iMod (fupd_intro_mask' E ∅) as "Hclose"; first set_solver.
-  iIntros "!>" (κ e2 σ2 efs) "%". iMod "Hclose" as "_".
+  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.
@@ -82,7 +82,7 @@ Lemma twp_pure_step `{!Inhabited (state Λ)} s E e1 e2 φ 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; first done.
+  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.

theories/program_logic/total_weakestpre.v → 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.proofmode Require Import tactics.
-From iris.bi Require Import fixpoint big_op.
-Set Default Proof Using "Type".
+From iris.prelude Require Import options.
 Import uPred.
 
-Definition twp_pre `{!irisG Λ Σ} (s : stuckness)
+(** 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 κs n,
-     state_interp σ1 κs n ={E,∅}=∗
+  | 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 (length efs + n) ∗
+         state_interp σ2 (S ns) κs (length efs + nt) ∗
          wp E e2 Φ ∗
          [∗ list] ef ∈ efs, wp ⊤ ef fork_post
   end%I.
 
-Lemma twp_pre_mono `{!irisG Λ Σ} s
+(** 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 Φ)%I.
+  ⊢ (□ ∀ 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 κs n) "Hσ". iMod ("Hwp" with "Hσ") as "($ & Hwp)"; iModIntro.
+  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".
+  - 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 *)
-Definition twp_pre' `{!irisG Λ Σ} (s : stuckness) :
-  (prodC (prodC (leibnizC coPset) (exprC Λ)) (val Λ -c> iProp Σ) → iProp Σ) →
-  prodC (prodC (leibnizC coPset) (exprC Λ)) (val Λ -c> iProp Σ) → iProp Σ :=
-    curry3 ∘ twp_pre s ∘ uncurry3.
+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' `{!irisG Λ Σ} s : BiMonoPred (twp_pre' s).
+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,Φ)).
+  - 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 /uncurry3 /twp_pre. do 24 (f_equiv || done). by apply pair_ne.
+    rewrite /curry3 /twp_pre. do 26 (f_equiv || done). by apply pair_ne.
 Qed.
 
-Definition twp_def `{!irisG Λ Σ} (s : stuckness) (E : coPset)
-    (e : expr Λ) (Φ : val Λ → iProp Σ) :
-  iProp Σ := bi_least_fixpoint (twp_pre' s) (E,e,Φ).
-Definition twp_aux `{!irisG Λ Σ} : seal (@twp_def Λ Σ _). by eexists. Qed.
-Instance twp' `{!irisG Λ Σ} : Twp Λ (iProp Σ) stuckness := twp_aux.(unseal).
-Definition twp_eq `{!irisG Λ Σ} : twp = @twp_def Λ Σ _ := twp_aux.(seal_eq).
+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 `{!irisG Λ Σ}.
+Context `{!irisGS_gen hlc Λ Σ}.
 Implicit Types s : stuckness.
 Implicit Types P : iProp Σ.
 Implicit Types Φ : val Λ → iProp Σ.
@@ -68,26 +76,26 @@ 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_eq /twp_def least_fixpoint_unfold. Qed.
+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 Φ)%I.
+  □ (∀ 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_eq.
-  set (Ψ' := curry3 Ψ :
-    prodC (prodC (leibnizC coPset) (exprC Λ)) (val Λ -c> iProp Σ) → iProp Σ).
+  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_strong_ind _ Ψ' with "[] H").
-  iIntros "!#" ([[??] ?]) "H". by iApply "IH".
+  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_eq. by apply (least_fixpoint_ne _), pair_ne, HΦ.
+  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).
@@ -95,10 +103,8 @@ Proof.
   by intros Φ Φ' ?; apply equiv_dist=>n; apply twp_ne=>v; apply equiv_dist.
 Qed.
 
-Lemma twp_value' s E Φ v : Φ v -∗ WP of_val v @ s; E [{ Φ }].
-Proof. iIntros "HΦ". rewrite twp_unfold /twp_pre to_of_val. auto. Qed.
-Lemma twp_value_inv' s E Φ v : WP of_val v @ s; E [{ Φ }] ={E}=∗ Φ v.
-Proof. by rewrite twp_unfold /twp_pre to_of_val. 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 →
@@ -106,36 +112,37 @@ Lemma twp_strong_mono s1 s2 E1 E2 e Φ Ψ :
 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Φ".
+  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 κs n) "Hσ". iMod (fupd_intro_mask' E2 E1) as "Hclose"; first done.
+  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 (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 [{ Φ }].
+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 κs n) "Hσ1". iMod "H". by iApply "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 [{ Φ }].
+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 [{ Φ }].
+  (|={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 κs n) "Hσ". iMod "H". iMod ("H" $! σ1 with "Hσ") as "[$ H]".
+  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.
@@ -143,22 +150,23 @@ Proof.
     + iMod ("H" with "[$]") as "[H _]". iDestruct "H" as %(? & ? & ? & ?).
       by edestruct (atomic _ _ _ _ _ Hstep).
   - destruct (atomic _ _ _ _ _ Hstep) as [v <-%of_to_val].
-    iMod (twp_value_inv' with "H") as ">H".
-    iModIntro. iSplit; first done. iFrame "Hσ Hefs". by iApply twp_value'.
+    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 [{ Φ }].
+  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Φ".
+  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 κs n) "Hσ". iMod ("IH" with "[$]") as "[% IH]". iModIntro; iSplit.
+  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).
@@ -174,15 +182,17 @@ Lemma twp_bind_inv K `{!LanguageCtx K} s E 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 ->).
+  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 Φ') "[_ ?]". }
+    iApply (twp_pre_mono with "[] IH"). by iIntros "!>" (E e Φ') "[_ ?]". }
   rewrite /twp_pre fill_not_val //.
-  iIntros (σ1 κs n) "Hσ". iMod ("IH" with "[$]") as "[% IH]". iModIntro; iSplit.
-  { destruct s; eauto using reducible_no_obs_fill. }
+  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.
+  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.
@@ -191,19 +201,59 @@ 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 κ κs n) "Hσ". iMod ("H" with "Hσ") as "[% H]". iIntros "!>". iSplitR.
-  { destruct s; last done. eauto using reducible_no_obs_reducible. }
-  iIntros (e2 σ2 efs) "Hstep". iMod ("H" with "Hstep") as (->) "(Hσ & H & Hfork)".
-  iApply step_fupd_intro; [set_solver+|]. iNext.
-  iFrame "Hσ". iSplitL "H". by iApply "IH".
+  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".
+  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 [{ Ψ }].
+  (∀ 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Φ.
@@ -221,18 +271,16 @@ 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 s E Φ e v : IntoVal e v → Φ v -∗ WP e @ s; E [{ Φ }].
-Proof. intros <-. by apply twp_value'. Qed.
-Lemma twp_value_fupd' s E Φ v : (|={E}=> Φ v) -∗ WP of_val v @ s; E [{ Φ }].
-Proof. intros. by rewrite -twp_fupd -twp_value'. Qed.
-Lemma twp_value_fupd s E Φ e v : IntoVal e v → (|={E}=> Φ v) -∗ WP e @ s; E [{ Φ }].
-Proof. intros ?. rewrite -twp_fupd -twp_value //. Qed.
-Lemma twp_value_inv s E Φ e v : IntoVal e v → WP e @ s; E [{ Φ }] ={E}=∗ Φ v.
-Proof. intros <-. by apply twp_value_inv'. 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 }].
+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 }].
+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 Φ Ψ :
@@ -247,18 +295,37 @@ 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 `{!irisG Λ Σ}.
+  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 Φ Ψ :
-    (∀ v, Frame p R (Φ v) (Ψ v)) →
-    Frame p R (WP e @ s; E [{ Φ }]) (WP e @ s; E [{ Ψ }]).
-  Proof. rewrite /Frame=> HR. rewrite twp_frame_l. apply twp_mono, HR. Qed.
+    (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.
@@ -276,17 +343,48 @@ Section proofmode_classes.
     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 Φ :
-    Atomic (stuckness_to_atomicity s) e →
-    ElimModal True p false (|={E1,E2}=> P) P
-            (WP e @ s; E1 [{ Φ }]) (WP e @ s; E2 [{ v, |={E2,E1}=> Φ v }])%I.
+    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 /ElimModal intuitionistically_if_elim
+    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.

theories/program_logic/weakestpre.v → 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.proofmode Require Import base tactics classes.
-Set Default Proof Using "Type".
+From iris.prelude Require Import options.
 Import uPred.
 
-Class irisG (Λ : language) (Σ : gFunctors) := IrisG {
-  iris_invG :> invG Σ;
+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, [list Λobservation] are
-  the remaining observations, and [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 Λ → list (observation Λ) → nat → iProp Σ;
+  (** 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_invG.
+Global Opaque iris_invGS.
+Global Arguments IrisG {hlc Λ Σ}.
 
-Definition wp_pre `{!irisG Λ Σ} (s : stuckness)
-    (wp : coPset -c> expr Λ -c> (val Λ -c> iProp Σ) -c> iProp Σ) :
-    coPset -c> expr Λ -c> (val Λ -c> iProp Σ) -c> iProp Σ := λ E e1 Φ,
+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 κ κs n,
-     state_interp σ1 (κ ++ κs) n ={E,∅}=∗
+  | 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⌝ ={∅,∅,E}▷=∗
-         state_interp σ2 κs (length efs + n) ∗
+       ∀ 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 `{!irisG Λ Σ} s : Contractive (wp_pre s).
+Local Instance wp_pre_contractive `{!irisGS_gen hlc Λ Σ} s : Contractive (wp_pre s).
 Proof.
-  rewrite /wp_pre=> n wp wp' Hwp E e1 Φ.
-  repeat (f_contractive || f_equiv); apply Hwp.
+  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.
 
-Definition wp_def `{!irisG Λ Σ} (s : stuckness) :
-  coPset → expr Λ → (val Λ → iProp Σ) → iProp Σ := fixpoint (wp_pre s).
-Definition wp_aux `{!irisG Λ Σ} : seal (@wp_def Λ Σ _). by eexists. Qed.
-Instance wp' `{!irisG Λ Σ} : Wp Λ (iProp Σ) stuckness := wp_aux.(unseal).
-Definition wp_eq `{!irisG Λ Σ} : wp = @wp_def Λ Σ _ := wp_aux.(seal_eq).
+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 `{!irisG Λ Σ}.
+Context `{!irisGS_gen hlc Λ Σ}.
 Implicit Types s : stuckness.
 Implicit Types P : iProp Σ.
 Implicit Types Φ : val Λ → iProp Σ.
@@ -58,47 +109,60 @@ 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_eq. apply (fixpoint_unfold (wp_pre s)). Qed.
+  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.
+  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 24 (f_contractive || f_equiv). apply IH; first lia.
-  intros v. eapply dist_le; eauto with lia.
+  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' s E Φ v : Φ v ⊢ WP of_val v @ s; E {{ Φ }}.
-Proof. iIntros "HΦ". rewrite wp_unfold /wp_pre to_of_val. auto. Qed.
-Lemma wp_value_inv' s E Φ v : WP of_val v @ s; E {{ Φ }} ={E}=∗ Φ v.
-Proof. by rewrite wp_unfold /wp_pre to_of_val. 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.
+  rewrite !wp_unfold /wp_pre /=.
   destruct (to_val e) as [v|] eqn:?.
   { iApply ("HΦ" with "[> -]"). by iApply (fupd_mask_mono E1 _). }
-  iIntros (σ1 κ κs n) "Hσ". iMod (fupd_intro_mask' E2 E1) as "Hclose"; first done.
+  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).
-  iMod ("H" with "[//]") as "H". iIntros "!> !>".
-  iMod "H" as "(Hσ & H & Hefs)".
-  iMod "Hclose" as "_". iModIntro. iFrame "Hσ". iSplitR "Hefs".
+  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 _).
+  - iApply (big_sepL_impl with "Hefs"); iIntros "!>" (k ef _).
     iIntros "H". iApply ("IH" with "[] H"); auto.
 Qed.
 
@@ -106,7 +170,7 @@ 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 κ κs n) "Hσ1". iMod "H". by iApply "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.
@@ -117,30 +181,97 @@ Proof.
   iIntros "H". rewrite !wp_unfold /wp_pre.
   destruct (to_val e) as [v|] eqn:He.
   { by iDestruct "H" as ">>> $". }
-  iIntros (σ1 κ κs n) "Hσ". iMod "H". iMod ("H" $! σ1 with "Hσ") as "[$ H]".
-  iModIntro. iIntros (e2 σ2 efs Hstep).
-  iMod ("H" with "[//]") as "H". iIntros "!>!>".
-  iMod "H" as "(Hσ & H & Hefs)". destruct s.
+  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 %(? & ? & ? & ? & ?).
+    + iMod ("H" $! _ _ [] with "[$]") as "[H _]". iDestruct "H" as %(? & ? & ? & ? & ?).
       by edestruct (atomic _ _ _ _ _ Hstep).
   - destruct (atomic _ _ _ _ _ Hstep) as [v <-%of_to_val].
-    iMod (wp_value_inv' with "H") as ">H".
-    iModIntro. iFrame "Hσ Hefs". by iApply wp_value'.
+    rewrite wp_value_fupd'. iMod "H" as ">H".
+    iModIntro. iFrame "Hσ Hefs". by iApply wp_value_fupd'.
 Qed.
 
-Lemma wp_step_fupd s E1 E2 e P Φ :
-  to_val e = None → E2 ⊆ E1 →
-  (|={E1,E2}▷=> P) -∗ WP e @ s; E2 {{ v, P ={E1}=∗ Φ v }} -∗ WP e @ s; E1 {{ Φ }}.
+(** 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.
-  rewrite !wp_unfold /wp_pre. iIntros (-> ?) "HR H".
-  iIntros (σ1 κ κs n) "Hσ". iMod "HR". iMod ("H" with "[$]") as "[$ H]".
-  iIntros "!>" (e2 σ2 efs Hstep). iMod ("H" $! e2 σ2 efs with "[% //]") as "H".
-  iIntros "!>!>". iMod "H" as "(Hσ & H & Hefs)".
-  iMod "HR". iModIntro. iFrame "Hσ Hefs".
-  iApply (wp_strong_mono s s E2 with "H"); [done..|].
-  iIntros (v) "H". by iApply "H".
+  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 Φ :
@@ -149,30 +280,31 @@ 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 //.
-  iIntros (σ1 κ κs n) "Hσ". iMod ("H" with "[$]") as "[% H]". iModIntro; iSplit.
-  { iPureIntro. destruct s; last done.
-    unfold reducible in *. naive_solver eauto using fill_step. }
-  iIntros (e2 σ2 efs Hstep).
+  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 "[//]") as "H". iIntros "!>!>".
-  iMod "H" as "(Hσ & H & Hefs)".
-  iModIntro. iFrame "Hσ Hefs". by iApply "IH".
+  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.
+  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 κ κs n) "Hσ". iMod ("H" with "[$]") as "[% H]". iModIntro; iSplit.
-  { destruct s; eauto using reducible_fill. }
-  iIntros (e2 σ2 efs Hstep).
-  iMod ("H" $! (K e2) σ2 efs with "[]") as "H"; [by eauto using fill_step|].
-  iIntros "!>!>". iMod "H" as "(Hσ & H & Hefs)".
-  iModIntro. iFrame "Hσ Hefs". by iApply "IH".
+  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 *)
@@ -192,41 +324,76 @@ 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 <-. by apply wp_value'. Qed.
-Lemma wp_value_fupd' s E Φ v : (|={E}=> Φ v) ⊢ WP of_val v @ s; E {{ Φ }}.
-Proof. intros. by rewrite -wp_fupd -wp_value'. Qed.
-Lemma wp_value_fupd s E Φ e v `{!IntoVal e v} :
-  (|={E}=> Φ v) ⊢ WP e @ s; E {{ Φ }}.
-Proof. intros. rewrite -wp_fupd -wp_value //. Qed.
-Lemma wp_value_inv s E Φ e v : IntoVal e v → WP e @ s; E {{ Φ }} ={E}=∗ Φ v.
-Proof. intros <-. by apply wp_value_inv'. Qed.
+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 :
-  to_val e = None → E2 ⊆ E1 →
-  (|={E1,E2}▷=> R) ∗ WP e @ s; E2 {{ Φ }} ⊢ WP e @ s; E1 {{ v, R ∗ Φ v }}.
+  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 :
-  to_val e = None → E2 ⊆ E1 →
-  WP e @ s; E2 {{ Φ }} ∗ (|={E1,E2}▷=> R) ⊢ WP e @ s; E1 {{ v, Φ v ∗ 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 :
-  to_val e = None → ▷ R ∗ WP e @ s; E {{ Φ }} ⊢ WP e @ s; E {{ v, R ∗ Φ v }}.
+  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 :
-  to_val e = None → WP e @ s; E {{ Φ }} ∗ ▷ R ⊢ WP e @ s; E {{ v, Φ v ∗ 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 Φ Ψ :
@@ -241,25 +408,28 @@ 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_l s E e Q Φ :
-  Q ∗ WP e @ s; E {{ v, Q -∗ Φ v }} -∗ WP e @ s; E {{ Φ }}.
+Lemma wp_frame_wand s E e Φ R :
+  R -∗ WP e @ s; E {{ v, R -∗ Φ v }} -∗ WP e @ s; E {{ Φ }}.
 Proof.
-  iIntros "[HQ HWP]". iApply (wp_wand with "HWP").
+  iIntros "HR HWP". iApply (wp_wand with "HWP").
   iIntros (v) "HΦ". by iApply "HΦ".
 Qed.
-
 End wp.
 
 (** Proofmode class instances *)
 Section proofmode_classes.
-  Context `{!irisG Λ Σ}.
+  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 Φ Ψ :
-    (∀ v, Frame p R (Φ v) (Ψ v)) →
-    Frame p R (WP e @ s; E {{ Φ }}) (WP e @ s; E {{ Ψ }}).
-  Proof. rewrite /Frame=> HR. rewrite wp_frame_l. apply wp_mono, HR. Qed.
+    (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.
@@ -277,39 +447,57 @@ Section proofmode_classes.
     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 Φ :
-    Atomic (stuckness_to_atomicity s) e →
-    ElimModal True p false (|={E1,E2}=> P) P
-            (WP e @ s; E1 {{ Φ }}) (WP e @ s; E2 {{ v, |={E2,E1}=> Φ v }})%I.
+    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 /ElimModal intuitionistically_if_elim
+    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 {X} E1 E2 α β γ e s Φ :
-    Atomic (stuckness_to_atomicity s) e →
-    ElimAcc (X:=X) (fupd E1 E2) (fupd E2 E1)
+  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.
+            (λ x, WP e @ s; E2 {{ v, |={E2}=> β x ∗ (γ x -∗? Φ v) }})%I | 100.
   Proof.
-    intros ?. rewrite /ElimAcc.
-    iIntros "Hinner >Hacc". iDestruct "Hacc" as (x) "[Hα Hclose]".
+    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) (fupd E E) (fupd E E)
+    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.
-    rewrite /ElimAcc.
-    iIntros "Hinner >Hacc". iDestruct "Hacc" as (x) "[Hα Hclose]".
+    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".

theories/proofmode/base.v → iris/proofmode/base.v

-From stdpp Require Export strings.
-From iris.algebra Require Export base.
 From Coq Require Export Ascii.
-Set Default Proof Using "Type".
+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. *)
-Local Notation "b1 && b2" := (if b1 then b2 else false) : bool_scope.
 
-Lemma lazy_andb_true (b1 b2 : bool) : b1 && b2 = true ↔ b1 = true ∧ b2 = true.
+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
@@ -32,13 +90,13 @@ Definition beq (b1 b2 : bool) : bool :=
 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.
+  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
+  | String a1 s1, String a2 s2 => ascii_beq a1 a2 &&& string_beq s1 s2
   | _, _ => false
   end.
 
@@ -65,12 +123,12 @@ Inductive ident :=
   | INamed :> string → ident.
 End ident.
 
-Instance maybe_IAnon : Maybe IAnon := λ i,
+Global Instance maybe_IAnon : Maybe IAnon := λ i,
   match i with IAnon n => Some n | _ => None end.
-Instance maybe_INamed : Maybe INamed := λ i,
+Global Instance maybe_INamed : Maybe INamed := λ i,
   match i with INamed s => Some s | _ => None end.
 
-Instance beq_eq_dec : EqDecision ident.
+Global Instance beq_eq_dec : EqDecision ident.
 Proof. solve_decision. Defined.
 
 Definition positive_beq := Eval compute in Pos.eqb.
@@ -93,18 +151,21 @@ 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 [option] combinators for better reduction control. *)
+(** 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.
-Arguments pm_option_bind {_ _} _ !_ /.
+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.
-Arguments pm_from_option {_ _} _ _ !_ /.
+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.
-Arguments pm_option_fun {_ _} !_ _ /.
+Global Arguments pm_option_fun {_ _} !_ _ /.
 
 (* Can't write [id] here as that would not reduce. *)
 Notation pm_default := (pm_from_option (λ x, x)).

theories/proofmode/class_instances_bi.v → iris/proofmode/class_instances.v

-From stdpp Require Import nat_cancel.
-From iris.bi Require Import bi tactics telescopes.
-From iris.proofmode Require Import base modality_instances classes ltac_tactics.
-Set Default Proof Using "Type".
+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.
 
-Section bi_instances.
+(* 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 P : AsEmpValid0 (bi_emp_valid P) P | 0.
+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 P Q : AsEmpValid0 (P ⊢ Q) (P -∗ Q).
-Proof. split. apply bi.entails_wand. apply bi.wand_entails. Qed.
-Global Instance as_emp_valid_equiv P Q : AsEmpValid0 (P ≡ Q) (P ∗-∗ Q).
-Proof. split. apply bi.equiv_wand_iff. apply bi.wand_iff_equiv. Qed.
-
-Global Instance as_emp_valid_forall {A : Type} (φ : A → Prop) (P : A → PROP) :
-  (∀ x, AsEmpValid (φ x) (P x)) → AsEmpValid (∀ x, φ x) (∀ x, P x).
-Proof.
-  rewrite /AsEmpValid=>H1. split=>H2.
-  - apply bi.forall_intro=>?. apply H1, H2.
-  - intros x. apply H1. revert H2. by rewrite (bi.forall_elim x).
-Qed.
-
-(* 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'} (φ : Prop) (P : PROP) :
-  BiEmbed PROP PROP' →
-  AsEmpValid0 φ P → AsEmpValid φ ⎡P⎤.
-Proof. rewrite /AsEmpValid0 /AsEmpValid=> _ ->. rewrite embed_emp_valid //. 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.
@@ -47,7 +63,7 @@ Proof. by rewrite /FromAffinely. Qed.
 
 (** IntoAbsorbingly *)
 Global Instance into_absorbingly_True : @IntoAbsorbingly PROP True emp | 0.
-Proof. by rewrite /IntoAbsorbingly -absorbingly_True_emp absorbingly_pure. Qed.
+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 :
@@ -59,9 +75,6 @@ Global Instance into_absorbingly_default P : IntoAbsorbingly (<absorb> P) P | 10
 Proof. by rewrite /IntoAbsorbingly. Qed.
 
 (** FromAssumption *)
-Global Instance from_assumption_exact p P : FromAssumption p P P | 0.
-Proof. by rewrite /FromAssumption /= intuitionistically_if_elim. Qed.
-
 Global Instance from_assumption_persistently_r P Q :
   FromAssumption true P Q → KnownRFromAssumption true P (<pers> Q).
 Proof.
@@ -99,7 +112,7 @@ Proof.
   rewrite /KnownLFromAssumption /FromAssumption /= =><-.
   rewrite intuitionistically_persistently_elim //.
 Qed.
-Global Instance from_assumption_persistently_l_false `{BiAffine PROP} P Q :
+Global Instance from_assumption_persistently_l_false `{!BiAffine PROP} P Q :
   FromAssumption true P Q → KnownLFromAssumption false (<pers> P) Q.
 Proof.
   rewrite /KnownLFromAssumption /FromAssumption /= =><-.
@@ -124,10 +137,12 @@ Proof.
   rewrite /KnownLFromAssumption /FromAssumption=> <-.
   by rewrite forall_elim.
 Qed.
-
-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_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 ⌜φ⌝ φ.
@@ -139,27 +154,36 @@ 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 (φ1 φ2 : Prop) P1 P2 :
+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 pure_impl=> <- -> //. Qed.
+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_forall {A} (Φ : A → PROP) (φ : A → Prop) :
+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 (φ1 φ2 : Prop) P1 P2 :
-  FromPure true P1 φ1 → IntoPure P2 φ2 → IntoPure (P1 -∗ P2) (φ1 → φ2).
+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 -impl_wand_2. apply bi.wand_intro_l.
-  rewrite -{1}(persistent_absorbingly_affinely ⌜φ1⌝%I) absorbingly_sep_l
-          bi.wand_elim_r absorbing //.
+  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) φ.
@@ -172,23 +196,63 @@ 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_embed `{BiEmbed PROP PROP'} P φ :
-  IntoPure P φ → IntoPure ⎡P⎤ φ.
-Proof. rewrite /IntoPure=> ->. by rewrite embed_pure. 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_pure a φ : @FromPure PROP a ⌜φ⌝ φ.
-Proof. rewrite /FromPure. apply affinely_if_elim. Qed.
-Global Instance from_pure_pure_and a (φ1 φ2 : Prop) P1 P2 :
-  FromPure a P1 φ1 → FromPure a P2 φ2 → FromPure a (P1 ∧ P2) (φ1 ∧ φ2).
-Proof. rewrite /FromPure pure_and=> <- <- /=. by rewrite affinely_if_and. Qed.
-Global Instance from_pure_pure_or a (φ1 φ2 : Prop) P1 P2 :
-  FromPure a P1 φ1 → FromPure a P2 φ2 → FromPure a (P1 ∨ P2) (φ1 ∨ φ2).
-Proof. by rewrite /FromPure pure_or affinely_if_or=><- <-. Qed.
+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=> -> <-. destruct a=>//=.
+  rewrite /FromPure /IntoPure pure_impl_1=> -> <-. destruct a=>//=.
   apply bi.impl_intro_l. by rewrite affinely_and_r bi.impl_elim_r.
 Qed.
 
@@ -198,34 +262,40 @@ 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. setoid_rewrite <-Hx.
+  rewrite /FromPure=>Hx. rewrite pure_forall_1. setoid_rewrite <-Hx.
   destruct a=>//=. apply affinely_forall.
 Qed.
-
-Global Instance from_pure_pure_sep_true (φ1 φ2 : Prop) P1 P2 :
-  FromPure true P1 φ1 → FromPure true P2 φ2 → FromPure true (P1 ∗ P2) (φ1 ∧ φ2).
+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=> <- <- /=.
-  by rewrite -persistent_and_affinely_sep_l affinely_and_r pure_and.
+  rewrite /FromPure !tforall_forall bi_tforall_forall. apply from_pure_forall.
 Qed.
-Global Instance from_pure_pure_sep_false_l (φ1 φ2 : Prop) P1 P2 :
-  FromPure false P1 φ1 → FromPure true P2 φ2 → FromPure false (P1 ∗ P2) (φ1 ∧ φ2).
-Proof.
-  rewrite /FromPure=> <- <- /=. by rewrite -persistent_and_affinely_sep_r pure_and.
-Qed.
-Global Instance from_pure_pure_sep_false_r (φ1 φ2 : Prop) P1 P2 :
-  FromPure true P1 φ1 → FromPure false P2 φ2 → FromPure false (P1 ∗ P2) (φ1 ∧ φ2).
+
+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=> <- <- /=. by rewrite -persistent_and_affinely_sep_l pure_and.
+  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 (φ1 φ2 : Prop) a P1 P2 :
-  IntoPure P1 φ1 → FromPure false P2 φ2 → FromPure a (P1 -∗ P2) (φ1 → φ2).
+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=> -> <- /=.
-  by rewrite bi.affinely_if_elim pure_wand_forall pure_impl pure_impl_forall.
+  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 φ :
@@ -234,32 +304,71 @@ Proof.
   rewrite /FromPure=> <- /=.
   by rewrite persistently_affinely_elim affinely_if_elim persistently_pure.
 Qed.
-Global Instance from_pure_affinely_true P φ :
-  FromPure true P φ → FromPure true (<affine> P) φ.
-Proof. rewrite /FromPure=><- /=. by rewrite affinely_idemp. Qed.
-Global Instance from_pure_affinely_false P φ `{!Affine P} :
-  FromPure false P φ → FromPure false (<affine> P) φ.
-Proof. rewrite /FromPure /= affine_affinely //. Qed.
-Global Instance from_pure_intuitionistically_true P φ :
-  FromPure true P φ → FromPure true (□ P) φ.
-Proof.
-  rewrite /FromPure=><- /=. rewrite intuitionistically_affinely_elim.
-  rewrite {1}(persistent ⌜φ⌝%I) //.
-Qed.
-
-Global Instance from_pure_absorbingly P φ p :
-  FromPure true P φ → FromPure p (<absorb> P) φ.
-Proof.
-  rewrite /FromPure=> <- /=.
-  rewrite persistent_absorbingly_affinely affinely_if_elim //.
+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.
-Global Instance from_pure_embed `{BiEmbed PROP PROP'} a P φ :
-  FromPure a P φ → FromPure a ⎡P⎤ φ.
-Proof. rewrite /FromPure=> <-. by rewrite -embed_pure embed_affinely_if_2. Qed.
-
-Global Instance from_pure_bupd `{BiBUpd PROP} a P φ :
-  FromPure a P φ → FromPure a (|==> P) φ.
-Proof. rewrite /FromPure=> <-. apply bupd_intro. Qed.
 
 (** IntoPersistent *)
 Global Instance into_persistent_persistently p P Q :
@@ -279,11 +388,6 @@ Proof.
     eauto using persistently_mono, intuitionistically_elim,
     intuitionistically_into_persistently_1.
 Qed.
-Global Instance into_persistent_embed `{BiEmbed PROP PROP'} p P Q :
-  IntoPersistent p P Q → IntoPersistent p ⎡P⎤ ⎡Q⎤ | 0.
-Proof.
-  rewrite /IntoPersistent -embed_persistently -embed_persistently_if=> -> //.
-Qed.
 Global Instance into_persistent_here P : IntoPersistent true P P | 1.
 Proof. by rewrite /IntoPersistent. Qed.
 Global Instance into_persistent_persistent P :
@@ -292,53 +396,25 @@ Proof. intros. by rewrite /IntoPersistent. Qed.
 
 (** FromModal *)
 Global Instance from_modal_affinely P :
-  FromModal modality_affinely (<affine> P) (<affine> P) P | 2.
+  FromModal True modality_affinely (<affine> P) (<affine> P) P | 2.
 Proof. by rewrite /FromModal. Qed.
 
 Global Instance from_modal_persistently P :
-  FromModal modality_persistently (<pers> P) (<pers> P) P | 2.
+  FromModal True modality_persistently (<pers> P) (<pers> P) P | 2.
 Proof. by rewrite /FromModal. Qed.
 Global Instance from_modal_intuitionistically P :
-  FromModal modality_intuitionistically (□ P) (□ P) P | 1.
+  FromModal True modality_intuitionistically (□ P) (□ P) P | 1.
 Proof. by rewrite /FromModal. Qed.
 Global Instance from_modal_intuitionistically_affine_bi P :
-  BiAffine PROP → FromModal modality_persistently (□ P) (□ P) P | 0.
+  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 modality_id (<absorb> P) (<absorb> P) P.
+  FromModal True modality_id (<absorb> P) (<absorb> P) P.
 Proof. by rewrite /FromModal /= -absorbingly_intro. Qed.
 
-(* When having a modality nested in an embedding, e.g. [ ⎡|==> P⎤ ], we prefer
-the embedding over the modality. *)
-Global Instance from_modal_embed `{BiEmbed PROP PROP'} (P : PROP) :
-  FromModal (@modality_embed PROP PROP' _) ⎡P⎤ ⎡P⎤ P.
-Proof. by rewrite /FromModal. Qed.
-
-Global Instance from_modal_id_embed `{BiEmbed PROP PROP'} `(sel : A) P Q :
-  FromModal modality_id sel P Q →
-  FromModal modality_id sel ⎡P⎤ ⎡Q⎤ | 100.
-Proof. by rewrite /FromModal /= =><-. Qed.
-
-Global Instance from_modal_affinely_embed `{BiEmbed PROP PROP'} `(sel : A) P Q :
-  FromModal modality_affinely sel P Q →
-  FromModal modality_affinely sel ⎡P⎤ ⎡Q⎤ | 100.
-Proof. rewrite /FromModal /= =><-. by rewrite embed_affinely_2. Qed.
-Global Instance from_modal_persistently_embed `{BiEmbed PROP PROP'} `(sel : A) P Q :
-  FromModal modality_persistently sel P Q →
-  FromModal modality_persistently sel ⎡P⎤ ⎡Q⎤ | 100.
-Proof. rewrite /FromModal /= =><-. by rewrite embed_persistently. Qed.
-Global Instance from_modal_intuitionistically_embed `{BiEmbed PROP PROP'} `(sel : A) P Q :
-  FromModal modality_intuitionistically sel P Q →
-  FromModal modality_intuitionistically sel ⎡P⎤ ⎡Q⎤ | 100.
-Proof. rewrite /FromModal /= =><-. by rewrite embed_intuitionistically_2. Qed.
-
-Global Instance from_modal_bupd `{BiBUpd PROP} P :
-  FromModal modality_id (|==> P) (|==> P) P.
-Proof. by rewrite /FromModal /= -bupd_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.
@@ -355,30 +431,49 @@ Global Instance into_wand_wand p q P Q P' :
 Proof.
   rewrite /FromAssumption /IntoWand=> HP. by rewrite HP intuitionistically_if_elim.
 Qed.
-Global Instance into_wand_impl_false_false P Q P' :
-  Absorbing P' → Absorbing (P' → Q) →
-  FromAssumption false P P' → IntoWand false false (P' → Q) P Q.
-Proof.
-  rewrite /FromAssumption /IntoWand /= => ?? ->. apply wand_intro_r.
-  by rewrite sep_and impl_elim_l.
+(** 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' →
+  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.
-  by rewrite -persistently_and_intuitionistically_sep_l persistently_elim impl_elim_r.
+  apply wand_elim_r.
 Qed.
-Global Instance into_wand_impl_true_false P Q P' :
-  Affine P' → FromAssumption false P P' →
-  IntoWand true false (P' → Q) P Q.
+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 /FromAssumption /IntoWand /= => ? HP. apply wand_intro_r.
-  rewrite HP sep_and intuitionistically_elim impl_elim_l //.
+  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.
+  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 //.
@@ -402,18 +497,19 @@ Proof.
           -impl_wand_intuitionistically -pure_impl_forall
           bi.persistently_elim //.
 Qed.
-Global Instance into_wand_forall_prop_false p (φ : Prop) P :
-  Absorbing P → IntoWand p false (∀ _ : φ, P) ⌜ φ ⌝ P.
+Global Instance into_wand_forall_prop_false p (φ : Prop) Pφ P :
+  MakeAffinely ⌜ φ ⌝ Pφ →
+  IntoWand p false (∀ _ : φ, P) Pφ P.
 Proof.
-  intros ?.
-  rewrite /IntoWand (intuitionistically_if_elim p) /= pure_wand_forall //.
+  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 {A} p q (Φ : tele_arg A → PROP) P Q x :
+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.
 
@@ -421,12 +517,12 @@ 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)%I) HR. destruct q; simpl in *.
-    + rewrite (affinely_elim P) -{2}(affine_affinely (□ P)%I).
+  - 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)%I).
+    + 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.
@@ -443,8 +539,8 @@ 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)%I) HR. destruct q; simpl.
-  - rewrite (affinely_elim P) -{2}(affine_affinely (□ P)%I).
+  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.
@@ -459,69 +555,16 @@ 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.
 
-Global Instance into_wand_embed `{BiEmbed PROP PROP'} 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 ⎡RR⎤ ...] with the argument being
-[<affine> ⎡PP⎤]. When the wand [⎡RR⎤] resides in the intuitionistic context
-the result of wand elimination will have the affine modality. Otherwise, it
-won't. Note that when the wand [⎡RR⎤] is under an affine modality, the instance
-[into_wand_affine] would already have been used. *)
-Global Instance into_wand_affine_embed_true `{BiEmbed PROP PROP'} q (PP QQ RR : PROP) :
-  IntoWand true q RR PP QQ → IntoWand true q ⎡RR⎤ (<affine> ⎡PP⎤) (<affine> ⎡QQ⎤) | 100.
-Proof.
-  rewrite /IntoWand /=.
-  rewrite -(intuitionistically_idemp ⎡ _ ⎤%I) embed_intuitionistically_2=> ->.
-  apply bi.wand_intro_l. destruct q; simpl.
-  - rewrite affinely_elim  -(intuitionistically_idemp ⎡ _ ⎤%I).
-    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 `{BiEmbed PROP PROP'} q (PP QQ RR : PROP) :
-  IntoWand false q RR (<affine> PP) QQ → IntoWand false q ⎡RR⎤ (<affine> ⎡PP⎤) ⎡QQ⎤ | 100.
-Proof.
-  rewrite /IntoWand /= => ->.
-  by rewrite embed_affinely_2 embed_intuitionistically_if_2 embed_wand.
-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_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_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.
-
 (** 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.
-Global Instance from_wand_embed `{BiEmbed PROP PROP'} P Q1 Q2 :
-  FromWand P Q1 Q2 → FromWand ⎡P⎤ ⎡Q1⎤ ⎡Q2⎤.
-Proof. by rewrite /FromWand -embed_wand => <-. Qed.
 
 (** FromImpl *)
 Global Instance from_impl_impl P1 P2 : FromImpl (P1 → P2) P1 P2.
 Proof. by rewrite /FromImpl. Qed.
-Global Instance from_impl_embed `{BiEmbed PROP PROP'} P Q1 Q2 :
-  FromImpl P Q1 Q2 → FromImpl ⎡P⎤ ⎡Q1⎤ ⎡Q2⎤.
-Proof. by rewrite /FromImpl -embed_impl => <-. Qed.
 
 (** FromAnd *)
 Global Instance from_and_and P1 P2 : FromAnd (P1 ∧ P2) P1 P2 | 100.
@@ -553,10 +596,6 @@ Global Instance from_and_persistently_sep 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_embed `{BiEmbed PROP PROP'} P Q1 Q2 :
-  FromAnd P Q1 Q2 → FromAnd ⎡P⎤ ⎡Q1⎤ ⎡Q2⎤.
-Proof. by rewrite /FromAnd -embed_and => <-. Qed.
-
 Global Instance from_and_big_sepL_cons_persistent {A} (Φ : nat → A → PROP) l x l' :
   IsCons l x l' →
   Persistent (Φ 0 x) →
@@ -601,7 +640,7 @@ Proof. intros. by rewrite /FromAnd big_sepMS_disj_union persistent_and_sep_1. Qe
 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 (Absorbing P1) (Affine 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.
 
@@ -622,10 +661,6 @@ Global Instance from_sep_persistently P Q1 Q2 :
   FromSep (<pers> P) (<pers> Q1) (<pers> Q2).
 Proof. rewrite /FromSep=> <-. by rewrite persistently_sep_2. Qed.
 
-Global Instance from_sep_embed `{BiEmbed PROP PROP'} P Q1 Q2 :
-  FromSep P Q1 Q2 → FromSep ⎡P⎤ ⎡Q1⎤ ⎡Q2⎤.
-Proof. by rewrite /FromSep -embed_sep => <-. 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).
@@ -654,9 +689,52 @@ Global Instance from_sep_big_sepMS_disj_union `{Countable A} (Φ : A → PROP) X
   FromSep ([∗ mset] y ∈ X1 ⊎ X2, Φ y) ([∗ mset] y ∈ X1, Φ y) ([∗ mset] y ∈ X2, Φ y).
 Proof. by rewrite /FromSep big_sepMS_disj_union. 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.
+(** 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.
@@ -674,13 +752,14 @@ Proof.
   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.
+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 //.
+  rewrite /IntoAnd /= intuitionistically_sep
+    -and_sep_intuitionistically intuitionistically_and //.
 Qed.
-Global Instance into_and_sep_affine P Q :
-  TCOr (Affine P) (Absorbing Q) → TCOr (Absorbing P) (Affine Q) →
-  IntoAnd true (P ∗ Q) P Q.
+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 ⌜φ ∧ ψ⌝ ⌜φ⌝ ⌜ψ⌝.
@@ -708,12 +787,6 @@ Proof.
   - rewrite -persistently_and !intuitionistically_persistently_elim //.
   - intros ->. by rewrite persistently_and.
 Qed.
-Global Instance into_and_embed `{BiEmbed PROP PROP'} 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.
 
 (** IntoSep *)
 Global Instance into_sep_sep P Q : IntoSep (P ∗ Q) P Q.
@@ -721,7 +794,7 @@ 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)%I 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.
@@ -730,7 +803,7 @@ 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') -(affine_affinely P) affinely_and_lr.
+  - 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.
@@ -738,7 +811,7 @@ 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') -(affine_affinely Q) -affinely_and_lr.
+  - 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.
@@ -746,30 +819,26 @@ Qed.
 Global Instance into_sep_pure φ ψ : @IntoSep PROP ⌜φ ∧ ψ⌝ ⌜φ⌝ ⌜ψ⌝.
 Proof. by rewrite /IntoSep pure_and persistent_and_sep_1. Qed.
 
-Global Instance into_sep_embed `{BiEmbed PROP PROP'} P Q1 Q2 :
-  IntoSep P Q1 Q2 → IntoSep ⎡P⎤ ⎡Q1⎤ ⎡Q2⎤.
-Proof. rewrite /IntoSep -embed_sep=> -> //. Qed.
-
-Global Instance into_sep_affinely `{BiPositive PROP} P Q1 Q2 :
+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 :
+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 lower
-precedence. *)
+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 :
+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 (Absorbing Q1) (Affine Q2) →
+  TCOr (Affine Q1) (Absorbing Q2) → TCOr (Affine Q2) (Absorbing Q1) →
   IntoSep (<pers> P) (<pers> Q1) (<pers> Q2).
 Proof.
   rewrite /IntoSep /= => -> ??.
@@ -777,7 +846,7 @@ Proof.
 Qed.
 Global Instance into_sep_intuitionistically_affine P Q1 Q2 :
   IntoSep P Q1 Q2 →
-  TCOr (Affine Q1) (Absorbing Q2) → TCOr (Absorbing Q1) (Affine Q2) →
+  TCOr (Affine Q1) (Absorbing Q2) → TCOr (Affine Q2) (Absorbing Q1) →
   IntoSep (□ P) (□ Q1) (□ Q2).
 Proof.
   rewrite /IntoSep /= => -> ??.
@@ -825,16 +894,6 @@ 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.
-Global Instance from_or_embed `{BiEmbed PROP PROP'} P Q1 Q2 :
-  FromOr P Q1 Q2 → FromOr ⎡P⎤ ⎡Q1⎤ ⎡Q2⎤.
-Proof. by rewrite /FromOr -embed_or => <-. Qed.
-
-Global Instance from_or_bupd `{BiBUpd PROP} P Q1 Q2 :
-  FromOr P Q1 Q2 → FromOr (|==> P) (|==> Q1) (|==> Q2).
-Proof.
-  rewrite /FromOr=><-.
-  apply or_elim; apply bupd_mono; auto using or_intro_l, or_intro_r.
-Qed.
 
 (** IntoOr *)
 Global Instance into_or_or P Q : IntoOr (P ∨ Q) P Q.
@@ -854,14 +913,9 @@ 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.
-Global Instance into_or_embed `{BiEmbed PROP PROP'} P Q1 Q2 :
-  IntoOr P Q1 Q2 → IntoOr ⎡P⎤ ⎡Q1⎤ ⎡Q2⎤.
-Proof. by rewrite /IntoOr -embed_or => <-. Qed.
 
 (** FromExist *)
-Global Instance from_exist_exist {A} (Φ : A → PROP) : FromExist (∃ a, Φ a) Φ.
-Proof. by rewrite /FromExist. Qed.
-Global Instance from_exist_texist {A} (Φ : tele_arg A → PROP) :
+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) :
@@ -879,58 +933,69 @@ 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.
-Global Instance from_exist_embed `{BiEmbed PROP PROP'} {A} P (Φ : A → PROP) :
-  FromExist P Φ → FromExist ⎡P⎤ (λ a, ⎡Φ a⎤%I).
-Proof. by rewrite /FromExist -embed_exist => <-. Qed.
-
-Global Instance from_exist_bupd `{BiBUpd PROP} {A} P (Φ : A → PROP) :
-  FromExist P Φ → FromExist (|==> P) (λ a, |==> Φ a)%I.
-Proof.
-  rewrite /FromExist=><-. apply exist_elim=> a. by rewrite -(exist_intro a).
-Qed.
 
 (** IntoExist *)
-Global Instance into_exist_exist {A} (Φ : A → PROP) : IntoExist (∃ a, Φ a) Φ.
+
+(* 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_texist {A} (Φ : tele_arg A → PROP) :
-  IntoExist (∃.. a, Φ a) Φ | 10.
-Proof. by rewrite /IntoExist bi_texist_exist. Qed.
-Global Instance into_exist_pure {A} (φ : A → Prop) :
-  @IntoExist PROP A ⌜∃ x, φ x⌝ (λ a, ⌜φ a⌝)%I.
+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_affinely {A} P (Φ : A → PROP) :
-  IntoExist P Φ → IntoExist (<affine> P) (λ a, <affine> (Φ a))%I.
+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) :
-  IntoExist P Φ → IntoExist (□ P) (λ a, □ (Φ a))%I.
+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.
-Global Instance into_exist_and_pure P Q φ :
-  IntoPureT P φ → IntoExist (P ∧ Q) (λ _ : φ, Q).
-Proof.
-  intros (φ'&->&?). rewrite /IntoExist (into_pure P).
+(* 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.
-Global Instance into_exist_sep_pure P Q φ :
-  IntoPureT P φ → TCOr (Affine P) (Absorbing Q) → IntoExist (P ∗ Q) (λ _ : φ, Q).
+(* [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) :
-  IntoExist P Φ → IntoExist (<absorb> P) (λ a, <absorb> (Φ a))%I.
+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) :
-  IntoExist P Φ → IntoExist (<pers> P) (λ a, <pers> (Φ a))%I.
+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.
-Global Instance into_exist_embed `{BiEmbed PROP PROP'} {A} P (Φ : A → PROP) :
-  IntoExist P Φ → IntoExist ⎡P⎤ (λ a, ⎡Φ a⎤%I).
-Proof. by rewrite /IntoExist -embed_exist => <-. Qed.
 
 (** IntoForall *)
 Global Instance into_forall_forall {A} (Φ : A → PROP) : IntoForall (∀ a, Φ a) Φ.
 Proof. by rewrite /IntoForall. Qed.
-Global Instance into_forall_tforall {A} (Φ : tele_arg A → PROP) :
+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) :
@@ -939,57 +1004,65 @@ 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 {A} P (Φ : A → PROP) :
+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_embed `{BiEmbed PROP PROP'} {A} P (Φ : A → PROP) :
-  IntoForall P Φ → IntoForall ⎡P⎤ (λ a, ⎡Φ a⎤%I).
-Proof. by rewrite /IntoForall -embed_forall => <-. Qed.
 
-Global Instance into_forall_impl_pure φ P Q :
-  FromPureT false P φ → IntoForall (P → Q) (λ _ : φ, Q).
+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.
+  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 φ P Q :
-  FromPureT true P φ → IntoForall (P -∗ Q) (λ _ : φ, Q).
+Global Instance into_forall_wand_pure a φ P Q :
+  FromPureT a P φ → IntoForall (P -∗ Q) (λ _ : φ, Q).
 Proof.
   rewrite /FromPureT /FromPure /IntoForall=> -[φ' [-> <-]] /=.
-  apply forall_intro=>? /=.
-  by rewrite -(pure_intro _ True%I) // /bi_affinely right_id emp_wand.
+  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) (λ _ : bi_emp_valid P, Q) | 10.
+  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) (λ _ : bi_emp_valid P, Q) | 10.
-Proof. rewrite /IntoForall. apply forall_intro=><-. rewrite -True_emp True_impl //. Qed.
+  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) :
-  FromForall (∀ x, Φ x)%I Φ.
+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 {A} (Φ : tele_arg A → PROP) :
-  FromForall (∀.. x, Φ x)%I Φ.
+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 {A} (φ : A → Prop) :
-  @FromForall PROP A (⌜∀ a : A, φ a⌝)%I (λ a, ⌜ φ a ⌝)%I.
-Proof. by rewrite /FromForall pure_forall. Qed.
-Global Instance from_forall_pure_not (φ : Prop) :
-  @FromForall PROP φ (⌜¬ φ⌝)%I (λ a : φ, False)%I.
+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)%I (λ _ : φ, Q)%I.
+  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)%I (λ _ : φ, Q)%I.
+  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.
@@ -997,22 +1070,17 @@ Proof.
   - by rewrite (into_pure P) -pure_wand_forall wand_elim_l.
 Qed.
 
-Global Instance from_forall_intuitionistically `{BiAffine PROP} {A} P (Φ : A → PROP) :
-  FromForall P Φ → FromForall (□ P) (λ a, □ (Φ a))%I.
+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 {A} P (Φ : A → PROP) :
-  FromForall P Φ → FromForall (<pers> P)%I (λ a, <pers> (Φ a))%I.
+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.
-Global Instance from_forall_embed `{BiEmbed PROP PROP'} {A} P (Φ : A → PROP) :
-  FromForall P Φ → FromForall ⎡P⎤%I (λ a, ⎡Φ a⎤%I).
-Proof. by rewrite /FromForall -embed_forall => <-. Qed.
-
-(** IntoInv *)
-Global Instance into_inv_embed {PROP' : bi} `{BiEmbed PROP PROP'} P N :
-  IntoInv P N → IntoInv ⎡P⎤ N := {}.
 
 (** ElimModal *)
 Global Instance elim_modal_wand φ p p' P P' Q Q' R :
@@ -1026,10 +1094,15 @@ Global Instance elim_modal_wandM φ p p' P P' Q Q' mR :
   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).
+  (∀ 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.
@@ -1037,24 +1110,6 @@ Proof.
     absorbingly_sep_l wand_elim_r absorbing_absorbingly.
 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_embed_bupd_goal `{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 `{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.
-
 (** AddModal *)
 Global Instance add_modal_wand P P' Q R :
   AddModal P P' Q → AddModal P P' (R -∗ Q).
@@ -1070,25 +1125,20 @@ Global Instance add_modal_forall {A} P P' (Φ : A → PROP) :
 Proof.
   rewrite /AddModal=> H. apply forall_intro=> a. by rewrite (forall_elim a).
 Qed.
-Global Instance add_modal_embed_bupd_goal `{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_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_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}
-       φ Pinv Pin
-       M1 M2 α β mγ Q (Q' : X → PROP) :
-  IntoAcc (X:=X) Pinv φ Pin M1 M2 α β mγ →
-  ElimAcc (X:=X) M1 M2 α β mγ Q Q' →
-  ElimInv φ Pinv Pin α None Q Q'.
+     φ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 Hφ) "(Hinv & Hin & Hcont)".
-  iApply (Helim with "[Hcont]").
+  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.
@@ -1097,8 +1147,7 @@ Qed.
 [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 α β mγ Q Q' :
+    φ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
@@ -1111,12 +1160,4 @@ Proof.
   iMod (Hacc with "Hinv Hin") as (x) "[Hα Hclose]"; first done.
   iApply "Hcont". simpl. iSplitL "Hα"; done.
 Qed.
-
-(** IntoEmbed *)
-Global Instance into_embed_embed {PROP' : bi} `{BiEmbed PROP PROP'} P :
-  IntoEmbed ⎡P⎤ P.
-Proof. by rewrite /IntoEmbed. Qed.
-Global Instance into_embed_affinely `{BiEmbedBUpd PROP PROP'} (P : PROP') (Q : PROP) :
-  IntoEmbed P Q → IntoEmbed (<affine> P) (<affine> Q).
-Proof. rewrite /IntoEmbed=> ->. by rewrite embed_affinely_2. Qed.
-End bi_instances.
+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.

theories/proofmode/class_instances_sbi.v → iris/proofmode/class_instances_later.v

 From stdpp Require Import nat_cancel.
-From iris.bi Require Import bi tactics.
-From iris.proofmode Require Import base modality_instances classes class_instances_bi ltac_tactics.
-Set Default Proof Using "Type".
+From iris.proofmode Require Import classes classes_make modality_instances.
+From iris.prelude Require Import options.
 Import bi.
 
-Section sbi_instances.
-Context {PROP : sbi}.
+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)%I.
+  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)%I.
+  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)%I.
+  FromAssumption p P Q → KnownRFromAssumption p P (◇ Q).
 Proof. rewrite /KnownRFromAssumption /FromAssumption=>->. apply except_0_intro. Qed.
 
-Global Instance from_assumption_fupd `{BiBUpdFUpd PROP} E p P Q :
-  FromAssumption p P (|==> Q) → KnownRFromAssumption p P (|={E}=> Q)%I.
-Proof. rewrite /KnownRFromAssumption /FromAssumption=>->. apply bupd_fupd. Qed.
-
-Global Instance from_assumption_plainly_l_true `{BiPlainly PROP} 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 `{BiPlainly PROP, BiAffine PROP} P Q :
-  FromAssumption true P Q → KnownLFromAssumption false (■ P) Q.
-Proof.
-  rewrite /KnownLFromAssumption /FromAssumption /= =><-.
-  rewrite plainly_elim_persistently intuitionistically_into_persistently //.
-Qed.
-
 (** FromPure *)
-Global Instance from_pure_internal_eq af {A : ofeT} (a b : A) :
-  @FromPure PROP af (a ≡ b) (a ≡ b).
-Proof. by rewrite /FromPure pure_internal_eq affinely_if_elim. Qed.
 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) φ.
@@ -47,23 +26,6 @@ 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.
 
-Global Instance from_pure_fupd `{BiFUpd PROP} a E P φ :
-  FromPure a P φ → FromPure a (|={E}=> P) φ.
-Proof. rewrite /FromPure. intros <-. apply fupd_intro. Qed.
-
-Global Instance from_pure_plainly `{BiPlainly PROP} P φ :
-  FromPure false P φ → FromPure false (■ P) φ.
-Proof. rewrite /FromPure=> <-. by rewrite plainly_pure. Qed.
-
-(** IntoPure *)
-Global Instance into_pure_eq {A : ofeT} (a b : A) :
-  Discrete a → @IntoPure PROP (a ≡ b) (a ≡ b).
-Proof. intros. by rewrite /IntoPure discrete_eq. Qed.
-
-Global Instance into_pure_plainly `{BiPlainly PROP} P φ :
-  IntoPure P φ → IntoPure (■ P) φ.
-Proof. rewrite /IntoPure=> ->. apply: plainly_elim. Qed.
-
 (** IntoWand *)
 Global Instance into_wand_later p q R P Q :
   IntoWand p q R P Q → IntoWand p q (▷ R) (▷ P) (▷ Q).
@@ -76,7 +38,7 @@ Global Instance into_wand_later_args p q R P Q :
 Proof.
   rewrite /IntoWand' /IntoWand /= => HR.
   by rewrite !later_intuitionistically_if_2
-             (later_intro (□?p R)%I) -later_wand HR.
+             (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).
@@ -89,36 +51,9 @@ Global Instance into_wand_laterN_args n p q R P Q :
 Proof.
   rewrite /IntoWand' /IntoWand /= => HR.
   by rewrite !laterN_intuitionistically_if_2
-             (laterN_intro _ (□?p R)%I) -laterN_wand HR.
-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_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_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.
+             (laterN_intro _ (□?p R)) -laterN_wand HR.
 Qed.
 
-Global Instance into_wand_plainly_true `{BiPlainly PROP} 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 `{BiPlainly PROP} 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.
-
 (** FromAnd *)
 Global Instance from_and_later P Q1 Q2 :
   FromAnd P Q1 Q2 → FromAnd (▷ P) (▷ Q1) (▷ Q2).
@@ -130,10 +65,6 @@ 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.
 
-Global Instance from_and_plainly `{BiPlainly PROP} P Q1 Q2 :
-  FromAnd P Q1 Q2 → FromAnd (■ P) (■ Q1) (■ Q2).
-Proof. rewrite /FromAnd=> <-. by rewrite plainly_and. Qed.
-
 (** FromSep *)
 Global Instance from_sep_later P Q1 Q2 :
   FromSep P Q1 Q2 → FromSep (▷ P) (▷ Q1) (▷ Q2).
@@ -145,13 +76,35 @@ 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.
 
-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_sep_plainly `{BiPlainly PROP} P Q1 Q2 :
-  FromSep P Q1 Q2 → FromSep (■ P) (■ Q1) (■ Q2).
-Proof. rewrite /FromSep=> <-. by rewrite plainly_sep_2. 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 :
@@ -176,15 +129,6 @@ Proof.
              intuitionistically_if_elim except_0_and.
 Qed.
 
-Global Instance into_and_plainly `{BiPlainly PROP} 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.
-
 (** IntoSep *)
 Global Instance into_sep_later P Q1 Q2 :
   IntoSep P Q1 Q2 → IntoSep (▷ P) (▷ Q1) (▷ Q2).
@@ -203,23 +147,11 @@ Global Instance into_sep_affinely_later `{!Timeless (PROP:=PROP) emp} P Q1 Q2 :
 Proof.
   rewrite /IntoSep /= => -> ??.
   rewrite -{1}(affine_affinely Q1) -{1}(affine_affinely Q2) later_sep !later_affinely_1.
-  rewrite -except_0_sep /sbi_except_0 affinely_or. apply or_elim, affinely_elim.
+  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.
 
-Global Instance into_sep_plainly `{BiPlainly PROP, 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 `{BiPlainly PROP} P Q1 Q2 :
-  IntoSep P Q1 Q2 →
-  TCOr (Affine Q1) (Absorbing Q2) → TCOr (Absorbing Q1) (Affine Q2) →
-  IntoSep (■ P) (■ Q1) (■ Q2).
-Proof.
-  rewrite /IntoSep /= => -> ??. by rewrite sep_and plainly_and plainly_and_sep_l_1.
-Qed.
-
 (** FromOr *)
 Global Instance from_or_later P Q1 Q2 :
   FromOr P Q1 Q2 → FromOr (▷ P) (▷ Q1) (▷ Q2).
@@ -231,17 +163,6 @@ 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.
 
-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 or_elim; apply fupd_mono;
-                         [apply bi.or_intro_l|apply bi.or_intro_r].
-Qed.
-
-Global Instance from_or_plainly `{BiPlainly PROP} P Q1 Q2 :
-  FromOr P Q1 Q2 → FromOr (■ P) (■ Q1) (■ Q2).
-Proof. rewrite /FromOr=> <-. by rewrite -plainly_or_2. Qed.
-
 (** IntoOr *)
 Global Instance into_or_later P Q1 Q2 :
   IntoOr P Q1 Q2 → IntoOr (▷ P) (▷ Q1) (▷ Q2).
@@ -253,10 +174,6 @@ 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.
 
-Global Instance into_or_plainly `{BiPlainly PROP, BiPlainlyExist PROP} P Q1 Q2 :
-  IntoOr P Q1 Q2 → IntoOr (■ P) (■ Q1) (■ Q2).
-Proof. rewrite /IntoOr=>->. by rewrite plainly_or. Qed.
-
 (** FromExist *)
 Global Instance from_exist_later {A} P (Φ : A → PROP) :
   FromExist P Φ → FromExist (▷ P) (λ a, ▷ (Φ a))%I.
@@ -272,31 +189,17 @@ 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.
 
-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 exist_elim=> a. by rewrite -(exist_intro a).
-Qed.
-
-Global Instance from_exist_plainly `{BiPlainly PROP} {A} P (Φ : A → PROP) :
-  FromExist P Φ → FromExist (■ P) (λ a, ■ (Φ a))%I.
-Proof. rewrite /FromExist=> <-. by rewrite -plainly_exist_2. Qed.
-
 (** IntoExist *)
-Global Instance into_exist_later {A} P (Φ : A → PROP) :
-  IntoExist P Φ → Inhabited A → IntoExist (▷ P) (λ a, ▷ (Φ a))%I.
+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) :
-  IntoExist P Φ → Inhabited A → IntoExist (▷^n P) (λ a, ▷^n (Φ a))%I.
+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) :
-  IntoExist P Φ → Inhabited A → IntoExist (◇ P) (λ a, ◇ (Φ a))%I.
+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.
 
-Global Instance into_exist_plainly `{BiPlainlyExist PROP} {A} P (Φ : A → PROP) :
-  IntoExist P Φ → IntoExist (■ P) (λ a, ■ (Φ a))%I.
-Proof. rewrite /IntoExist=> HP. by rewrite HP plainly_exist. Qed.
-
 (** IntoForall *)
 Global Instance into_forall_later {A} P (Φ : A → PROP) :
   IntoForall P Φ → IntoForall (▷ P) (λ a, ▷ (Φ a))%I.
@@ -310,115 +213,36 @@ 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.
 
-Global Instance into_forall_plainly `{BiPlainly PROP} {A} P (Φ : A → PROP) :
-  IntoForall P Φ → IntoForall (■ P) (λ a, ■ (Φ a))%I.
-Proof. rewrite /IntoForall=> HP. by rewrite HP plainly_forall. Qed.
-
 (** FromForall *)
-Global Instance from_forall_later {A} P (Φ : A → PROP) :
-  FromForall P Φ → FromForall (▷ P)%I (λ a, ▷ (Φ a))%I.
+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 :
-      FromForall P Φ → FromForall (▷^n P)%I (λ a, ▷^n (Φ a))%I.
+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) :
-  FromForall P Φ → FromForall (◇ P)%I (λ a, ◇ (Φ a))%I.
+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.
 
-Global Instance from_forall_plainly `{BiPlainly PROP} {A} P (Φ : A → PROP) :
-  FromForall P Φ → FromForall (■ P)%I (λ a, ■ (Φ a))%I.
-Proof. rewrite /FromForall=> <-. by rewrite plainly_forall. Qed.
-
-Global Instance from_forall_fupd `{BiFUpdPlainly PROP} E1 E2 {A} P (Φ : A → PROP) :
-  (* Some cases in which [E2 ⊆ E1] holds *)
-  TCOr (TCEq E1 E2) (TCOr (TCEq E1 ⊤) (TCEq E2 ∅)) →
-  FromForall P Φ → (∀ x, Plain (Φ x)) →
-  FromForall (|={E1,E2}=> P)%I (λ a, |={E1,E2}=> (Φ a))%I.
-Proof.
-  rewrite /FromForall=> -[->|[->|->]] <- ?; rewrite fupd_plain_forall; set_solver.
-Qed.
-
-Global Instance from_forall_step_fupd `{BiFUpdPlainly PROP} E1 E2 {A} P (Φ : A → PROP) :
-  (* Some cases in which [E2 ⊆ E1] holds *)
-  TCOr (TCEq E1 E2) (TCOr (TCEq E1 ⊤) (TCEq E2 ∅)) →
-  FromForall P Φ → (∀ x, Plain (Φ x)) →
-  FromForall (|={E1,E2}▷=> P)%I (λ a, |={E1,E2}▷=> (Φ a))%I.
-Proof.
-  rewrite /FromForall=> -[->|[->|->]] <- ?; rewrite step_fupd_plain_forall; set_solver.
-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.
-Global Instance is_except_0_embed `{SbiEmbed PROP PROP'} P :
-  IsExcept0 P → IsExcept0 ⎡P⎤.
-Proof. by rewrite /IsExcept0 -embed_except_0=>->. 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.
 
 (** FromModal *)
 Global Instance from_modal_later P :
-  FromModal (modality_laterN 1) (▷^1 P) (▷ P) P.
+  FromModal True (modality_laterN 1) (▷^1 P) (▷ P) P.
 Proof. by rewrite /FromModal. Qed.
 Global Instance from_modal_laterN n P :
-  FromModal (modality_laterN n) (▷^n P) (▷^n P) P.
+  FromModal True (modality_laterN n) (▷^n P) (▷^n P) P.
 Proof. by rewrite /FromModal. Qed.
-Global Instance from_modal_except_0 P : FromModal modality_id (◇ P) (◇ P) P.
+Global Instance from_modal_except_0 P :
+  FromModal True modality_id (◇ P) (◇ P) P.
 Proof. by rewrite /FromModal /= -except_0_intro. Qed.
 
-Global Instance from_modal_fupd E P `{BiFUpd PROP} :
-  FromModal modality_id (|={E}=> P) (|={E}=> P) P.
-Proof. by rewrite /FromModal /= -fupd_intro. Qed.
-
-Global Instance from_modal_later_embed `{SbiEmbed PROP PROP'} `(sel : A) n P Q :
-  FromModal (modality_laterN n) sel P Q →
-  FromModal (modality_laterN n) sel ⎡P⎤ ⎡Q⎤.
-Proof. rewrite /FromModal /= =><-. by rewrite embed_laterN. Qed.
-
-Global Instance from_modal_plainly `{BiPlainly PROP} P :
-  FromModal modality_plainly (■ P) (■ P) P | 2.
-Proof. by rewrite /FromModal. Qed.
-
-Global Instance from_modal_plainly_embed `{BiPlainly PROP, BiPlainly PROP',
-    BiEmbedPlainly PROP PROP', !SbiEmbed PROP PROP'} `(sel : A) P Q :
-  FromModal modality_plainly sel P Q →
-  FromModal modality_plainly sel ⎡P⎤ ⎡Q⎤ | 100.
-Proof. rewrite /FromModal /= =><-. by rewrite embed_plainly. Qed.
-
-(** IntoInternalEq *)
-Global Instance into_internal_eq_internal_eq {A : ofeT} (x y : A) :
-  @IntoInternalEq PROP A (x ≡ y) x y.
-Proof. by rewrite /IntoInternalEq. Qed.
-Global Instance into_internal_eq_affinely {A : ofeT} (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 : ofeT} (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 : ofeT} (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 : ofeT} (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 : ofeT} (x y : A) P :
-  IntoInternalEq P x y → IntoInternalEq (<pers> P) x y.
-Proof. rewrite /IntoInternalEq=> ->. by rewrite persistently_elim. Qed.
-Global Instance into_internal_eq_embed
-       `{SbiEmbed PROP PROP'} {A : ofeT} (x y : A) P :
-  IntoInternalEq P x y → IntoInternalEq ⎡P⎤ x y.
-Proof. rewrite /IntoInternalEq=> ->. by rewrite embed_internal_eq. Qed.
-
 (** IntoExcept0 *)
 Global Instance into_except_0_except_0 P : IntoExcept0 (◇ P) P.
 Proof. by rewrite /IntoExcept0. Qed.
@@ -436,105 +260,43 @@ 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_plainly `{BiPlainly PROP, BiPlainlyExist PROP} P Q :
-  IntoExcept0 P Q → IntoExcept0 (■ P) (■ Q).
-Proof. rewrite /IntoExcept0=> ->. by rewrite except_0_plainly. 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.
-Global Instance into_except_0_embed `{SbiEmbed PROP PROP'} P Q :
-  IntoExcept0 P Q → IntoExcept0 ⎡P⎤ ⎡Q⎤.
-Proof. rewrite /IntoExcept0=> ->. by rewrite embed_except_0. Qed.
 
 (** ElimModal *)
-Global Instance elim_modal_timeless p P Q :
+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 (_ -∗ _)%I) (into_except_0 P).
+  intros. rewrite /ElimModal (except_0_intro (_ -∗ _)) (into_except_0 P).
   by rewrite except_0_intuitionistically_if_2 -except_0_sep wand_elim_r.
 Qed.
 
-Global Instance elim_modal_bupd_plain_goal `{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_plain.
-Qed.
-Global Instance elim_modal_bupd_plain `{BiBUpdPlainly PROP} p P Q :
-  Plain P → ElimModal True p p (|==> P) P Q Q.
-Proof. intros. by rewrite /ElimModal bupd_plain wand_elim_r. Qed.
-Global Instance elim_modal_bupd_fupd `{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_embed_fupd_goal `{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 `{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.
-
 (** AddModal *)
-(* High priority to add a ▷ rather than a ◇ when P is timeless. *)
+(* 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 (_ -∗ _)%I) (timeless P).
+  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 (_ -∗ _)%I) (timeless P).
+  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 (_ -∗ _)%I).
+  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 (_ -∗ _)%I).
+  intros. rewrite /AddModal (except_0_intro (_ -∗ _)).
   by rewrite -except_0_sep wand_elim_r except_0_later.
 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 add_modal_embed_fupd_goal `{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.
-
-(** ElimAcc *)
-Global Instance elim_acc_fupd `{BiFUpd PROP} {X} E1 E2 E α β mγ Q :
-  (* FIXME: Why %I? ElimAcc sets the right scopes! *)
-  ElimAcc (X:=X) (fupd E1 E2) (fupd E2 E1) α β mγ
-          (|={E1,E}=> Q)
-          (λ x, |={E2}=> β x ∗ (mγ x -∗? |={E1,E}=> Q))%I.
-Proof.
-  rewrite /ElimAcc.
-  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.
-
 (** IntoAcc *)
 (* TODO: We could have instances from "unfolded" accessors with or without
    the first binder. *)
@@ -550,12 +312,16 @@ Global Instance into_laterN_later only_head n n' m' P Q lQ :
   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_plus -Hn Nat.add_comm.
+    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' →
@@ -564,7 +330,7 @@ Global Instance into_laterN_laterN only_head n m n' m' P Q lQ :
   IntoLaterN only_head n (▷^m P) lQ | 1.
 Proof.
   rewrite /MakeLaterN /IntoLaterN /MaybeIntoLaterN /NatCancel.
-  move=> Hn [_ ->|->] <-; by rewrite -!laterN_plus -Hn Nat.add_comm.
+  move=> Hn [_ ->|->] <-; by rewrite -!laterN_add -Hn Nat.add_comm.
 Qed.
 
 Global Instance into_laterN_and_l n P1 P2 Q1 Q2 :
@@ -606,15 +372,9 @@ Proof. rewrite /IntoLaterN /MaybeIntoLaterN=> ->. by rewrite laterN_intuitionist
 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_plainly `{BiPlainly PROP} n P Q :
-  IntoLaterN false n P Q → IntoLaterN false n (■ P) (■ Q).
-Proof. rewrite /IntoLaterN /MaybeIntoLaterN=> ->. by rewrite laterN_plainly. 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_later_embed`{SbiEmbed PROP PROP'} n P Q :
-  IntoLaterN false n P Q → IntoLaterN false n ⎡P⎤ ⎡Q⎤.
-Proof. rewrite /IntoLaterN /MaybeIntoLaterN=> ->. by rewrite embed_laterN. Qed.
 
 Global Instance into_laterN_sep_l n P1 P2 Q1 Q2 :
   IntoLaterN false n P1 Q1 → MaybeIntoLaterN false n P2 Q2 →
@@ -650,6 +410,14 @@ 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)) →
@@ -666,4 +434,4 @@ Proof.
   rewrite /IntoLaterN /MaybeIntoLaterN=> ?.
   rewrite big_opMS_commute. by apply big_sepMS_mono.
 Qed.
-End sbi_instances.
+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.

theories/proofmode/classes.v → 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 modalities.
-From stdpp Require Import namespaces.
-Set Default Proof Using "Type".
+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.
-Arguments FromAssumption {_} _ _%I _%I : simpl never.
-Arguments from_assumption {_} _ _%I _%I {_}.
-Hint Mode FromAssumption + + - - : typeclass_instances.
+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) :=
-  knownl_from_assumption :> FromAssumption p P Q.
-Arguments KnownLFromAssumption {_} _ _%I _%I : simpl never.
-Arguments knownl_from_assumption {_} _ _%I _%I {_}.
-Hint Mode KnownLFromAssumption + + ! - : typeclass_instances.
+  #[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) :=
-  knownr_from_assumption :> FromAssumption p P Q.
-Arguments KnownRFromAssumption {_} _ _%I _%I : simpl never.
-Arguments knownr_from_assumption {_} _ _%I _%I {_}.
-Hint Mode KnownRFromAssumption + + - ! : typeclass_instances.
+  #[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 ⊢ ⌜φ⌝.
-Arguments IntoPure {_} _%I _%type_scope : simpl never.
-Arguments into_pure {_} _%I _%type_scope {_}.
-Hint Mode IntoPure + ! - : typeclass_instances.
+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
@@ -53,50 +58,47 @@ 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.
-Hint Extern 0 (IntoPureT _ _) =>
+Global Hint Extern 0 (IntoPureT _ _) =>
   notypeclasses refine (into_pureT_hint _ _ _) : typeclass_instances.
 
-(** [FromPure] is used when introducing a pure assertion. It is used
-    by iPure, the "[%]" specialization pattern, and the [with "[%]"]
-    pattern when using [iAssert].
+(** [FromPure a P φ] is used when introducing a pure assertion. It is used by
+[iPureIntro] and the [[%]] specialization pattern.
 
-    The [a] Boolean asserts whether we introduce the pure assertion in
-    an affine way or in an absorbing way. When [FromPure true P φ] is
-    derived, then [FromPure false P φ] can always be derived too. We
-    use [true] for specialization patterns and [false] for the
-    [iPureIntro] tactic.
+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.
 
-    This Boolean is not needed for [IntoPure], because in the case of
-    [IntoPure], we can have the same behavior by asking that [P] be
-    [Affine]. *)
+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.
-Arguments FromPure {_} _ _%I _%type_scope : simpl never.
-Arguments from_pure {_} _ _%I _%type_scope {_}.
-Hint Mode FromPure + + ! - : typeclass_instances.
+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.
-Hint Extern 0 (FromPureT _ _ _) =>
+Global Hint Extern 0 (FromPureT _ _ _) =>
   notypeclasses refine (from_pureT_hint _ _ _ _) : typeclass_instances.
 
-Class IntoInternalEq {PROP : sbi} {A : ofeT} (P : PROP) (x y : A) :=
+Class IntoInternalEq `{BiInternalEq PROP} {A : ofe} (P : PROP) (x y : A) :=
   into_internal_eq : P ⊢ x ≡ y.
-Arguments IntoInternalEq {_ _} _%I _%type_scope _%type_scope : simpl never.
-Arguments into_internal_eq {_ _} _%I _%type_scope _%type_scope {_}.
-Hint Mode IntoInternalEq + - ! - - : typeclass_instances.
+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.
-Arguments IntoPersistent {_} _ _%I _%I : simpl never.
-Arguments into_persistent {_} _ _%I _%I {_}.
-Hint Mode IntoPersistent + + ! - : typeclass_instances.
+Global Arguments IntoPersistent {_} _ _%_I _%_I : simpl never.
+Global Arguments into_persistent {_} _ _%_I _%_I {_}.
+Global Hint Mode IntoPersistent + + ! - : typeclass_instances.
 
-(** The [FromModal M P Q] class is used by the [iModIntro] tactic to transform
-a goal [P] into a modality [M] and proposition [Q].
+(** 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].
 
@@ -107,16 +109,16 @@ 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 modality_id (N P) P]. Defining such an
+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}
-    (M : modality PROP1 PROP2) (sel : A) (P : PROP2) (Q : PROP1) :=
-  from_modal : M Q ⊢ P.
-Arguments FromModal {_ _ _} _ _%I _%I _%I : simpl never.
-Arguments from_modal {_ _ _} _ _ _%I _%I {_}.
-Hint Mode FromModal - + - - - ! - : typeclass_instances.
+    (φ : 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].
@@ -124,9 +126,9 @@ proposition [Q].
 The input is [Q] and the output is [P]. *)
 Class FromAffinely {PROP : bi} (P Q : PROP) :=
   from_affinely : <affine> Q ⊢ P.
-Arguments FromAffinely {_} _%I _%I : simpl never.
-Arguments from_affinely {_} _%I _%I {_}.
-Hint Mode FromAffinely + - ! : typeclass_instances.
+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].
@@ -134,112 +136,191 @@ the proposition [Q].
 The input is [Q] and the output is [P]. *)
 Class IntoAbsorbingly {PROP : bi} (P Q : PROP) :=
   into_absorbingly : P ⊢ <absorb> Q.
-Arguments IntoAbsorbingly {_} _%I _%I.
-Arguments into_absorbingly {_} _%I _%I {_}.
-Hint Mode IntoAbsorbingly + - ! : typeclass_instances.
+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:
+(** 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.
-*)
-
+- 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.
-Arguments IntoWand {_} _ _ _%I _%I _%I : simpl never.
-Arguments into_wand {_} _ _ _%I _%I _%I {_}.
-Hint Mode IntoWand + + + ! - - : typeclass_instances.
+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.
-Arguments IntoWand' {_} _ _ _%I _%I _%I : simpl never.
-Hint Mode IntoWand' + + + ! ! - : typeclass_instances.
-Hint Mode IntoWand' + + + ! - ! : typeclass_instances.
+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.
-Arguments FromWand {_} _%I _%I _%I : simpl never.
-Arguments from_wand {_} _%I _%I _%I {_}.
-Hint Mode FromWand + ! - - : typeclass_instances.
+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.
-Arguments FromImpl {_} _%I _%I _%I : simpl never.
-Arguments from_impl {_} _%I _%I _%I {_}.
-Hint Mode FromImpl + ! - - : typeclass_instances.
+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.
-Arguments FromSep {_} _%I _%I _%I : simpl never.
-Arguments from_sep {_} _%I _%I _%I {_}.
-Hint Mode FromSep + ! - - : typeclass_instances.
-Hint Mode FromSep + - ! ! : typeclass_instances. (* For iCombine *)
+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.
-Arguments FromAnd {_} _%I _%I _%I : simpl never.
-Arguments from_and {_} _%I _%I _%I {_}.
-Hint Mode FromAnd + ! - - : typeclass_instances.
-Hint Mode FromAnd + - ! ! : typeclass_instances. (* For iCombine *)
-
+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).
-Arguments IntoAnd {_} _ _%I _%I _%I : simpl never.
-Arguments into_and {_} _ _%I _%I _%I {_}.
-Hint Mode IntoAnd + + ! - - : typeclass_instances.
+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.
-Arguments IntoSep {_} _%I _%I _%I : simpl never.
-Arguments into_sep {_} _%I _%I _%I {_}.
-Hint Mode IntoSep + ! - - : typeclass_instances.
+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.
-Arguments FromOr {_} _%I _%I _%I : simpl never.
-Arguments from_or {_} _%I _%I _%I {_}.
-Hint Mode FromOr + ! - - : typeclass_instances.
+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.
-Arguments IntoOr {_} _%I _%I _%I : simpl never.
-Arguments into_or {_} _%I _%I _%I {_}.
-Hint Mode IntoOr + ! - - : typeclass_instances.
+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.
-Arguments FromExist {_ _} _%I _%I : simpl never.
-Arguments from_exist {_ _} _%I _%I {_}.
-Hint Mode FromExist + - ! - : typeclass_instances.
+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) :=
+Class IntoExist {PROP : bi} {A} (P : PROP) (Φ : A → PROP) (name: ident_name) :=
   into_exist : P ⊢ ∃ x, Φ x.
-Arguments IntoExist {_ _} _%I _%I : simpl never.
-Arguments into_exist {_ _} _%I _%I {_}.
-Hint Mode IntoExist + - ! - : typeclass_instances.
+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.
-Arguments IntoForall {_ _} _%I _%I : simpl never.
-Arguments into_forall {_ _} _%I _%I {_}.
-Hint Mode IntoForall + - ! - : typeclass_instances.
+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) :=
+Class FromForall {PROP : bi} {A} (P : PROP) (Φ : A → PROP) (name : ident_name) :=
   from_forall : (∀ x, Φ x) ⊢ P.
-Arguments FromForall {_ _} _%I _%I : simpl never.
-Arguments from_forall {_ _} _%I _%I {_}.
-Hint Mode FromForall + - ! - : typeclass_instances.
+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.
 
-Class IsExcept0 {PROP : sbi} (Q : PROP) := is_except_0 : ◇ Q ⊢ Q.
-Arguments IsExcept0 {_} _%I : simpl never.
-Arguments is_except_0 {_} _%I {_}.
-Hint Mode IsExcept0 + ! : typeclass_instances.
+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 simultaniously transformed into [Q']. The Booleans [p]
+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]).
@@ -255,17 +336,17 @@ 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.
-Arguments ElimModal {_} _ _ _ _%I _%I _%I _%I : simpl never.
-Arguments elim_modal {_} _ _ _ _%I _%I _%I _%I {_}.
-Hint Mode ElimModal + - ! - ! - ! - : typeclass_instances.
+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.
-Arguments AddModal {_} _%I _%I _%I : simpl never.
-Arguments add_modal {_} _%I _%I _%I {_}.
-Hint Mode AddModal + - ! ! : typeclass_instances.
+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.
@@ -278,148 +359,84 @@ 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.
 
-Instance is_cons_cons {A} (x : A) (l : list A) : IsCons (x :: l) x l.
+Global Instance is_cons_cons {A} (x : A) (l : list A) : IsCons (x :: l) x l.
 Proof. done. Qed.
-Instance is_app_app {A} (l1 l2 : list A) : IsApp (l1 ++ l2) l1 l2.
+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.
-Arguments Frame {_} _ _%I _%I _%I.
-Arguments frame {_ _} _%I _%I _%I {_}.
-Hint Mode Frame + + ! ! - : typeclass_instances.
+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. *)
-Class MaybeFrame {PROP : bi} (p : bool) (R P Q : PROP) (progress : bool) :=
+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.
-Arguments MaybeFrame {_} _ _%I _%I _%I _.
-Arguments maybe_frame {_} _ _%I _%I _%I _ {_}.
-Hint Mode MaybeFrame + + ! - - - : typeclass_instances.
+Global Arguments MaybeFrame' {_} _ _%_I _%_I _%_I _.
+Global Arguments maybe_frame {_} _ _%_I _%_I _%_I _ {_}.
+Global Hint Mode MaybeFrame' + + ! - - - : typeclass_instances.
 
-Instance maybe_frame_frame {PROP : bi} p (R P Q : PROP) :
-  Frame p R P Q → MaybeFrame p R P Q true.
+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.
 
-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.
-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.
-
-(* For each of the [MakeXxxx] class, there is a [KnownMakeXxxx]
-   variant, that only succeeds if the parameter(s) is not an evar. In
-   the case the parameter(s) is an evar, then [MakeXxxx] will not
-   instantiate it arbitrarily.
-
-   The reason for this is that if given an evar, these typeclasses
-   would typically try to instantiate this evar with some arbitrary
-   logical constructs such as emp or True. Therefore, we use an Hint
-   Mode to disable all the instances that would have this behavior. *)
-Class MakeEmbed {PROP PROP' : bi} `{BiEmbed PROP PROP'} (P : PROP) (Q : PROP') :=
-  make_embed : ⎡P⎤ ⊣⊢ Q.
-Arguments MakeEmbed {_ _ _} _%I _%I.
-Hint Mode MakeEmbed + + + - - : typeclass_instances.
-Class KnownMakeEmbed {PROP PROP' : bi} `{BiEmbed PROP PROP'} (P : PROP) (Q : PROP') :=
-  known_make_embed :> MakeEmbed P Q.
-Arguments KnownMakeEmbed {_ _ _} _%I _%I.
-Hint Mode KnownMakeEmbed + + + ! - : typeclass_instances.
-
-Class MakeSep {PROP : bi} (P Q PQ : PROP) := make_sep : P ∗ Q ⊣⊢ PQ .
-Arguments MakeSep {_} _%I _%I _%I.
-Hint Mode MakeSep + - - - : typeclass_instances.
-Class KnownLMakeSep {PROP : bi} (P Q PQ : PROP) :=
-  knownl_make_sep :> MakeSep P Q PQ.
-Arguments KnownLMakeSep {_} _%I _%I _%I.
-Hint Mode KnownLMakeSep + ! - - : typeclass_instances.
-Class KnownRMakeSep {PROP : bi} (P Q PQ : PROP) :=
-  knownr_make_sep :> MakeSep P Q PQ.
-Arguments KnownRMakeSep {_} _%I _%I _%I.
-Hint Mode KnownRMakeSep + - ! - : typeclass_instances.
-
-Class MakeAnd {PROP : bi} (P Q PQ : PROP) :=  make_and_l : P ∧ Q ⊣⊢ PQ.
-Arguments MakeAnd {_} _%I _%I _%I.
-Hint Mode MakeAnd + - - - : typeclass_instances.
-Class KnownLMakeAnd {PROP : bi} (P Q PQ : PROP) :=
-  knownl_make_and :> MakeAnd P Q PQ.
-Arguments KnownLMakeAnd {_} _%I _%I _%I.
-Hint Mode KnownLMakeAnd + ! - - : typeclass_instances.
-Class KnownRMakeAnd {PROP : bi} (P Q PQ : PROP) :=
-  knownr_make_and :> MakeAnd P Q PQ.
-Arguments KnownRMakeAnd {_} _%I _%I _%I.
-Hint Mode KnownRMakeAnd + - ! - : typeclass_instances.
-
-Class MakeOr {PROP : bi} (P Q PQ : PROP) := make_or_l : P ∨ Q ⊣⊢ PQ.
-Arguments MakeOr {_} _%I _%I _%I.
-Hint Mode MakeOr + - - - : typeclass_instances.
-Class KnownLMakeOr {PROP : bi} (P Q PQ : PROP) :=
-  knownl_make_or :> MakeOr P Q PQ.
-Arguments KnownLMakeOr {_} _%I _%I _%I.
-Hint Mode KnownLMakeOr + ! - - : typeclass_instances.
-Class KnownRMakeOr {PROP : bi} (P Q PQ : PROP) := knownr_make_or :> MakeOr P Q PQ.
-Arguments KnownRMakeOr {_} _%I _%I _%I.
-Hint Mode KnownRMakeOr + - ! - : typeclass_instances.
-
-Class MakeAffinely {PROP : bi} (P Q : PROP) :=
-  make_affinely : <affine> P ⊣⊢ Q.
-Arguments MakeAffinely {_} _%I _%I.
-Hint Mode MakeAffinely + - - : typeclass_instances.
-Class KnownMakeAffinely {PROP : bi} (P Q : PROP) :=
-  known_make_affinely :> MakeAffinely P Q.
-Arguments KnownMakeAffinely {_} _%I _%I.
-Hint Mode KnownMakeAffinely + ! - : typeclass_instances.
-
-Class MakeIntuitionistically {PROP : bi} (P Q : PROP) :=
-  make_intuitionistically : □ P ⊣⊢ Q.
-Arguments MakeIntuitionistically {_} _%I _%I.
-Hint Mode MakeIntuitionistically + - - : typeclass_instances.
-Class KnownMakeIntuitionistically {PROP : bi} (P Q : PROP) :=
-  known_make_intuitionistically :> MakeIntuitionistically P Q.
-Arguments KnownMakeIntuitionistically {_} _%I _%I.
-Hint Mode KnownMakeIntuitionistically + ! - : typeclass_instances.
-
-Class MakeAbsorbingly {PROP : bi} (P Q : PROP) :=
-  make_absorbingly : <absorb> P ⊣⊢ Q.
-Arguments MakeAbsorbingly {_} _%I _%I.
-Hint Mode MakeAbsorbingly + - - : typeclass_instances.
-Class KnownMakeAbsorbingly {PROP : bi} (P Q : PROP) :=
-  known_make_absorbingly :> MakeAbsorbingly P Q.
-Arguments KnownMakeAbsorbingly {_} _%I _%I.
-Hint Mode KnownMakeAbsorbingly + ! - : typeclass_instances.
-
-Class MakePersistently {PROP : bi} (P Q : PROP) :=
-  make_persistently : <pers> P ⊣⊢ Q.
-Arguments MakePersistently {_} _%I _%I.
-Hint Mode MakePersistently + - - : typeclass_instances.
-Class KnownMakePersistently {PROP : bi} (P Q : PROP) :=
-  known_make_persistently :> MakePersistently P Q.
-Arguments KnownMakePersistently {_} _%I _%I.
-Hint Mode KnownMakePersistently + ! - : typeclass_instances.
-
-Class MakeLaterN {PROP : sbi} (n : nat) (P lP : PROP) :=
-  make_laterN : ▷^n P ⊣⊢ lP.
-Arguments MakeLaterN {_} _%nat _%I _%I.
-Hint Mode MakeLaterN + + - - : typeclass_instances.
-Class KnownMakeLaterN {PROP : sbi} (n : nat) (P lP : PROP) :=
-  known_make_laterN :> MakeLaterN n P lP.
-Arguments KnownMakeLaterN {_} _%nat _%I _%I.
-Hint Mode KnownMakeLaterN + + ! - : typeclass_instances.
-
-Class MakeExcept0 {PROP : sbi} (P Q : PROP) :=
-  make_except_0 : sbi_except_0 P ⊣⊢ Q.
-Arguments MakeExcept0 {_} _%I _%I.
-Hint Mode MakeExcept0 + - - : typeclass_instances.
-Class KnownMakeExcept0 {PROP : sbi} (P Q : PROP) :=
-  known_make_except_0 :> MakeExcept0 P Q.
-Arguments KnownMakeExcept0 {_} _%I _%I.
-Hint Mode KnownMakeExcept0 + ! - : typeclass_instances.
-
-Class IntoExcept0 {PROP : sbi} (P Q : PROP) := into_except_0 : P ⊢ ◇ Q.
-Arguments IntoExcept0 {_} _%I _%I : simpl never.
-Arguments into_except_0 {_} _%I _%I {_}.
-Hint Mode IntoExcept0 + ! - : typeclass_instances.
-Hint Mode IntoExcept0 + - ! : typeclass_instances.
+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:
 
@@ -455,24 +472,24 @@ Lemma test_iFrame_later_1 P Q : P ∗ ▷ Q -∗ ▷ (P ∗ ▷ Q).
 Proof. iIntros "H". iFrame "H". Qed.
 >>
 *)
-Class MaybeIntoLaterN {PROP : sbi} (only_head : bool) (n : nat) (P Q : PROP) :=
+Class MaybeIntoLaterN {PROP : bi} (only_head : bool) (n : nat) (P Q : PROP) :=
   maybe_into_laterN : P ⊢ ▷^n Q.
-Arguments MaybeIntoLaterN {_} _ _%nat_scope _%I _%I.
-Arguments maybe_into_laterN {_} _ _%nat_scope _%I _%I {_}.
-Hint Mode MaybeIntoLaterN + + + - - : typeclass_instances.
+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 : sbi} (only_head : bool) (n : nat) (P Q : PROP) :=
-  into_laterN :> MaybeIntoLaterN only_head n P Q.
-Arguments IntoLaterN {_} _ _%nat_scope _%I _%I.
-Hint Mode IntoLaterN + + + ! - : 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.
 
-Instance maybe_into_laterN_default {PROP : sbi} only_head n (P : PROP) :
+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. *)
-Instance maybe_into_laterN_default_0 {PROP : sbi} only_head (P : PROP) :
+Global Instance maybe_into_laterN_default_0 {PROP : bi} only_head (P : PROP) :
   MaybeIntoLaterN only_head 0 P P | 0.
 Proof. apply _. Qed.
 
@@ -482,9 +499,9 @@ 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⎤.
-Arguments IntoEmbed {_ _ _} _%I _%I.
-Arguments into_embed {_ _ _} _%I _%I {_}.
-Hint Mode IntoEmbed + + + ! -  : typeclass_instances.
+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
@@ -496,28 +513,46 @@ Hint Mode IntoEmbed + + + ! -  : typeclass_instances.
    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.*)
-Class AsEmpValid {PROP : bi} (φ : Prop) (P : PROP) :=
-  as_emp_valid : φ ↔ bi_emp_valid P.
-Arguments AsEmpValid {_} _%type _%I.
-Class AsEmpValid0 {PROP : bi} (φ : Prop) (P : PROP) :=
-  as_emp_valid_here : AsEmpValid φ P.
-Arguments AsEmpValid0 {_} _%type _%I.
-Existing Instance as_emp_valid_here | 0.
-
-Lemma as_emp_valid_1 (φ : Prop) {PROP : bi} (P : PROP) `{!AsEmpValid φ P} :
-  φ → bi_emp_valid P.
+   [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 φ P} :
-  bi_emp_valid P → φ.
+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).
-Arguments IntoInv {_} _%I _.
-Hint Mode IntoInv + ! - : typeclass_instances.
+Global Arguments IntoInv {_} _%_I _.
+Global Hint Mode IntoInv + ! - : typeclass_instances.
 
 (** Accessors.
     This definition only exists for the purpose of the proof mode; a truly
@@ -528,19 +563,20 @@ 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 elliminated.
+(* Typeclass for assertions around which accessors can be eliminated.
    Inputs: [Q], [E1], [E2], [α], [β], [γ]
-   Outputs: [Q']
+   Outputs: [Q'], [φ]
 
    Elliminates an accessor [accessor E1 E2 α β γ] in goal [Q'], turning the goal
-   into [Q'] with a new assumption [α x]. *)
-Class ElimAcc {PROP : bi} {X : Type} (M1 M2 : PROP → PROP)
+   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).
-Arguments ElimAcc {_} {_} _%I _%I _%I _%I _%I _%I : simpl never.
-Arguments elim_acc {_} {_} _%I _%I _%I _%I _%I _%I {_}.
-Hint Mode ElimAcc + ! ! ! ! ! ! ! - : typeclass_instances.
+  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:
@@ -555,13 +591,13 @@ Hint Mode ElimAcc + ! ! ! ! ! ! ! - : typeclass_instances.
 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γ.
-Arguments IntoAcc {_} {_} _%I _ _%I _%I _%I _%I _%I _%I : simpl never.
-Arguments into_acc {_} {_} _%I _ _%I _%I _%I _%I _%I _%I {_} : simpl never.
-Hint Mode IntoAcc + - ! - - - - - - - : typeclass_instances.
+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]
-   Arguments:
+   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
@@ -576,22 +612,20 @@ Hint Mode IntoAcc + - ! - - - - - - - : typeclass_instances.
    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].
-
-   TODO: Add support for a binder (like accessors have it).
 *)
 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.
-Arguments ElimInv {_} {_} _ _%I _%I _%I _%I _%I _%I : simpl never.
-Arguments elim_inv {_} {_} _ _%I _%I _%I _%I _%I _%I {_}.
-Hint Mode ElimInv + - - ! - - ! ! - : typeclass_instances.
+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
+(** 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`,
+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
+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.
 
@@ -603,36 +637,47 @@ with the exception of:
 - [MaybeIntoLaterN] and [FromLaterN] used by [iNext]
 - [IntoPersistent] used by [iIntuitionistic]
 *)
-Instance into_pure_tc_opaque {PROP : bi} (P : PROP) φ :
+Global Instance into_pure_tc_opaque {PROP : bi} (P : PROP) φ :
   IntoPure P φ → IntoPure (tc_opaque P) φ := id.
-Instance from_pure_tc_opaque {PROP : bi} (a : bool) (P : PROP) φ :
+Global Instance from_pure_tc_opaque {PROP : bi} (a : bool) (P : PROP) φ :
   FromPure a P φ → FromPure a (tc_opaque P) φ := id.
-Instance from_wand_tc_opaque {PROP : bi} (P Q1 Q2 : PROP) :
+Global Instance from_wand_tc_opaque {PROP : bi} (P Q1 Q2 : PROP) :
   FromWand P Q1 Q2 → FromWand (tc_opaque P) Q1 Q2 := id.
-Instance into_wand_tc_opaque {PROP : bi} p q (R P Q : PROP) :
+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.
-(* Higher precedence than [from_and_sep] so that [iCombine] does not loop. *)
-Instance from_and_tc_opaque {PROP : bi} (P Q1 Q2 : PROP) :
-  FromAnd P Q1 Q2 → FromAnd (tc_opaque P) Q1 Q2 | 102 := id.
-Instance into_and_tc_opaque {PROP : bi} p (P Q1 Q2 : PROP) :
+
+(* 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.
-Instance from_or_tc_opaque {PROP : bi} (P Q1 Q2 : PROP) :
+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.
-Instance into_or_tc_opaque {PROP : bi} (P Q1 Q2 : PROP) :
+Global Instance into_or_tc_opaque {PROP : bi} (P Q1 Q2 : PROP) :
   IntoOr P Q1 Q2 → IntoOr (tc_opaque P) Q1 Q2 := id.
-Instance from_exist_tc_opaque {PROP : bi} {A} (P : PROP) (Φ : A → PROP) :
+Global Instance from_exist_tc_opaque {PROP : bi} {A} (P : PROP) (Φ : A → PROP) :
   FromExist P Φ → FromExist (tc_opaque P) Φ := id.
-Instance into_exist_tc_opaque {PROP : bi} {A} (P : PROP) (Φ : A → PROP) :
-  IntoExist P Φ → IntoExist (tc_opaque P) Φ := id.
-Instance into_forall_tc_opaque {PROP : bi} {A} (P : PROP) (Φ : A → PROP) :
+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.
-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.
-Instance elim_modal_tc_opaque {PROP : bi} φ p p' (P P' Q Q' : PROP) :
+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.
-Instance into_inv_tc_opaque {PROP : bi} (P : PROP) N :
+Global Instance into_inv_tc_opaque {PROP : bi} (P : PROP) N :
   IntoInv P N → IntoInv (tc_opaque P) N := id.
-Instance elim_inv_tc_opaque {PROP : sbi} {X} φ Pinv Pin Pout Pclose Q Q' :
+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.

iris/proofmode/classes_make.v

+(** The [MakeX] classes are "smart constructors" for the logical connectives
+and modalities that perform some trivial logical simplifications to give "clean"
+results.
+
+For example, when framing below logical connectives/modalities, framing should
+remove connectives/modalities if the result of framing is [emp]. For example,
+when framing [P] (using [iFrame]) in goal [P ∗ Q], the result should be [Q]. The
+result should not be [emp ∗ Q], where [emp] would be the result of (recursively)
+framing [P] in [P]. Hence, in the recursive calls, the framing machinery uses
+the class [MakeSep P Q PQ]. If either [P] or [Q] is [emp] (or [True] in case of
+appropriate assumptions w.r.t. affinity), the result [PQ] is [Q] or [P],
+respectively. In other cases, the result is [PQ] is simply [P ∗ Q].
+
+The [MakeX] classes are used in each recursive step of the framing machinery.
+Hence, they should be "constant time", which means that the number of steps in
+the inference search for [MakeX] should not depend on the size of the inputs.
+This implies that [MakeX] instances should not be recursive, and [MakeX]
+instances should not have premises of other classes with recursive instances. In
+particular, [MakeX] instances should not have [Affine] or [Absorbing] premises
+(because these could invoke a recursive search). Instances for [MakeX] instances
+typically look only at the top-level symbol of the input, or check if the whole
+BI is affine (via the [BiAffine] class) -- the latter can be linear in
+the size of [PROP] itself, but is still independent of the size of the term.
+
+One could imagine a smarter way of "cleaning up", as implemented in
+https://gitlab.mpi-sws.org/iris/iris/-/merge_requests/450 for some modalities,
+but that makes framing less predictable and might have some performance impact
+(i.e., not be constant time). Hence, we only perform such cleanup for [True]
+and [emp].
+
+For each of the [MakeX] class, there is a [KnownMakeX] variant, which only
+succeeds if the parameter(s) is not an evar. In the case the parameter(s) is an
+evar, then [MakeX] will not instantiate it arbitrarily.
+
+The reason for this is that if given an evar, these classes would typically
+try to instantiate this evar with some arbitrary logical constructs such as
+[emp] or [True]. Therefore, we use a [Hint Mode] to disable all the instances
+that would have this behavior.
+
+In practice this means that usually only the default instance should use [MakeX],
+and most specialized instances should use [KnownMakeX]. *)
+From iris.bi Require Export bi.
+From iris.prelude Require Import options.
+
+(** Aliases for [Affine] and [Absorbing], but the instances are severely
+restricted. They only inspect the top-level symbol or check if the whole BI
+is affine. *)
+Class QuickAffine {PROP : bi} (P : PROP) := quick_affine : Affine P.
+Global Hint Mode QuickAffine + ! : typeclass_instances.
+Class QuickAbsorbing {PROP : bi} (P : PROP) := quick_absorbing : Absorbing P.
+Global Hint Mode QuickAbsorbing + ! : typeclass_instances.
+
+Class MakeEmbed {PROP PROP' : bi} `{BiEmbed PROP PROP'} (P : PROP) (Q : PROP') :=
+  make_embed : ⎡P⎤ ⊣⊢ Q.
+Global Arguments MakeEmbed {_ _ _} _%_I _%_I.
+Global Hint Mode MakeEmbed + + + - - : typeclass_instances.
+Class KnownMakeEmbed {PROP PROP' : bi} `{BiEmbed PROP PROP'} (P : PROP) (Q : PROP') :=
+  #[global] known_make_embed :: MakeEmbed P Q.
+Global Arguments KnownMakeEmbed {_ _ _} _%_I _%_I.
+Global Hint Mode KnownMakeEmbed + + + ! - : typeclass_instances.
+
+Class MakeSep {PROP : bi} (P Q PQ : PROP) := make_sep : P ∗ Q ⊣⊢ PQ .
+Global Arguments MakeSep {_} _%_I _%_I _%_I.
+Global Hint Mode MakeSep + - - - : typeclass_instances.
+Class KnownLMakeSep {PROP : bi} (P Q PQ : PROP) :=
+  #[global] knownl_make_sep :: MakeSep P Q PQ.
+Global Arguments KnownLMakeSep {_} _%_I _%_I _%_I.
+Global Hint Mode KnownLMakeSep + ! - - : typeclass_instances.
+Class KnownRMakeSep {PROP : bi} (P Q PQ : PROP) :=
+  #[global] knownr_make_sep :: MakeSep P Q PQ.
+Global Arguments KnownRMakeSep {_} _%_I _%_I _%_I.
+Global Hint Mode KnownRMakeSep + - ! - : typeclass_instances.
+
+Class MakeAnd {PROP : bi} (P Q PQ : PROP) :=  make_and_l : P ∧ Q ⊣⊢ PQ.
+Global Arguments MakeAnd {_} _%_I _%_I _%_I.
+Global Hint Mode MakeAnd + - - - : typeclass_instances.
+Class KnownLMakeAnd {PROP : bi} (P Q PQ : PROP) :=
+  #[global] knownl_make_and :: MakeAnd P Q PQ.
+Global Arguments KnownLMakeAnd {_} _%_I _%_I _%_I.
+Global Hint Mode KnownLMakeAnd + ! - - : typeclass_instances.
+Class KnownRMakeAnd {PROP : bi} (P Q PQ : PROP) :=
+  #[global] knownr_make_and :: MakeAnd P Q PQ.
+Global Arguments KnownRMakeAnd {_} _%_I _%_I _%_I.
+Global Hint Mode KnownRMakeAnd + - ! - : typeclass_instances.
+
+Class MakeOr {PROP : bi} (P Q PQ : PROP) := make_or_l : P ∨ Q ⊣⊢ PQ.
+Global Arguments MakeOr {_} _%_I _%_I _%_I.
+Global Hint Mode MakeOr + - - - : typeclass_instances.
+Class KnownLMakeOr {PROP : bi} (P Q PQ : PROP) :=
+  #[global] knownl_make_or :: MakeOr P Q PQ.
+Global Arguments KnownLMakeOr {_} _%_I _%_I _%_I.
+Global Hint Mode KnownLMakeOr + ! - - : typeclass_instances.
+Class KnownRMakeOr {PROP : bi} (P Q PQ : PROP) := #[global] knownr_make_or :: MakeOr P Q PQ.
+Global Arguments KnownRMakeOr {_} _%_I _%_I _%_I.
+Global Hint Mode KnownRMakeOr + - ! - : typeclass_instances.
+
+Class MakeAffinely {PROP : bi} (P Q : PROP) :=
+  make_affinely : <affine> P ⊣⊢ Q.
+Global Arguments MakeAffinely {_} _%_I _%_I.
+Global Hint Mode MakeAffinely + - - : typeclass_instances.
+Class KnownMakeAffinely {PROP : bi} (P Q : PROP) :=
+  #[global] known_make_affinely :: MakeAffinely P Q.
+Global Arguments KnownMakeAffinely {_} _%_I _%_I.
+Global Hint Mode KnownMakeAffinely + ! - : typeclass_instances.
+
+Class MakeIntuitionistically {PROP : bi} (P Q : PROP) :=
+  make_intuitionistically : □ P ⊣⊢ Q.
+Global Arguments MakeIntuitionistically {_} _%_I _%_I.
+Global Hint Mode MakeIntuitionistically + - - : typeclass_instances.
+Class KnownMakeIntuitionistically {PROP : bi} (P Q : PROP) :=
+  #[global] known_make_intuitionistically :: MakeIntuitionistically P Q.
+Global Arguments KnownMakeIntuitionistically {_} _%_I _%_I.
+Global Hint Mode KnownMakeIntuitionistically + ! - : typeclass_instances.
+
+Class MakeAbsorbingly {PROP : bi} (P Q : PROP) :=
+  make_absorbingly : <absorb> P ⊣⊢ Q.
+Global Arguments MakeAbsorbingly {_} _%_I _%_I.
+Global Hint Mode MakeAbsorbingly + - - : typeclass_instances.
+Class KnownMakeAbsorbingly {PROP : bi} (P Q : PROP) :=
+  #[global] known_make_absorbingly :: MakeAbsorbingly P Q.
+Global Arguments KnownMakeAbsorbingly {_} _%_I _%_I.
+Global Hint Mode KnownMakeAbsorbingly + ! - : typeclass_instances.
+
+Class MakePersistently {PROP : bi} (P Q : PROP) :=
+  make_persistently : <pers> P ⊣⊢ Q.
+Global Arguments MakePersistently {_} _%_I _%_I.
+Global Hint Mode MakePersistently + - - : typeclass_instances.
+Class KnownMakePersistently {PROP : bi} (P Q : PROP) :=
+  #[global] known_make_persistently :: MakePersistently P Q.
+Global Arguments KnownMakePersistently {_} _%_I _%_I.
+Global Hint Mode KnownMakePersistently + ! - : typeclass_instances.
+
+Class MakeLaterN {PROP : bi} (n : nat) (P lP : PROP) :=
+  make_laterN : ▷^n P ⊣⊢ lP.
+Global Arguments MakeLaterN {_} _%_nat _%_I _%_I.
+Global Hint Mode MakeLaterN + + - - : typeclass_instances.
+Class KnownMakeLaterN {PROP : bi} (n : nat) (P lP : PROP) :=
+  #[global] known_make_laterN :: MakeLaterN n P lP.
+Global Arguments KnownMakeLaterN {_} _%_nat _%_I _%_I.
+Global Hint Mode KnownMakeLaterN + + ! - : typeclass_instances.
+
+Class MakeExcept0 {PROP : bi} (P Q : PROP) :=
+  make_except_0 : ◇ P ⊣⊢ Q.
+Global Arguments MakeExcept0 {_} _%_I _%_I.
+Global Hint Mode MakeExcept0 + - - : typeclass_instances.
+Class KnownMakeExcept0 {PROP : bi} (P Q : PROP) :=
+  #[global] known_make_except_0 :: MakeExcept0 P Q.
+Global Arguments KnownMakeExcept0 {_} _%_I _%_I.
+Global Hint Mode KnownMakeExcept0 + ! - : typeclass_instances.