From 52c3006d6d1fda69a1b9614a91a29b83225b1ef4 Mon Sep 17 00:00:00 2001
From: Robbert Krebbers <mail@robbertkrebbers.nl>
Date: Tue, 15 Aug 2017 20:39:40 +0200
Subject: [PATCH] Generalize proofmode.
---
_CoqProject | 14 +-
theories/algebra/auth.v | 3 +-
theories/algebra/frac.v | 2 +-
theories/algebra/frac_auth.v | 2 +-
theories/base_logic/base_logic.v | 7 +-
theories/base_logic/deprecated.v | 4 +
theories/base_logic/derived.v | 958 +---------
theories/base_logic/double_negation.v | 18 +-
theories/base_logic/hlist.v | 43 -
theories/base_logic/lib/auth.v | 3 +-
theories/base_logic/lib/boxes.v | 17 +-
.../base_logic/lib/cancelable_invariants.v | 3 +-
theories/base_logic/lib/counter_examples.v | 18 +-
theories/base_logic/lib/fancy_updates.v | 50 +-
.../base_logic/lib/fancy_updates_from_vs.v | 5 +-
theories/base_logic/lib/gen_heap.v | 11 +-
theories/base_logic/lib/invariants.v | 4 +-
theories/base_logic/lib/iprop.v | 3 +-
theories/base_logic/lib/own.v | 35 +-
theories/base_logic/lib/saved_prop.v | 3 +-
theories/base_logic/lib/viewshifts.v | 6 +-
theories/base_logic/lib/wsat.v | 16 +-
theories/base_logic/primitive.v | 603 ------
theories/base_logic/proofmode.v | 126 ++
theories/base_logic/proofmode_classes.v | 33 +
theories/base_logic/soundness.v | 10 +-
theories/base_logic/upred.v | 528 +++++-
theories/bi/bi.v | 19 +
theories/{base_logic => bi}/big_op.v | 507 ++---
theories/bi/derived.v | 1673 +++++++++++++++++
theories/{base_logic/lib => bi}/fractional.v | 80 +-
theories/bi/interface.v | 468 +++++
theories/{base_logic => bi}/tactics.v | 95 +-
theories/heap_lang/adequacy.v | 4 +-
theories/heap_lang/lifting.v | 8 +-
theories/heap_lang/proofmode.v | 2 +-
theories/program_logic/adequacy.v | 10 +-
theories/program_logic/lifting.v | 3 +-
theories/program_logic/ownp.v | 6 +-
theories/program_logic/weakestpre.v | 17 +-
theories/proofmode/class_instances.v | 1298 +++++++------
theories/proofmode/classes.v | 377 ++--
theories/proofmode/coq_tactics.v | 655 ++++---
theories/proofmode/environments.v | 6 +
theories/proofmode/notation.v | 2 +-
theories/proofmode/tactics.v | 161 +-
theories/tests/proofmode.v | 133 +-
theories/tests/proofmode_iris.v | 52 +
48 files changed, 4910 insertions(+), 3191 deletions(-)
delete mode 100644 theories/base_logic/hlist.v
delete mode 100644 theories/base_logic/primitive.v
create mode 100644 theories/base_logic/proofmode.v
create mode 100644 theories/base_logic/proofmode_classes.v
create mode 100644 theories/bi/bi.v
rename theories/{base_logic => bi}/big_op.v (57%)
create mode 100644 theories/bi/derived.v
rename theories/{base_logic/lib => bi}/fractional.v (71%)
create mode 100644 theories/bi/interface.v
rename theories/{base_logic => bi}/tactics.v (72%)
create mode 100644 theories/tests/proofmode_iris.v
diff --git a/_CoqProject b/_CoqProject
index 501e7c877..b9108ee52 100644
--- a/_CoqProject
+++ b/_CoqProject
@@ -24,17 +24,21 @@ theories/algebra/local_updates.v
theories/algebra/gset.v
theories/algebra/coPset.v
theories/algebra/deprecated.v
+theories/bi/interface.v
+theories/bi/derived.v
+theories/bi/big_op.v
+theories/bi/bi.v
+theories/bi/tactics.v
+theories/bi/fractional.v
theories/base_logic/upred.v
-theories/base_logic/primitive.v
theories/base_logic/derived.v
theories/base_logic/base_logic.v
-theories/base_logic/tactics.v
-theories/base_logic/big_op.v
-theories/base_logic/hlist.v
theories/base_logic/soundness.v
theories/base_logic/double_negation.v
theories/base_logic/deprecated.v
theories/base_logic/fixpoint.v
+theories/base_logic/proofmode.v
+theories/base_logic/proofmode_classes.v
theories/base_logic/lib/iprop.v
theories/base_logic/lib/own.v
theories/base_logic/lib/saved_prop.v
@@ -49,7 +53,6 @@ theories/base_logic/lib/boxes.v
theories/base_logic/lib/na_invariants.v
theories/base_logic/lib/cancelable_invariants.v
theories/base_logic/lib/counter_examples.v
-theories/base_logic/lib/fractional.v
theories/base_logic/lib/gen_heap.v
theories/base_logic/lib/core.v
theories/base_logic/lib/fancy_updates_from_vs.v
@@ -89,6 +92,7 @@ theories/proofmode/class_instances.v
theories/tests/heap_lang.v
theories/tests/one_shot.v
theories/tests/proofmode.v
+theories/tests/proofmode_iris.v
theories/tests/list_reverse.v
theories/tests/tree_sum.v
theories/tests/ipm_paper.v
diff --git a/theories/algebra/auth.v b/theories/algebra/auth.v
index 992400cac..07cff4db7 100644
--- a/theories/algebra/auth.v
+++ b/theories/algebra/auth.v
@@ -1,6 +1,5 @@
From iris.algebra Require Export excl local_updates.
-From iris.base_logic Require Import base_logic.
-From iris.proofmode Require Import classes.
+From iris.base_logic Require Import base_logic proofmode_classes.
Set Default Proof Using "Type".
Record auth (A : Type) := Auth { authoritative : excl' A; auth_own : A }.
diff --git a/theories/algebra/frac.v b/theories/algebra/frac.v
index c83f70117..253ceae52 100644
--- a/theories/algebra/frac.v
+++ b/theories/algebra/frac.v
@@ -1,6 +1,6 @@
From Coq.QArith Require Import Qcanon.
From iris.algebra Require Export cmra.
-From iris.proofmode Require Import classes.
+From iris.base_logic Require Import proofmode_classes.
Set Default Proof Using "Type".
Notation frac := Qp (only parsing).
diff --git a/theories/algebra/frac_auth.v b/theories/algebra/frac_auth.v
index 3f65239d3..1d564f3ac 100644
--- a/theories/algebra/frac_auth.v
+++ b/theories/algebra/frac_auth.v
@@ -1,6 +1,6 @@
From iris.algebra Require Export frac auth.
From iris.algebra Require Export updates local_updates.
-From iris.proofmode Require Import classes.
+From iris.base_logic Require Import proofmode_classes.
Definition frac_authR (A : cmraT) : cmraT :=
authR (optionUR (prodR fracR A)).
diff --git a/theories/base_logic/base_logic.v b/theories/base_logic/base_logic.v
index 58a5a0098..394212c45 100644
--- a/theories/base_logic/base_logic.v
+++ b/theories/base_logic/base_logic.v
@@ -1,10 +1,11 @@
From iris.base_logic Require Export derived.
+From iris.bi Require Export bi.
Set Default Proof Using "Type".
Module Import uPred.
Export upred.uPred.
- Export primitive.uPred.
Export derived.uPred.
+ Export bi.
End uPred.
(* Hint DB for the logic *)
@@ -12,6 +13,6 @@ Hint Resolve pure_intro.
Hint Resolve or_elim or_intro_l' or_intro_r' : I.
Hint Resolve and_intro and_elim_l' and_elim_r' : I.
Hint Resolve persistently_mono : I.
-Hint Resolve sep_elim_l' sep_elim_r' sep_mono : I.
+Hint Resolve sep_mono : I. (* sep_elim_l' sep_elim_r' *)
Hint Immediate True_intro False_elim : I.
-Hint Immediate iff_refl internal_eq_refl' : I.
+Hint Immediate iff_refl internal_eq_refl : I.
diff --git a/theories/base_logic/deprecated.v b/theories/base_logic/deprecated.v
index 4d4995e42..e82de3331 100644
--- a/theories/base_logic/deprecated.v
+++ b/theories/base_logic/deprecated.v
@@ -1,3 +1,6 @@
+(*
+FIXME
+
From iris.base_logic Require Import primitive.
Set Default Proof Using "Type".
@@ -10,3 +13,4 @@ Notation "x = y" := (uPred_pure (x%C%type = y%C%type)) (only parsing) : uPred_sc
(* Deprecated 2016-11-22. Use ⌜x ⊥ y ⌠instead. *)
Notation "x ⊥ y" := (uPred_pure (x%C%type ⊥ y%C%type)) (only parsing) : uPred_scope.
+*)
diff --git a/theories/base_logic/derived.v b/theories/base_logic/derived.v
index 0875fde43..e7cf6bb4c 100644
--- a/theories/base_logic/derived.v
+++ b/theories/base_logic/derived.v
@@ -1,43 +1,8 @@
-From iris.base_logic Require Export primitive.
+From iris.base_logic Require Export upred.
+From iris.bi Require Export interface derived.
Set Default Proof Using "Type".
-Import upred.uPred primitive.uPred.
-
-Definition uPred_iff {M} (P Q : uPred M) : uPred M := ((P → Q) ∧ (Q → P))%I.
-Instance: Params (@uPred_iff) 1.
-Infix "↔" := uPred_iff : uPred_scope.
-
-Definition uPred_laterN {M} (n : nat) (P : uPred M) : uPred M :=
- Nat.iter n uPred_later P.
-Instance: Params (@uPred_laterN) 2.
-Notation "â–·^ n P" := (uPred_laterN n P)
- (at level 20, n at level 9, P at level 20,
- format "â–·^ n P") : uPred_scope.
-Notation "â–·? p P" := (uPred_laterN (Nat.b2n p) P)
- (at level 20, p at level 9, P at level 20,
- format "â–·? p P") : uPred_scope.
-
-Definition uPred_persistently_if {M} (p : bool) (P : uPred M) : uPred M :=
- (if p then â–¡ P else P)%I.
-Instance: Params (@uPred_persistently_if) 2.
-Arguments uPred_persistently_if _ !_ _/.
-Notation "â–¡? p P" := (uPred_persistently_if p P)
- (at level 20, p at level 9, P at level 20, format "â–¡? p P").
-
-Definition uPred_except_0 {M} (P : uPred M) : uPred M := ▷ False ∨ P.
-Notation "â—‡ P" := (uPred_except_0 P)
- (at level 20, right associativity) : uPred_scope.
-Instance: Params (@uPred_except_0) 1.
-Typeclasses Opaque uPred_except_0.
-
-Class Timeless {M} (P : uPred M) := timelessP : ▷ P ⊢ ◇ P.
-Arguments timelessP {_} _ {_}.
-Hint Mode Timeless + ! : typeclass_instances.
-Instance: Params (@Timeless) 1.
-
-Class Persistent {M} (P : uPred M) := persistent : P ⊢ □ P.
-Arguments persistent {_} _ {_}.
-Hint Mode Persistent + ! : typeclass_instances.
-Instance: Params (@Persistent) 1.
+Import upred.uPred.
+Import interface.bi derived.bi.
Module uPred.
Section derived.
@@ -45,728 +10,46 @@ Context {M : ucmraT}.
Implicit Types φ : Prop.
Implicit Types P Q : uPred M.
Implicit Types A : Type.
-Notation "P ⊢ Q" := (@uPred_entails M P%I Q%I). (* Force implicit argument M *)
-Notation "P ⊣⊢ Q" := (equiv (A:=uPred M) P%I Q%I). (* Force implicit argument M *)
-
-(* Derived logical stuff *)
-Lemma False_elim P : False ⊢ P.
-Proof. by apply (pure_elim' False). Qed.
-Lemma True_intro P : P ⊢ True.
-Proof. by apply pure_intro. Qed.
-
-Lemma and_elim_l' P Q R : (P ⊢ R) → P ∧ Q ⊢ R.
-Proof. by rewrite and_elim_l. Qed.
-Lemma and_elim_r' P Q R : (Q ⊢ R) → P ∧ Q ⊢ R.
-Proof. by rewrite and_elim_r. Qed.
-Lemma or_intro_l' P Q R : (P ⊢ Q) → P ⊢ Q ∨ R.
-Proof. intros ->; apply or_intro_l. Qed.
-Lemma or_intro_r' P Q R : (P ⊢ R) → P ⊢ Q ∨ R.
-Proof. intros ->; apply or_intro_r. Qed.
-Lemma exist_intro' {A} P (Ψ : A → uPred M) a : (P ⊢ Ψ a) → P ⊢ ∃ a, Ψ a.
-Proof. intros ->; apply exist_intro. Qed.
-Lemma forall_elim' {A} P (Ψ : A → uPred M) : (P ⊢ ∀ a, Ψ a) → ∀ a, P ⊢ Ψ a.
-Proof. move=> HP a. by rewrite HP forall_elim. Qed.
-
-Hint Resolve pure_intro.
-Hint Resolve or_elim or_intro_l' or_intro_r'.
-Hint Resolve and_intro and_elim_l' and_elim_r'.
-Hint Immediate True_intro False_elim.
-
-Lemma impl_intro_l P Q R : (Q ∧ P ⊢ R) → P ⊢ Q → R.
-Proof. intros HR; apply impl_intro_r; rewrite -HR; auto. Qed.
-Lemma impl_elim_l P Q : (P → Q) ∧ P ⊢ Q.
-Proof. apply impl_elim with P; auto. Qed.
-Lemma impl_elim_r P Q : P ∧ (P → Q) ⊢ Q.
-Proof. apply impl_elim with P; auto. Qed.
-Lemma impl_elim_l' P Q R : (P ⊢ Q → R) → P ∧ Q ⊢ R.
-Proof. intros; apply impl_elim with Q; auto. Qed.
-Lemma impl_elim_r' P Q R : (Q ⊢ P → R) → P ∧ Q ⊢ R.
-Proof. intros; apply impl_elim with P; auto. Qed.
-Lemma impl_entails P Q : (P → Q)%I → P ⊢ Q.
-Proof. intros HPQ; apply impl_elim with P; rewrite -?HPQ; auto. Qed.
-Lemma entails_impl P Q : (P ⊢ Q) → (P → Q)%I.
-Proof. intro. apply impl_intro_l. auto. Qed.
-
-Lemma and_mono P P' Q Q' : (P ⊢ Q) → (P' ⊢ Q') → P ∧ P' ⊢ Q ∧ Q'.
-Proof. auto. Qed.
-Lemma and_mono_l P P' Q : (P ⊢ Q) → P ∧ P' ⊢ Q ∧ P'.
-Proof. by intros; apply and_mono. Qed.
-Lemma and_mono_r P P' Q' : (P' ⊢ Q') → P ∧ P' ⊢ P ∧ Q'.
-Proof. by apply and_mono. Qed.
-
-Lemma or_mono P P' Q Q' : (P ⊢ Q) → (P' ⊢ Q') → P ∨ P' ⊢ Q ∨ Q'.
-Proof. auto. Qed.
-Lemma or_mono_l P P' Q : (P ⊢ Q) → P ∨ P' ⊢ Q ∨ P'.
-Proof. by intros; apply or_mono. Qed.
-Lemma or_mono_r P P' Q' : (P' ⊢ Q') → P ∨ P' ⊢ P ∨ Q'.
-Proof. by apply or_mono. Qed.
-
-Lemma impl_mono P P' Q Q' : (Q ⊢ P) → (P' ⊢ Q') → (P → P') ⊢ Q → Q'.
-Proof.
- intros HP HQ'; apply impl_intro_l; rewrite -HQ'.
- apply impl_elim with P; eauto.
-Qed.
-Lemma forall_mono {A} (Φ Ψ : A → uPred M) :
- (∀ a, Φ a ⊢ Ψ a) → (∀ a, Φ a) ⊢ ∀ a, Ψ a.
-Proof.
- intros HP. apply forall_intro=> a; rewrite -(HP a); apply forall_elim.
-Qed.
-Lemma exist_mono {A} (Φ Ψ : A → uPred M) :
- (∀ a, Φ a ⊢ Ψ a) → (∃ a, Φ a) ⊢ ∃ a, Ψ a.
-Proof. intros HΦ. apply exist_elim=> a; rewrite (HΦ a); apply exist_intro. Qed.
-
-Global Instance and_mono' : Proper ((⊢) ==> (⊢) ==> (⊢)) (@uPred_and M).
-Proof. by intros P P' HP Q Q' HQ; apply and_mono. Qed.
-Global Instance and_flip_mono' :
- Proper (flip (⊢) ==> flip (⊢) ==> flip (⊢)) (@uPred_and M).
-Proof. by intros P P' HP Q Q' HQ; apply and_mono. Qed.
-Global Instance or_mono' : Proper ((⊢) ==> (⊢) ==> (⊢)) (@uPred_or M).
-Proof. by intros P P' HP Q Q' HQ; apply or_mono. Qed.
-Global Instance or_flip_mono' :
- Proper (flip (⊢) ==> flip (⊢) ==> flip (⊢)) (@uPred_or M).
-Proof. by intros P P' HP Q Q' HQ; apply or_mono. Qed.
-Global Instance impl_mono' :
- Proper (flip (⊢) ==> (⊢) ==> (⊢)) (@uPred_impl M).
-Proof. by intros P P' HP Q Q' HQ; apply impl_mono. Qed.
-Global Instance impl_flip_mono' :
- Proper ((⊢) ==> flip (⊢) ==> flip (⊢)) (@uPred_impl M).
-Proof. by intros P P' HP Q Q' HQ; apply impl_mono. Qed.
-Global Instance forall_mono' A :
- Proper (pointwise_relation _ (⊢) ==> (⊢)) (@uPred_forall M A).
-Proof. intros P1 P2; apply forall_mono. Qed.
-Global Instance forall_flip_mono' A :
- Proper (pointwise_relation _ (flip (⊢)) ==> flip (⊢)) (@uPred_forall M A).
-Proof. intros P1 P2; apply forall_mono. Qed.
-Global Instance exist_mono' A :
- Proper (pointwise_relation _ (⊢) ==> (⊢)) (@uPred_exist M A).
-Proof. intros P1 P2; apply exist_mono. Qed.
-Global Instance exist_flip_mono' A :
- Proper (pointwise_relation _ (flip (⊢)) ==> flip (⊢)) (@uPred_exist M A).
-Proof. intros P1 P2; apply exist_mono. Qed.
-
-Global Instance and_idem : IdemP (⊣⊢) (@uPred_and M).
-Proof. intros P; apply (anti_symm (⊢)); auto. Qed.
-Global Instance or_idem : IdemP (⊣⊢) (@uPred_or M).
-Proof. intros P; apply (anti_symm (⊢)); auto. Qed.
-Global Instance and_comm : Comm (⊣⊢) (@uPred_and M).
-Proof. intros P Q; apply (anti_symm (⊢)); auto. Qed.
-Global Instance True_and : LeftId (⊣⊢) True%I (@uPred_and M).
-Proof. intros P; apply (anti_symm (⊢)); auto. Qed.
-Global Instance and_True : RightId (⊣⊢) True%I (@uPred_and M).
-Proof. intros P; apply (anti_symm (⊢)); auto. Qed.
-Global Instance False_and : LeftAbsorb (⊣⊢) False%I (@uPred_and M).
-Proof. intros P; apply (anti_symm (⊢)); auto. Qed.
-Global Instance and_False : RightAbsorb (⊣⊢) False%I (@uPred_and M).
-Proof. intros P; apply (anti_symm (⊢)); auto. Qed.
-Global Instance True_or : LeftAbsorb (⊣⊢) True%I (@uPred_or M).
-Proof. intros P; apply (anti_symm (⊢)); auto. Qed.
-Global Instance or_True : RightAbsorb (⊣⊢) True%I (@uPred_or M).
-Proof. intros P; apply (anti_symm (⊢)); auto. Qed.
-Global Instance False_or : LeftId (⊣⊢) False%I (@uPred_or M).
-Proof. intros P; apply (anti_symm (⊢)); auto. Qed.
-Global Instance or_False : RightId (⊣⊢) False%I (@uPred_or M).
-Proof. intros P; apply (anti_symm (⊢)); auto. Qed.
-Global Instance and_assoc : Assoc (⊣⊢) (@uPred_and M).
-Proof. intros P Q R; apply (anti_symm (⊢)); auto. Qed.
-Global Instance or_comm : Comm (⊣⊢) (@uPred_or M).
-Proof. intros P Q; apply (anti_symm (⊢)); auto. Qed.
-Global Instance or_assoc : Assoc (⊣⊢) (@uPred_or M).
-Proof. intros P Q R; apply (anti_symm (⊢)); auto. Qed.
-Global Instance True_impl : LeftId (⊣⊢) True%I (@uPred_impl M).
-Proof.
- intros P; apply (anti_symm (⊢)).
- - by rewrite -(left_id True%I uPred_and (_ → _)%I) impl_elim_r.
- - by apply impl_intro_l; rewrite left_id.
-Qed.
-Lemma False_impl P : (False → P) ⊣⊢ True.
-Proof.
- apply (anti_symm (⊢)); [by auto|].
- apply impl_intro_l. rewrite left_absorb. auto.
-Qed.
-
-Lemma exists_impl_forall {A} P (Ψ : A → uPred M) :
- ((∃ x : A, Ψ x) → P) ⊣⊢ ∀ x : A, Ψ x → P.
-Proof.
- apply equiv_spec; split.
- - apply forall_intro=>x. by rewrite -exist_intro.
- - apply impl_intro_r, impl_elim_r', exist_elim=>x.
- apply impl_intro_r. by rewrite (forall_elim x) impl_elim_r.
-Qed.
-
-Lemma or_and_l P Q R : P ∨ Q ∧ R ⊣⊢ (P ∨ Q) ∧ (P ∨ R).
-Proof.
- apply (anti_symm (⊢)); first auto.
- do 2 (apply impl_elim_l', or_elim; apply impl_intro_l); auto.
-Qed.
-Lemma or_and_r P Q R : P ∧ Q ∨ R ⊣⊢ (P ∨ R) ∧ (Q ∨ R).
-Proof. by rewrite -!(comm _ R) or_and_l. Qed.
-Lemma and_or_l P Q R : P ∧ (Q ∨ R) ⊣⊢ P ∧ Q ∨ P ∧ R.
-Proof.
- apply (anti_symm (⊢)); last auto.
- apply impl_elim_r', or_elim; apply impl_intro_l; auto.
-Qed.
-Lemma and_or_r P Q R : (P ∨ Q) ∧ R ⊣⊢ P ∧ R ∨ Q ∧ R.
-Proof. by rewrite -!(comm _ R) and_or_l. Qed.
-Lemma and_exist_l {A} P (Ψ : A → uPred M) : P ∧ (∃ a, Ψ a) ⊣⊢ ∃ a, P ∧ Ψ a.
-Proof.
- apply (anti_symm (⊢)).
- - apply impl_elim_r'. apply exist_elim=>a. apply impl_intro_l.
- by rewrite -(exist_intro a).
- - apply exist_elim=>a. apply and_intro; first by rewrite and_elim_l.
- by rewrite -(exist_intro a) and_elim_r.
-Qed.
-Lemma and_exist_r {A} P (Φ: A → uPred M) : (∃ a, Φ a) ∧ P ⊣⊢ ∃ a, Φ a ∧ P.
-Proof.
- rewrite -(comm _ P) and_exist_l. apply exist_proper=>a. by rewrite comm.
-Qed.
-Lemma or_exist {A} (Φ Ψ : A → uPred M) :
- (∃ a, Φ a ∨ Ψ a) ⊣⊢ (∃ a, Φ a) ∨ (∃ a, Ψ a).
-Proof.
- apply (anti_symm (⊢)).
- - apply exist_elim=> a. by rewrite -!(exist_intro a).
- - apply or_elim; apply exist_elim=> a; rewrite -(exist_intro a); auto.
-Qed.
-
-Lemma pure_elim φ Q R : (Q ⊢ ⌜φâŒ) → (φ → Q ⊢ R) → Q ⊢ R.
-Proof.
- intros HQ HQR. rewrite -(idemp uPred_and Q) {1}HQ.
- apply impl_elim_l', pure_elim'=> ?. by apply entails_impl, HQR.
-Qed.
-Lemma pure_mono φ1 φ2 : (φ1 → φ2) → ⌜φ1⌠⊢ ⌜φ2âŒ.
-Proof. intros; apply pure_elim with φ1; eauto. Qed.
-Global Instance pure_mono' : Proper (impl ==> (⊢)) (@uPred_pure M).
-Proof. intros φ1 φ2; apply pure_mono. Qed.
-Global Instance pure_flip_mono : Proper (flip impl ==> flip (⊢)) (@uPred_pure M).
-Proof. intros φ1 φ2; apply pure_mono. Qed.
-Lemma pure_iff φ1 φ2 : (φ1 ↔ φ2) → ⌜φ1⌠⊣⊢ ⌜φ2âŒ.
-Proof. intros [??]; apply (anti_symm _); auto using pure_mono. Qed.
-Lemma pure_intro_l φ Q R : φ → (⌜φ⌠∧ Q ⊢ R) → Q ⊢ R.
-Proof. intros ? <-; auto using pure_intro. Qed.
-Lemma pure_intro_r φ Q R : φ → (Q ∧ ⌜φ⌠⊢ R) → Q ⊢ R.
-Proof. intros ? <-; auto. Qed.
-Lemma pure_intro_impl φ Q R : φ → (Q ⊢ ⌜φ⌠→ R) → Q ⊢ R.
-Proof. intros ? ->. eauto using pure_intro_l, impl_elim_r. Qed.
-Lemma pure_elim_l φ Q R : (φ → Q ⊢ R) → ⌜φ⌠∧ Q ⊢ R.
-Proof. intros; apply pure_elim with φ; eauto. Qed.
-Lemma pure_elim_r φ Q R : (φ → Q ⊢ R) → Q ∧ ⌜φ⌠⊢ R.
-Proof. intros; apply pure_elim with φ; eauto. Qed.
-
-Lemma pure_True (φ : Prop) : φ → ⌜φ⌠⊣⊢ True.
-Proof. intros; apply (anti_symm _); auto. Qed.
-Lemma pure_False (φ : Prop) : ¬φ → ⌜φ⌠⊣⊢ False.
-Proof. intros; apply (anti_symm _); eauto using pure_elim. Qed.
-
-Lemma pure_and φ1 φ2 : ⌜φ1 ∧ φ2⌠⊣⊢ ⌜φ1⌠∧ ⌜φ2âŒ.
-Proof.
- apply (anti_symm _).
- - eapply pure_elim=> // -[??]; auto.
- - eapply (pure_elim φ1); [auto|]=> ?. eapply (pure_elim φ2); auto.
-Qed.
-Lemma pure_or φ1 φ2 : ⌜φ1 ∨ φ2⌠⊣⊢ ⌜φ1⌠∨ ⌜φ2âŒ.
-Proof.
- apply (anti_symm _).
- - eapply pure_elim=> // -[?|?]; auto.
- - apply or_elim; eapply pure_elim; eauto.
-Qed.
-Lemma pure_impl φ1 φ2 : ⌜φ1 → φ2⌠⊣⊢ (⌜φ1⌠→ ⌜φ2âŒ).
-Proof.
- apply (anti_symm _).
- - apply impl_intro_l. rewrite -pure_and. apply pure_mono. naive_solver.
- - rewrite -pure_forall_2. apply forall_intro=> ?.
- by rewrite -(left_id True uPred_and (_→_))%I (pure_True φ1) // impl_elim_r.
-Qed.
-Lemma pure_forall {A} (φ : A → Prop) : ⌜∀ x, φ x⌠⊣⊢ ∀ x, ⌜φ xâŒ.
-Proof.
- apply (anti_symm _); auto using pure_forall_2.
- apply forall_intro=> x. eauto using pure_mono.
-Qed.
-Lemma pure_exist {A} (φ : A → Prop) : ⌜∃ x, φ x⌠⊣⊢ ∃ x, ⌜φ xâŒ.
-Proof.
- apply (anti_symm _).
- - eapply pure_elim=> // -[x ?]. rewrite -(exist_intro x); auto.
- - apply exist_elim=> x. eauto using pure_mono.
-Qed.
-
-Lemma internal_eq_refl' {A : ofeT} (a : A) P : P ⊢ a ≡ a.
-Proof. rewrite (True_intro P). apply internal_eq_refl. Qed.
-Hint Resolve internal_eq_refl'.
-Lemma equiv_internal_eq {A : ofeT} P (a b : A) : a ≡ b → P ⊢ a ≡ b.
-Proof. by intros ->. Qed.
-Lemma internal_eq_sym {A : ofeT} (a b : A) : a ≡ b ⊢ b ≡ a.
-Proof. apply (internal_eq_rewrite a b (λ b, b ≡ a)%I); auto. solve_proper. Qed.
-Lemma internal_eq_rewrite_contractive {A : ofeT} a b (Ψ : A → uPred M) P
- {HΨ : Contractive Ψ} : (P ⊢ ▷ (a ≡ b)) → (P ⊢ Ψ a) → P ⊢ Ψ b.
-Proof.
- move: HΨ=> /contractiveI HΨ Heq ?.
- apply (internal_eq_rewrite (Ψ a) (Ψ b) id _)=>//=. by rewrite -HΨ.
-Qed.
-
-Lemma pure_impl_forall φ P : (⌜φ⌠→ P) ⊣⊢ (∀ _ : φ, P).
-Proof.
- apply (anti_symm _).
- - apply forall_intro=> ?. by rewrite pure_True // left_id.
- - apply impl_intro_l, pure_elim_l=> Hφ. by rewrite (forall_elim Hφ).
-Qed.
-Lemma pure_alt φ : ⌜φ⌠⊣⊢ ∃ _ : φ, True.
-Proof.
- apply (anti_symm _).
- - eapply pure_elim; eauto=> H. rewrite -(exist_intro H); auto.
- - by apply exist_elim, pure_intro.
-Qed.
-Lemma and_alt P Q : P ∧ Q ⊣⊢ ∀ b : bool, if b then P else Q.
-Proof.
- apply (anti_symm _); first apply forall_intro=> -[]; auto.
- apply and_intro. by rewrite (forall_elim true). by rewrite (forall_elim false).
-Qed.
-Lemma or_alt P Q : P ∨ Q ⊣⊢ ∃ b : bool, if b then P else Q.
-Proof.
- apply (anti_symm _); last apply exist_elim=> -[]; auto.
- apply or_elim. by rewrite -(exist_intro true). by rewrite -(exist_intro false).
-Qed.
-
-Global Instance iff_ne : NonExpansive2 (@uPred_iff M).
-Proof. unfold uPred_iff; solve_proper. Qed.
-Global Instance iff_proper :
- Proper ((⊣⊢) ==> (⊣⊢) ==> (⊣⊢)) (@uPred_iff M) := ne_proper_2 _.
-
-Lemma iff_refl Q P : Q ⊢ P ↔ P.
-Proof. rewrite /uPred_iff; apply and_intro; apply impl_intro_l; auto. Qed.
-Lemma iff_equiv P Q : (P ↔ Q)%I → (P ⊣⊢ Q).
-Proof.
- intros HPQ; apply (anti_symm (⊢));
- apply impl_entails; rewrite /uPred_valid HPQ /uPred_iff; auto.
-Qed.
-Lemma equiv_iff P Q : (P ⊣⊢ Q) → (P ↔ Q)%I.
-Proof. intros ->; apply iff_refl. Qed.
-Lemma internal_eq_iff P Q : P ≡ Q ⊢ P ↔ Q.
-Proof.
- apply (internal_eq_rewrite P Q (λ Q, P ↔ Q))%I;
- first solve_proper; auto using iff_refl.
-Qed.
-
-(* Derived BI Stuff *)
-Hint Resolve sep_mono.
-Lemma sep_mono_l P P' Q : (P ⊢ Q) → P ∗ P' ⊢ Q ∗ P'.
-Proof. by intros; apply sep_mono. Qed.
-Lemma sep_mono_r P P' Q' : (P' ⊢ Q') → P ∗ P' ⊢ P ∗ Q'.
-Proof. by apply sep_mono. Qed.
-Global Instance sep_mono' : Proper ((⊢) ==> (⊢) ==> (⊢)) (@uPred_sep M).
-Proof. by intros P P' HP Q Q' HQ; apply sep_mono. Qed.
-Global Instance sep_flip_mono' :
- Proper (flip (⊢) ==> flip (⊢) ==> flip (⊢)) (@uPred_sep M).
-Proof. by intros P P' HP Q Q' HQ; apply sep_mono. Qed.
-Lemma wand_mono P P' Q Q' : (Q ⊢ P) → (P' ⊢ Q') → (P -∗ P') ⊢ Q -∗ Q'.
-Proof.
- intros HP HQ; apply wand_intro_r. rewrite HP -HQ. by apply wand_elim_l'.
-Qed.
-Global Instance wand_mono' : Proper (flip (⊢) ==> (⊢) ==> (⊢)) (@uPred_wand M).
-Proof. by intros P P' HP Q Q' HQ; apply wand_mono. Qed.
-Global Instance wand_flip_mono' :
- Proper ((⊢) ==> flip (⊢) ==> flip (⊢)) (@uPred_wand M).
-Proof. by intros P P' HP Q Q' HQ; apply wand_mono. Qed.
-
-Global Instance sep_comm : Comm (⊣⊢) (@uPred_sep M).
-Proof. intros P Q; apply (anti_symm _); auto using sep_comm'. Qed.
-Global Instance sep_assoc : Assoc (⊣⊢) (@uPred_sep M).
-Proof.
- intros P Q R; apply (anti_symm _); auto using sep_assoc'.
- by rewrite !(comm _ P) !(comm _ _ R) sep_assoc'.
-Qed.
-Global Instance True_sep : LeftId (⊣⊢) True%I (@uPred_sep M).
-Proof. intros P; apply (anti_symm _); auto using True_sep_1, True_sep_2. Qed.
-Global Instance sep_True : RightId (⊣⊢) True%I (@uPred_sep M).
-Proof. by intros P; rewrite comm left_id. Qed.
-Lemma sep_elim_l P Q : P ∗ Q ⊢ P.
-Proof. by rewrite (True_intro Q) right_id. Qed.
-Lemma sep_elim_r P Q : P ∗ Q ⊢ Q.
-Proof. by rewrite (comm (∗))%I; apply sep_elim_l. Qed.
-Lemma sep_elim_l' P Q R : (P ⊢ R) → P ∗ Q ⊢ R.
-Proof. intros ->; apply sep_elim_l. Qed.
-Lemma sep_elim_r' P Q R : (Q ⊢ R) → P ∗ Q ⊢ R.
-Proof. intros ->; apply sep_elim_r. Qed.
-Hint Resolve sep_elim_l' sep_elim_r'.
-Lemma sep_intro_True_l P Q R : P%I → (R ⊢ Q) → R ⊢ P ∗ Q.
-Proof. by intros; rewrite -(left_id True%I uPred_sep R); apply sep_mono. Qed.
-Lemma sep_intro_True_r P Q R : (R ⊢ P) → Q%I → R ⊢ P ∗ Q.
-Proof. by intros; rewrite -(right_id True%I uPred_sep R); apply sep_mono. Qed.
-Lemma sep_elim_True_l P Q R : P → (P ∗ R ⊢ Q) → R ⊢ Q.
-Proof. by intros HP; rewrite -HP left_id. Qed.
-Lemma sep_elim_True_r P Q R : P → (R ∗ P ⊢ Q) → R ⊢ Q.
-Proof. by intros HP; rewrite -HP right_id. Qed.
-Lemma wand_intro_l P Q R : (Q ∗ P ⊢ R) → P ⊢ Q -∗ R.
-Proof. rewrite comm; apply wand_intro_r. Qed.
-Lemma wand_elim_l P Q : (P -∗ Q) ∗ P ⊢ Q.
-Proof. by apply wand_elim_l'. Qed.
-Lemma wand_elim_r P Q : P ∗ (P -∗ Q) ⊢ Q.
-Proof. rewrite (comm _ P); apply wand_elim_l. Qed.
-Lemma wand_elim_r' P Q R : (Q ⊢ P -∗ R) → P ∗ Q ⊢ R.
-Proof. intros ->; apply wand_elim_r. Qed.
-Lemma wand_apply P Q R S : (P ⊢ Q -∗ R) → (S ⊢ P ∗ Q) → S ⊢ R.
-Proof. intros HR%wand_elim_l' HQ. by rewrite HQ. Qed.
-Lemma wand_frame_l P Q R : (Q -∗ R) ⊢ P ∗ Q -∗ P ∗ R.
-Proof. apply wand_intro_l. rewrite -assoc. apply sep_mono_r, wand_elim_r. Qed.
-Lemma wand_frame_r P Q R : (Q -∗ R) ⊢ Q ∗ P -∗ R ∗ P.
-Proof.
- apply wand_intro_l. rewrite ![(_ ∗ P)%I]comm -assoc.
- apply sep_mono_r, wand_elim_r.
-Qed.
-Lemma wand_diag P : (P -∗ P) ⊣⊢ True.
-Proof. apply (anti_symm _); auto. apply wand_intro_l; by rewrite right_id. Qed.
-Lemma wand_True P : (True -∗ P) ⊣⊢ P.
-Proof.
- apply (anti_symm _); last by auto using wand_intro_l.
- eapply sep_elim_True_l; last by apply wand_elim_r. done.
-Qed.
-Lemma wand_entails P Q : (P -∗ Q)%I → P ⊢ Q.
-Proof.
- intros HPQ. eapply sep_elim_True_r; first exact: HPQ. by rewrite wand_elim_r.
-Qed.
-Lemma entails_wand P Q : (P ⊢ Q) → (P -∗ Q)%I.
-Proof. intro. apply wand_intro_l. auto. Qed.
-Lemma wand_curry P Q R : (P -∗ Q -∗ R) ⊣⊢ (P ∗ Q -∗ R).
-Proof.
- apply (anti_symm _).
- - apply wand_intro_l. by rewrite (comm _ P) -assoc !wand_elim_r.
- - do 2 apply wand_intro_l. by rewrite assoc (comm _ Q) wand_elim_r.
-Qed.
-
-Lemma sep_and P Q : (P ∗ Q) ⊢ (P ∧ Q).
-Proof. auto. Qed.
-Lemma impl_wand_1 P Q : (P → Q) ⊢ P -∗ Q.
-Proof. apply wand_intro_r, impl_elim with P; auto. Qed.
-Lemma pure_elim_sep_l φ Q R : (φ → Q ⊢ R) → ⌜φ⌠∗ Q ⊢ R.
-Proof. intros; apply pure_elim with φ; eauto. Qed.
-Lemma pure_elim_sep_r φ Q R : (φ → Q ⊢ R) → Q ∗ ⌜φ⌠⊢ R.
-Proof. intros; apply pure_elim with φ; eauto. Qed.
-
-Global Instance sep_False : LeftAbsorb (⊣⊢) False%I (@uPred_sep M).
-Proof. intros P; apply (anti_symm _); auto. Qed.
-Global Instance False_sep : RightAbsorb (⊣⊢) False%I (@uPred_sep M).
-Proof. intros P; apply (anti_symm _); auto. Qed.
-
-Lemma entails_equiv_and P Q : (P ⊣⊢ Q ∧ P) ↔ (P ⊢ Q).
-Proof. split. by intros ->; auto. intros; apply (anti_symm _); auto. Qed.
-Lemma sep_and_l P Q R : P ∗ (Q ∧ R) ⊢ (P ∗ Q) ∧ (P ∗ R).
-Proof. auto. Qed.
-Lemma sep_and_r P Q R : (P ∧ Q) ∗ R ⊢ (P ∗ R) ∧ (Q ∗ R).
-Proof. auto. Qed.
-Lemma sep_or_l P Q R : P ∗ (Q ∨ R) ⊣⊢ (P ∗ Q) ∨ (P ∗ R).
-Proof.
- apply (anti_symm (⊢)); last by eauto 8.
- apply wand_elim_r', or_elim; apply wand_intro_l; auto.
-Qed.
-Lemma sep_or_r P Q R : (P ∨ Q) ∗ R ⊣⊢ (P ∗ R) ∨ (Q ∗ R).
-Proof. by rewrite -!(comm _ R) sep_or_l. Qed.
-Lemma sep_exist_l {A} P (Ψ : A → uPred M) : P ∗ (∃ a, Ψ a) ⊣⊢ ∃ a, P ∗ Ψ a.
-Proof.
- intros; apply (anti_symm (⊢)).
- - apply wand_elim_r', exist_elim=>a. apply wand_intro_l.
- by rewrite -(exist_intro a).
- - apply exist_elim=> a; apply sep_mono; auto using exist_intro.
-Qed.
-Lemma sep_exist_r {A} (Φ: A → uPred M) Q: (∃ a, Φ a) ∗ Q ⊣⊢ ∃ a, Φ a ∗ Q.
-Proof. setoid_rewrite (comm _ _ Q); apply sep_exist_l. Qed.
-Lemma sep_forall_l {A} P (Ψ : A → uPred M) : P ∗ (∀ a, Ψ a) ⊢ ∀ a, P ∗ Ψ a.
-Proof. by apply forall_intro=> a; rewrite forall_elim. Qed.
-Lemma sep_forall_r {A} (Φ : A → uPred M) Q : (∀ a, Φ a) ∗ Q ⊢ ∀ a, Φ a ∗ Q.
-Proof. by apply forall_intro=> a; rewrite forall_elim. Qed.
-
-(* Always derived *)
-Hint Resolve persistently_mono persistently_elim.
-Global Instance persistently_mono' : Proper ((⊢) ==> (⊢)) (@uPred_persistently M).
-Proof. intros P Q; apply persistently_mono. Qed.
-Global Instance persistently_flip_mono' :
- Proper (flip (⊢) ==> flip (⊢)) (@uPred_persistently M).
-Proof. intros P Q; apply persistently_mono. Qed.
-Lemma persistently_intro' P Q : (□ P ⊢ Q) → □ P ⊢ □ Q.
-Proof. intros <-. apply persistently_idemp_2. Qed.
-Lemma persistently_idemp P : □ □ P ⊣⊢ □ P.
-Proof. apply (anti_symm _); auto using persistently_idemp_2. Qed.
-
-Lemma persistently_pure φ : â–¡ ⌜φ⌠⊣⊢ ⌜φâŒ.
-Proof.
- apply (anti_symm _); auto.
- apply pure_elim'=> Hφ.
- trans (∀ x : False, □ True : uPred M)%I; [by apply forall_intro|].
- rewrite persistently_forall_2. auto using persistently_mono, pure_intro.
-Qed.
-Lemma persistently_forall {A} (Ψ : A → uPred M) : (□ ∀ a, Ψ a) ⊣⊢ (∀ a, □ Ψ a).
-Proof.
- apply (anti_symm _); auto using persistently_forall_2.
- apply forall_intro=> x. by rewrite (forall_elim x).
-Qed.
-Lemma persistently_exist {A} (Ψ : A → uPred M) : (□ ∃ a, Ψ a) ⊣⊢ (∃ a, □ Ψ a).
-Proof.
- apply (anti_symm _); auto using persistently_exist_1.
- apply exist_elim=> x. by rewrite (exist_intro x).
-Qed.
-Lemma persistently_and P Q : □ (P ∧ Q) ⊣⊢ □ P ∧ □ Q.
-Proof. rewrite !and_alt persistently_forall. by apply forall_proper=> -[]. Qed.
-Lemma persistently_or P Q : □ (P ∨ Q) ⊣⊢ □ P ∨ □ Q.
-Proof. rewrite !or_alt persistently_exist. by apply exist_proper=> -[]. Qed.
-Lemma persistently_impl P Q : □ (P → Q) ⊢ □ P → □ Q.
-Proof.
- apply impl_intro_l; rewrite -persistently_and.
- apply persistently_mono, impl_elim with P; auto.
-Qed.
-Lemma persistently_internal_eq {A:ofeT} (a b : A) : □ (a ≡ b) ⊣⊢ a ≡ b.
-Proof.
- apply (anti_symm (⊢)); auto using persistently_elim.
- apply (internal_eq_rewrite a b (λ b, □ (a ≡ b))%I); auto.
- { intros n; solve_proper. }
- rewrite -(internal_eq_refl a) persistently_pure; auto.
-Qed.
-
-Lemma persistently_and_sep_l P Q : □ P ∧ Q ⊣⊢ □ P ∗ Q.
-Proof. apply (anti_symm (⊢)); auto using persistently_and_sep_l_1. Qed.
-Lemma persistently_and_sep_r P Q : P ∧ □ Q ⊣⊢ P ∗ □ Q.
-Proof. by rewrite !(comm _ P) persistently_and_sep_l. Qed.
-Lemma persistently_sep_dup P : □ P ⊣⊢ □ P ∗ □ P.
-Proof. by rewrite -persistently_and_sep_l idemp. Qed.
-
-Lemma persistently_and_sep P Q : □ (P ∧ Q) ⊣⊢ □ (P ∗ Q).
-Proof.
- apply (anti_symm (⊢)); auto.
- rewrite -{1}persistently_idemp persistently_and persistently_and_sep_l; auto.
-Qed.
-Lemma persistently_sep P Q : □ (P ∗ Q) ⊣⊢ □ P ∗ □ Q.
-Proof. by rewrite -persistently_and_sep -persistently_and_sep_l persistently_and. Qed.
-
-Lemma persistently_wand P Q : □ (P -∗ Q) ⊢ □ P -∗ □ Q.
-Proof. by apply wand_intro_r; rewrite -persistently_sep wand_elim_l. Qed.
-Lemma persistently_impl_wand P Q : □ (P → Q) ⊣⊢ □ (P -∗ Q).
-Proof.
- apply (anti_symm (⊢)); [by rewrite -impl_wand_1|].
- apply persistently_intro', impl_intro_r.
- by rewrite persistently_and_sep_l persistently_elim wand_elim_l.
-Qed.
-Lemma impl_wand_persistently P Q : (□ P → Q) ⊣⊢ (□ P -∗ Q).
-Proof.
- apply (anti_symm (⊢)); [by rewrite -impl_wand_1|].
- apply impl_intro_l. by rewrite persistently_and_sep_l wand_elim_r.
-Qed.
-Lemma persistently_entails_l P Q : (P ⊢ □ Q) → P ⊢ □ Q ∗ P.
-Proof. intros; rewrite -persistently_and_sep_l; auto. Qed.
-Lemma persistently_entails_r P Q : (P ⊢ □ Q) → P ⊢ P ∗ □ Q.
-Proof. intros; rewrite -persistently_and_sep_r; auto. Qed.
-
-Lemma persistently_laterN n P : □ ▷^n P ⊣⊢ ▷^n □ P.
-Proof. induction n as [|n IH]; simpl; auto. by rewrite persistently_later IH. Qed.
-
-Lemma wand_alt P Q : (P -∗ Q) ⊣⊢ ∃ R, R ∗ □ (P ∗ R → Q).
-Proof.
- apply (anti_symm (⊢)).
- - rewrite -(right_id True%I uPred_sep (P -∗ Q)%I) -(exist_intro (P -∗ Q)%I).
- apply sep_mono_r. rewrite -persistently_pure. apply persistently_mono, impl_intro_l.
- by rewrite wand_elim_r right_id.
- - apply exist_elim=> R. apply wand_intro_l. rewrite assoc -persistently_and_sep_r.
- by rewrite persistently_elim impl_elim_r.
-Qed.
-Lemma impl_alt P Q : (P → Q) ⊣⊢ ∃ R, R ∧ □ (P ∧ R -∗ Q).
-Proof.
- apply (anti_symm (⊢)).
- - rewrite -(right_id True%I uPred_and (P → Q)%I) -(exist_intro (P → Q)%I).
- apply and_mono_r. rewrite -persistently_pure. apply persistently_mono, wand_intro_l.
- by rewrite impl_elim_r right_id.
- - apply exist_elim=> R. apply impl_intro_l. rewrite assoc persistently_and_sep_r.
- by rewrite persistently_elim wand_elim_r.
-Qed.
-
-(* Later derived *)
-Lemma later_proper P Q : (P ⊣⊢ Q) → ▷ P ⊣⊢ ▷ Q.
-Proof. by intros ->. Qed.
-Hint Resolve later_mono later_proper.
-Global Instance later_mono' : Proper ((⊢) ==> (⊢)) (@uPred_later M).
-Proof. intros P Q; apply later_mono. Qed.
-Global Instance later_flip_mono' :
- Proper (flip (⊢) ==> flip (⊢)) (@uPred_later M).
-Proof. intros P Q; apply later_mono. Qed.
-
-Lemma later_intro P : P ⊢ ▷ P.
-Proof.
- rewrite -(and_elim_l (▷ P) P) -(löb (▷ P ∧ P)).
- apply impl_intro_l. by rewrite {1}(and_elim_r (â–· P)).
-Qed.
+(* Force implicit argument M *)
+Notation "P ⊢ Q" := (bi_entails (PROP:=uPredI M) P%I Q%I).
+Notation "P ⊣⊢ Q" := (equiv (A:=uPredI M) P%I Q%I).
-Lemma later_True : ▷ True ⊣⊢ True.
-Proof. apply (anti_symm (⊢)); auto using later_intro. Qed.
-Lemma later_forall {A} (Φ : A → uPred M) : (▷ ∀ a, Φ a) ⊣⊢ (∀ a, ▷ Φ a).
+(* Limits *)
+Lemma limit_preserving_entails {A : ofeT} `{Cofe A} (Φ Ψ : A → uPred M) :
+ NonExpansive Φ → NonExpansive Ψ → LimitPreserving (λ x, Φ x ⊢ Ψ x).
Proof.
- apply (anti_symm _); auto using later_forall_2.
- apply forall_intro=> x. by rewrite (forall_elim x).
+ intros HΦ HΨ c Hc. etrans; [apply equiv_spec, compl_chain_map|].
+ etrans; [|apply equiv_spec, symmetry, compl_chain_map].
+ by apply entails_lim.
Qed.
-Lemma later_exist_2 {A} (Φ : A → uPred M) : (∃ a, ▷ Φ a) ⊢ ▷ (∃ a, Φ a).
-Proof. apply exist_elim; eauto using exist_intro. Qed.
-Lemma later_exist `{Inhabited A} (Φ : A → uPred M) :
- ▷ (∃ a, Φ a) ⊣⊢ (∃ a, ▷ Φ a).
+Lemma limit_preserving_equiv {A : ofeT} `{Cofe A} (Φ Ψ : A → uPred M) :
+ NonExpansive Φ → NonExpansive Ψ → LimitPreserving (λ x, Φ x ⊣⊢ Ψ x).
Proof.
- apply: anti_symm; [|apply later_exist_2].
- rewrite later_exist_false. apply or_elim; last done.
- rewrite -(exist_intro inhabitant); auto.
+ intros HΦ HΨ. eapply limit_preserving_ext.
+ { intros x. symmetry; apply equiv_spec. }
+ apply limit_preserving_and; by apply limit_preserving_entails.
Qed.
-Lemma later_and P Q : ▷ (P ∧ Q) ⊣⊢ ▷ P ∧ ▷ Q.
-Proof. rewrite !and_alt later_forall. by apply forall_proper=> -[]. Qed.
-Lemma later_or P Q : ▷ (P ∨ Q) ⊣⊢ ▷ P ∨ ▷ Q.
-Proof. rewrite !or_alt later_exist. by apply exist_proper=> -[]. Qed.
-Lemma later_impl P Q : ▷ (P → Q) ⊢ ▷ P → ▷ Q.
-Proof. apply impl_intro_l; rewrite -later_and; eauto using impl_elim. Qed.
-Lemma later_wand P Q : ▷ (P -∗ Q) ⊢ ▷ P -∗ ▷ Q.
-Proof. apply wand_intro_r; rewrite -later_sep; eauto using wand_elim_l. Qed.
-Lemma later_iff P Q : ▷ (P ↔ Q) ⊢ ▷ P ↔ ▷ Q.
-Proof. by rewrite /uPred_iff later_and !later_impl. Qed.
-
-(* Iterated later modality *)
-Global Instance laterN_ne m : NonExpansive (@uPred_laterN M m).
-Proof. induction m; simpl. by intros ???. solve_proper. Qed.
-Global Instance laterN_proper m :
- Proper ((⊣⊢) ==> (⊣⊢)) (@uPred_laterN M m) := ne_proper _.
-
-Lemma laterN_0 P : ▷^0 P ⊣⊢ P.
-Proof. done. Qed.
-Lemma later_laterN n P : ▷^(S n) P ⊣⊢ ▷ ▷^n P.
-Proof. done. Qed.
-Lemma laterN_later n P : ▷^(S n) P ⊣⊢ ▷^n ▷ P.
-Proof. induction n; simpl; auto. Qed.
-Lemma laterN_plus n1 n2 P : ▷^(n1 + n2) P ⊣⊢ ▷^n1 ▷^n2 P.
-Proof. induction n1; simpl; auto. Qed.
-Lemma laterN_le n1 n2 P : n1 ≤ n2 → ▷^n1 P ⊢ ▷^n2 P.
-Proof. induction 1; simpl; by rewrite -?later_intro. Qed.
-
-Lemma laterN_mono n P Q : (P ⊢ Q) → ▷^n P ⊢ ▷^n Q.
-Proof. induction n; simpl; auto. Qed.
-Global Instance laterN_mono' n : Proper ((⊢) ==> (⊢)) (@uPred_laterN M n).
-Proof. intros P Q; apply laterN_mono. Qed.
-Global Instance laterN_flip_mono' n :
- Proper (flip (⊢) ==> flip (⊢)) (@uPred_laterN M n).
-Proof. intros P Q; apply laterN_mono. Qed.
-
-Lemma laterN_intro n P : P ⊢ ▷^n P.
-Proof. induction n as [|n IH]; simpl; by rewrite -?later_intro. Qed.
-
-Lemma laterN_True n : ▷^n True ⊣⊢ True.
-Proof. apply (anti_symm (⊢)); auto using laterN_intro. Qed.
-Lemma laterN_forall {A} n (Φ : A → uPred M) : (▷^n ∀ a, Φ a) ⊣⊢ (∀ a, ▷^n Φ a).
-Proof. induction n as [|n IH]; simpl; rewrite -?later_forall; auto. Qed.
-Lemma laterN_exist_2 {A} n (Φ : A → uPred M) : (∃ a, ▷^n Φ a) ⊢ ▷^n (∃ a, Φ a).
-Proof. apply exist_elim; eauto using exist_intro, laterN_mono. Qed.
-Lemma laterN_exist `{Inhabited A} n (Φ : A → uPred M) :
- (▷^n ∃ a, Φ a) ⊣⊢ ∃ a, ▷^n Φ a.
-Proof. induction n as [|n IH]; simpl; rewrite -?later_exist; auto. Qed.
-Lemma laterN_and n P Q : ▷^n (P ∧ Q) ⊣⊢ ▷^n P ∧ ▷^n Q.
-Proof. induction n as [|n IH]; simpl; rewrite -?later_and; auto. Qed.
-Lemma laterN_or n P Q : ▷^n (P ∨ Q) ⊣⊢ ▷^n P ∨ ▷^n Q.
-Proof. induction n as [|n IH]; simpl; rewrite -?later_or; auto. Qed.
-Lemma laterN_impl n P Q : ▷^n (P → Q) ⊢ ▷^n P → ▷^n Q.
-Proof.
- apply impl_intro_l; rewrite -laterN_and; eauto using impl_elim, laterN_mono.
-Qed.
-Lemma laterN_sep n P Q : ▷^n (P ∗ Q) ⊣⊢ ▷^n P ∗ ▷^n Q.
-Proof. induction n as [|n IH]; simpl; rewrite -?later_sep; auto. Qed.
-Lemma laterN_wand n P Q : ▷^n (P -∗ Q) ⊢ ▷^n P -∗ ▷^n Q.
-Proof.
- apply wand_intro_r; rewrite -laterN_sep; eauto using wand_elim_l,laterN_mono.
-Qed.
-Lemma laterN_iff n P Q : ▷^n (P ↔ Q) ⊢ ▷^n P ↔ ▷^n Q.
-Proof. by rewrite /uPred_iff laterN_and !laterN_impl. Qed.
-
-(* Conditional persistently *)
-Global Instance persistently_if_ne p : NonExpansive (@uPred_persistently_if M p).
-Proof. solve_proper. Qed.
-Global Instance persistently_if_proper p : Proper ((⊣⊢) ==> (⊣⊢)) (@uPred_persistently_if M p).
-Proof. solve_proper. Qed.
-Global Instance persistently_if_mono p : Proper ((⊢) ==> (⊢)) (@uPred_persistently_if M p).
-Proof. solve_proper. Qed.
-
-Lemma persistently_if_elim p P : □?p P ⊢ P.
-Proof. destruct p; simpl; auto using persistently_elim. Qed.
-Lemma persistently_elim_if p P : □ P ⊢ □?p P.
-Proof. destruct p; simpl; auto using persistently_elim. Qed.
-
-Lemma persistently_if_pure p φ : â–¡?p ⌜φ⌠⊣⊢ ⌜φâŒ.
-Proof. destruct p; simpl; auto using persistently_pure. Qed.
-Lemma persistently_if_and p P Q : □?p (P ∧ Q) ⊣⊢ □?p P ∧ □?p Q.
-Proof. destruct p; simpl; auto using persistently_and. Qed.
-Lemma persistently_if_or p P Q : □?p (P ∨ Q) ⊣⊢ □?p P ∨ □?p Q.
-Proof. destruct p; simpl; auto using persistently_or. Qed.
-Lemma persistently_if_exist {A} p (Ψ : A → uPred M) : (□?p ∃ a, Ψ a) ⊣⊢ ∃ a, □?p Ψ a.
-Proof. destruct p; simpl; auto using persistently_exist. Qed.
-Lemma persistently_if_sep p P Q : □?p (P ∗ Q) ⊣⊢ □?p P ∗ □?p Q.
-Proof. destruct p; simpl; auto using persistently_sep. Qed.
-Lemma persistently_if_later p P : □?p ▷ P ⊣⊢ ▷ □?p P.
-Proof. destruct p; simpl; auto using persistently_later. Qed.
-Lemma persistently_if_laterN p n P : □?p ▷^n P ⊣⊢ ▷^n □?p P.
-Proof. destruct p; simpl; auto using persistently_laterN. Qed.
-
-(* True now *)
-Global Instance except_0_ne : NonExpansive (@uPred_except_0 M).
-Proof. solve_proper. Qed.
-Global Instance except_0_proper : Proper ((⊣⊢) ==> (⊣⊢)) (@uPred_except_0 M).
-Proof. solve_proper. Qed.
-Global Instance except_0_mono' : Proper ((⊢) ==> (⊢)) (@uPred_except_0 M).
-Proof. solve_proper. Qed.
-Global Instance except_0_flip_mono' :
- Proper (flip (⊢) ==> flip (⊢)) (@uPred_except_0 M).
-Proof. solve_proper. Qed.
-
-Lemma except_0_intro P : P ⊢ ◇ P.
-Proof. rewrite /uPred_except_0; auto. Qed.
-Lemma except_0_mono P Q : (P ⊢ Q) → ◇ P ⊢ ◇ Q.
-Proof. by intros ->. Qed.
-Lemma except_0_idemp P : ◇ ◇ P ⊢ ◇ P.
-Proof. rewrite /uPred_except_0; auto. Qed.
-
-Lemma except_0_True : ◇ True ⊣⊢ True.
-Proof. rewrite /uPred_except_0. apply (anti_symm _); auto. Qed.
-Lemma except_0_or P Q : ◇ (P ∨ Q) ⊣⊢ ◇ P ∨ ◇ Q.
-Proof. rewrite /uPred_except_0. apply (anti_symm _); auto. Qed.
-Lemma except_0_and P Q : ◇ (P ∧ Q) ⊣⊢ ◇ P ∧ ◇ Q.
-Proof. by rewrite /uPred_except_0 or_and_l. Qed.
-Lemma except_0_sep P Q : ◇ (P ∗ Q) ⊣⊢ ◇ P ∗ ◇ Q.
-Proof.
- rewrite /uPred_except_0. apply (anti_symm _).
- - apply or_elim; last by auto.
- by rewrite -!or_intro_l -persistently_pure -persistently_later -persistently_sep_dup.
- - rewrite sep_or_r sep_elim_l sep_or_l; auto.
-Qed.
-Lemma except_0_forall {A} (Φ : A → uPred M) : ◇ (∀ a, Φ a) ⊢ ∀ a, ◇ Φ a.
-Proof. apply forall_intro=> a. by rewrite (forall_elim a). Qed.
-Lemma except_0_exist_2 {A} (Φ : A → uPred M) : (∃ a, ◇ Φ a) ⊢ ◇ ∃ a, Φ a.
-Proof. apply exist_elim=> a. by rewrite (exist_intro a). Qed.
-Lemma except_0_exist `{Inhabited A} (Φ : A → uPred M) :
- ◇ (∃ a, Φ a) ⊣⊢ (∃ a, ◇ Φ a).
-Proof.
- apply (anti_symm _); [|by apply except_0_exist_2]. apply or_elim.
- - rewrite -(exist_intro inhabitant). by apply or_intro_l.
- - apply exist_mono=> a. apply except_0_intro.
-Qed.
-Lemma except_0_later P : ◇ ▷ P ⊢ ▷ P.
-Proof. by rewrite /uPred_except_0 -later_or False_or. Qed.
-Lemma except_0_persistently P : ◇ □ P ⊣⊢ □ ◇ P.
-Proof. by rewrite /uPred_except_0 persistently_or persistently_later persistently_pure. Qed.
-Lemma except_0_persistently_if p P : ◇ □?p P ⊣⊢ □?p ◇ P.
-Proof. destruct p; simpl; auto using except_0_persistently. Qed.
-Lemma except_0_frame_l P Q : P ∗ ◇ Q ⊢ ◇ (P ∗ Q).
-Proof. by rewrite {1}(except_0_intro P) except_0_sep. Qed.
-Lemma except_0_frame_r P Q : ◇ P ∗ Q ⊢ ◇ (P ∗ Q).
-Proof. by rewrite {1}(except_0_intro Q) except_0_sep. Qed.
+(* Affine *)
+Global Instance uPred_affine : AffineBI (uPredI M) | 0.
+Proof. intros P. rewrite /Affine. by apply bi.pure_intro. Qed.
(* Own and valid derived *)
Lemma persistently_ownM (a : M) : CoreId a → □ uPred_ownM a ⊣⊢ uPred_ownM a.
Proof.
- intros; apply (anti_symm _); first by apply:persistently_elim.
- by rewrite {1}persistently_ownM_core core_id_core.
+ intros; apply (anti_symm _); first by apply: persistently_elim_absorbing.
+ by rewrite {1}persistently_ownM_core core_id_core.
Qed.
Lemma ownM_invalid (a : M) : ¬ ✓{0} a → uPred_ownM a ⊢ False.
Proof. by intros; rewrite ownM_valid cmra_valid_elim. Qed.
Global Instance ownM_mono : Proper (flip (≼) ==> (⊢)) (@uPred_ownM M).
-Proof. intros a b [b' ->]. rewrite ownM_op. eauto. Qed.
+Proof. intros a b [b' ->]. by rewrite ownM_op sep_elim_l. Qed.
Lemma ownM_unit' : uPred_ownM ε ⊣⊢ True.
-Proof. apply (anti_symm _); first by auto. apply ownM_unit. Qed.
+Proof. apply (anti_symm _); first by apply pure_intro. apply ownM_empty. Qed.
Lemma persistently_cmra_valid {A : cmraT} (a : A) : □ ✓ a ⊣⊢ ✓ a.
Proof.
- intros; apply (anti_symm _); first by apply:persistently_elim.
+ intros; apply (anti_symm _); first by apply: persistently_elim_absorbing.
apply:persistently_cmra_valid_1.
Qed.
@@ -790,209 +73,42 @@ Proof.
Qed.
Lemma except_0_bupd P : ◇ (|==> P) ⊢ (|==> ◇ P).
Proof.
- rewrite /uPred_except_0. apply or_elim; auto using bupd_mono.
+ rewrite /bi_except_0. apply or_elim; auto using bupd_mono, or_intro_r.
by rewrite -bupd_intro -or_intro_l.
Qed.
-Global Instance Timeless_proper : Proper ((≡) ==> iff) (@Timeless M).
-Proof. solve_proper. Qed.
-Global Instance pure_timeless φ : Timeless (⌜φ⌠: uPred M)%I.
-Proof.
- rewrite /Timeless pure_alt later_exist_false. by setoid_rewrite later_True.
-Qed.
+(* Timeless instances *)
Global Instance valid_timeless {A : cmraT} `{CmraDiscrete A} (a : A) :
Timeless (✓ a : uPred M)%I.
-Proof. rewrite /Timeless !discrete_valid. apply (timelessP _). Qed.
-Global Instance and_timeless P Q: Timeless P → Timeless Q → Timeless (P ∧ Q).
-Proof. intros; rewrite /Timeless except_0_and later_and; auto. Qed.
-Global Instance or_timeless P Q : Timeless P → Timeless Q → Timeless (P ∨ Q).
-Proof. intros; rewrite /Timeless except_0_or later_or; auto. Qed.
-Global Instance impl_timeless P Q : Timeless Q → Timeless (P → Q).
-Proof.
- rewrite /Timeless=> HQ. rewrite later_false_excluded_middle.
- apply or_mono, impl_intro_l; first done.
- rewrite -{2}(löb Q); apply impl_intro_l.
- rewrite HQ /uPred_except_0 !and_or_r. apply or_elim; last auto.
- by rewrite assoc (comm _ _ P) -assoc !impl_elim_r.
-Qed.
-Global Instance sep_timeless P Q: Timeless P → Timeless Q → Timeless (P ∗ Q).
-Proof. intros; rewrite /Timeless except_0_sep later_sep; auto. Qed.
-Global Instance wand_timeless P Q : Timeless Q → Timeless (P -∗ Q).
-Proof.
- rewrite /Timeless=> HQ. rewrite later_false_excluded_middle.
- apply or_mono, wand_intro_l; first done.
- rewrite -{2}(löb Q); apply impl_intro_l.
- rewrite HQ /uPred_except_0 !and_or_r. apply or_elim; last auto.
- rewrite -(persistently_pure) -persistently_later persistently_and_sep_l.
- by rewrite assoc (comm _ _ P) -assoc -persistently_and_sep_l impl_elim_r wand_elim_r.
-Qed.
-Global Instance forall_timeless {A} (Ψ : A → uPred M) :
- (∀ x, Timeless (Ψ x)) → Timeless (∀ x, Ψ x).
-Proof.
- rewrite /Timeless=> HQ. rewrite later_false_excluded_middle.
- apply or_mono; first done. apply forall_intro=> x.
- rewrite -(löb (Ψ x)); apply impl_intro_l.
- rewrite HQ /uPred_except_0 !and_or_r. apply or_elim; last auto.
- by rewrite impl_elim_r (forall_elim x).
-Qed.
-Global Instance exist_timeless {A} (Ψ : A → uPred M) :
- (∀ x, Timeless (Ψ x)) → Timeless (∃ x, Ψ x).
-Proof.
- rewrite /Timeless=> ?. rewrite later_exist_false. apply or_elim.
- - rewrite /uPred_except_0; auto.
- - apply exist_elim=> x. rewrite -(exist_intro x); auto.
-Qed.
-Global Instance persistently_timeless P : Timeless P → Timeless (□ P).
-Proof. intros; rewrite /Timeless except_0_persistently -persistently_later; auto. Qed.
-Global Instance persistently_if_timeless p P : Timeless P → Timeless (□?p P).
-Proof. destruct p; apply _. Qed.
-Global Instance eq_timeless {A : ofeT} (a b : A) :
- Discrete a → Timeless (a ≡ b : uPred M)%I.
-Proof. intros. rewrite /Timeless !discrete_eq. apply (timelessP _). Qed.
+Proof. rewrite /Timeless !discrete_valid. apply (timeless _). Qed.
Global Instance ownM_timeless (a : M) : Discrete a → Timeless (uPred_ownM a).
Proof.
intros ?. rewrite /Timeless later_ownM. apply exist_elim=> b.
- rewrite (timelessP (a≡b)) (except_0_intro (uPred_ownM b)) -except_0_and.
+ rewrite (timeless (a≡b)) (except_0_intro (uPred_ownM b)) -except_0_and.
apply except_0_mono. rewrite internal_eq_sym.
- apply (internal_eq_rewrite b a (uPred_ownM)); first apply _; auto.
+ apply (internal_eq_rewrite' b a (uPred_ownM) _);
+ auto using and_elim_l, and_elim_r.
Qed.
-Global Instance from_option_timeless {A} P (Ψ : A → uPred M) (mx : option A) :
- (∀ x, Timeless (Ψ x)) → Timeless P → Timeless (from_option Ψ P mx).
-Proof. destruct mx; apply _. Qed.
(* Derived lemmas for persistence *)
-Global Instance Persistent_proper : Proper ((≡) ==> iff) (@Persistent M).
-Proof. solve_proper. Qed.
Global Instance limit_preserving_Persistent {A:ofeT} `{Cofe A} (Φ : A → uPred M) :
NonExpansive Φ → LimitPreserving (λ x, Persistent (Φ x)).
-Proof. intros. apply limit_preserving_entails; solve_proper. Qed.
-
-Lemma persistent_persistently P `{!Persistent P} : □ P ⊣⊢ P.
-Proof. apply (anti_symm (⊢)); auto using persistently_elim. Qed.
-Lemma persistent_persistently_if p P `{!Persistent P} : □?p P ⊣⊢ P.
-Proof. destruct p; simpl; auto using persistent_persistently. Qed.
-Lemma persistently_intro P Q `{!Persistent P} : (P ⊢ Q) → P ⊢ □ Q.
-Proof. rewrite -(persistent_persistently P); apply persistently_intro'. Qed.
-Lemma and_sep_l P Q `{!Persistent P} : P ∧ Q ⊣⊢ P ∗ Q.
-Proof. by rewrite -(persistent_persistently P) persistently_and_sep_l. Qed.
-Lemma and_sep_r P Q `{!Persistent Q} : P ∧ Q ⊣⊢ P ∗ Q.
-Proof. by rewrite -(persistent_persistently Q) persistently_and_sep_r. Qed.
-Lemma sep_dup P `{!Persistent P} : P ⊣⊢ P ∗ P.
-Proof. by rewrite -(persistent_persistently P) -persistently_sep_dup. Qed.
-Lemma sep_entails_l P Q `{!Persistent Q} : (P ⊢ Q) → P ⊢ Q ∗ P.
-Proof. by rewrite -(persistent_persistently Q); apply persistently_entails_l. Qed.
-Lemma sep_entails_r P Q `{!Persistent Q} : (P ⊢ Q) → P ⊢ P ∗ Q.
-Proof. by rewrite -(persistent_persistently Q); apply persistently_entails_r. Qed.
-Lemma impl_wand P `{!Persistent P} Q : (P → Q) ⊣⊢ (P -∗ Q).
-Proof.
- apply (anti_symm _); auto using impl_wand_1.
- apply impl_intro_l. by rewrite and_sep_l wand_elim_r.
-Qed.
+Proof. intros. apply limit_preserving_equiv; solve_proper. Qed.
(* Persistence *)
-Global Instance pure_persistent φ : Persistent (⌜φ⌠: uPred M)%I.
-Proof. by rewrite /Persistent persistently_pure. Qed.
-Global Instance pure_impl_persistent φ Q :
- Persistent Q → Persistent (⌜φ⌠→ Q)%I.
-Proof.
- rewrite /Persistent pure_impl_forall persistently_forall. auto using forall_mono.
-Qed.
-Global Instance pure_wand_persistent φ Q :
- Persistent Q → Persistent (⌜φ⌠-∗ Q)%I.
-Proof.
- rewrite /Persistent -impl_wand pure_impl_forall persistently_forall.
- auto using forall_mono.
-Qed.
-Global Instance persistently_persistent P : Persistent (â–¡ P).
-Proof. by intros; apply persistently_intro'. Qed.
-Global Instance and_persistent P Q :
- Persistent P → Persistent Q → Persistent (P ∧ Q).
-Proof. by intros; rewrite /Persistent persistently_and; apply and_mono. Qed.
-Global Instance or_persistent P Q :
- Persistent P → Persistent Q → Persistent (P ∨ Q).
-Proof. by intros; rewrite /Persistent persistently_or; apply or_mono. Qed.
-Global Instance sep_persistent P Q :
- Persistent P → Persistent Q → Persistent (P ∗ Q).
-Proof. by intros; rewrite /Persistent persistently_sep; apply sep_mono. Qed.
-Global Instance forall_persistent {A} (Ψ : A → uPred M) :
- (∀ x, Persistent (Ψ x)) → Persistent (∀ x, Ψ x).
-Proof. by intros; rewrite /Persistent persistently_forall; apply forall_mono. Qed.
-Global Instance exist_persistent {A} (Ψ : A → uPred M) :
- (∀ x, Persistent (Ψ x)) → Persistent (∃ x, Ψ x).
-Proof. by intros; rewrite /Persistent persistently_exist; apply exist_mono. Qed.
-Global Instance internal_eq_persistent {A : ofeT} (a b : A) :
- Persistent (a ≡ b : uPred M)%I.
-Proof. by intros; rewrite /Persistent persistently_internal_eq. Qed.
Global Instance cmra_valid_persistent {A : cmraT} (a : A) :
Persistent (✓ a : uPred M)%I.
Proof. by intros; rewrite /Persistent persistently_cmra_valid. Qed.
-Global Instance later_persistent P : Persistent P → Persistent (▷ P).
-Proof. by intros; rewrite /Persistent persistently_later; apply later_mono. Qed.
-Global Instance laterN_persistent n P : Persistent P → Persistent (▷^n P).
-Proof. induction n; apply _. Qed.
Global Instance ownM_persistent : CoreId a → Persistent (@uPred_ownM M a).
Proof. intros. by rewrite /Persistent persistently_ownM. Qed.
-Global Instance from_option_persistent {A} P (Ψ : A → uPred M) (mx : option A) :
- (∀ x, Persistent (Ψ x)) → Persistent P → Persistent (from_option Ψ P mx).
-Proof. destruct mx; apply _. Qed.
(* For big ops *)
-Global Instance uPred_and_monoid : Monoid (@uPred_and M) :=
- {| monoid_unit := True%I |}.
-Global Instance uPred_or_monoid : Monoid (@uPred_or M) :=
- {| monoid_unit := False%I |}.
-Global Instance uPred_sep_monoid : Monoid (@uPred_sep M) :=
- {| monoid_unit := True%I |}.
-
-Global Instance uPred_persistently_and_homomorphism :
- MonoidHomomorphism uPred_and uPred_and (≡) (@uPred_persistently M).
-Proof. split; [split; try apply _|]. apply persistently_and. apply persistently_pure. Qed.
-Global Instance uPred_persistently_if_and_homomorphism b :
- MonoidHomomorphism uPred_and uPred_and (≡) (@uPred_persistently_if M b).
-Proof. split; [split; try apply _|]. apply persistently_if_and. apply persistently_if_pure. Qed.
-Global Instance uPred_later_monoid_and_homomorphism :
- MonoidHomomorphism uPred_and uPred_and (≡) (@uPred_later M).
-Proof. split; [split; try apply _|]. apply later_and. apply later_True. Qed.
-Global Instance uPred_laterN_and_homomorphism n :
- MonoidHomomorphism uPred_and uPred_and (≡) (@uPred_laterN M n).
-Proof. split; [split; try apply _|]. apply laterN_and. apply laterN_True. Qed.
-Global Instance uPred_except_0_and_homomorphism :
- MonoidHomomorphism uPred_and uPred_and (≡) (@uPred_except_0 M).
-Proof. split; [split; try apply _|]. apply except_0_and. apply except_0_True. Qed.
-
-Global Instance uPred_persistently_or_homomorphism :
- MonoidHomomorphism uPred_or uPred_or (≡) (@uPred_persistently M).
-Proof. split; [split; try apply _|]. apply persistently_or. apply persistently_pure. Qed.
-Global Instance uPred_persistently_if_or_homomorphism b :
- MonoidHomomorphism uPred_or uPred_or (≡) (@uPred_persistently_if M b).
-Proof. split; [split; try apply _|]. apply persistently_if_or. apply persistently_if_pure. Qed.
-Global Instance uPred_later_monoid_or_homomorphism :
- WeakMonoidHomomorphism uPred_or uPred_or (≡) (@uPred_later M).
-Proof. split; try apply _. apply later_or. Qed.
-Global Instance uPred_laterN_or_homomorphism n :
- WeakMonoidHomomorphism uPred_or uPred_or (≡) (@uPred_laterN M n).
-Proof. split; try apply _. apply laterN_or. Qed.
-Global Instance uPred_except_0_or_homomorphism :
- WeakMonoidHomomorphism uPred_or uPred_or (≡) (@uPred_except_0 M).
-Proof. split; try apply _. apply except_0_or. Qed.
-
-Global Instance uPred_persistently_sep_homomorphism :
- MonoidHomomorphism uPred_sep uPred_sep (≡) (@uPred_persistently M).
-Proof. split; [split; try apply _|]. apply persistently_sep. apply persistently_pure. Qed.
-Global Instance uPred_persistently_if_sep_homomorphism b :
- MonoidHomomorphism uPred_sep uPred_sep (≡) (@uPred_persistently_if M b).
-Proof. split; [split; try apply _|]. apply persistently_if_sep. apply persistently_if_pure. Qed.
-Global Instance uPred_later_monoid_sep_homomorphism :
- MonoidHomomorphism uPred_sep uPred_sep (≡) (@uPred_later M).
-Proof. split; [split; try apply _|]. apply later_sep. apply later_True. Qed.
-Global Instance uPred_laterN_sep_homomorphism n :
- MonoidHomomorphism uPred_sep uPred_sep (≡) (@uPred_laterN M n).
-Proof. split; [split; try apply _|]. apply laterN_sep. apply laterN_True. Qed.
-Global Instance uPred_except_0_sep_homomorphism :
- MonoidHomomorphism uPred_sep uPred_sep (≡) (@uPred_except_0 M).
-Proof. split; [split; try apply _|]. apply except_0_sep. apply except_0_True. Qed.
Global Instance uPred_ownM_sep_homomorphism :
MonoidHomomorphism op uPred_sep (≡) (@uPred_ownM M).
Proof. split; [split; try apply _|]. apply ownM_op. apply ownM_unit'. Qed.
End derived.
+
+(* Also add this to the global hint database, otherwise [eauto] won't work for
+many lemmas that have [AffineBI] as a premise. *)
+Hint Immediate uPred_affine.
End uPred.
diff --git a/theories/base_logic/double_negation.v b/theories/base_logic/double_negation.v
index 38754d614..6f2d19444 100644
--- a/theories/base_logic/double_negation.v
+++ b/theories/base_logic/double_negation.v
@@ -7,11 +7,11 @@ Definition uPred_nnupd {M} (P: uPred M) : uPred M :=
∀ n, (P -∗ ▷^n False) -∗ ▷^n False.
Notation "|=n=> Q" := (uPred_nnupd Q)
- (at level 99, Q at level 200, format "|=n=> Q") : uPred_scope.
+ (at level 99, Q at level 200, format "|=n=> Q") : bi_scope.
Notation "P =n=> Q" := (P ⊢ |=n=> Q)
(at level 99, Q at level 200, only parsing) : C_scope.
Notation "P =n=∗ Q" := (P -∗ |=n=> Q)%I
- (at level 99, Q at level 200, format "P =n=∗ Q") : uPred_scope.
+ (at level 99, Q at level 200, format "P =n=∗ Q") : bi_scope.
(* Our goal is to prove that:
(1) |=n=> has (nearly) all the properties of the |==> modality that are used in Iris
@@ -27,7 +27,7 @@ Implicit Types x : M.
Import uPred.
(* Helper lemmas about iterated later modalities *)
-Lemma laterN_big n a x φ: ✓{n} x → a ≤ n → (â–·^a ⌜φâŒ)%I n x → φ.
+Lemma laterN_big n a x φ: ✓{n} x → a ≤ n → (▷^a ⌜φ⌠: uPred M)%I n x → φ.
Proof.
induction 2 as [| ?? IHle].
- induction a; repeat (rewrite //= || uPred.unseal).
@@ -37,7 +37,7 @@ Proof.
eapply uPred_closed; eauto using cmra_validN_S.
Qed.
-Lemma laterN_small n a x φ: ✓{n} x → n < a → (â–·^a ⌜φâŒ)%I n x.
+Lemma laterN_small n a x φ: ✓{n} x → n < a → (▷^a ⌜φ⌠: uPred M)%I n x.
Proof.
induction 2.
- induction n as [| n IHn]; [| move: IHn];
@@ -132,7 +132,7 @@ Fixpoint uPred_nnupd_k {M} k (P: uPred M) : uPred M :=
end.
Notation "|=n=>_ k Q" := (uPred_nnupd_k k Q)
- (at level 99, k at level 9, Q at level 200, format "|=n=>_ k Q") : uPred_scope.
+ (at level 99, k at level 9, Q at level 200, format "|=n=>_ k Q") : bi_scope.
(* One direction of the limiting process is easy -- nnupd implies nnupd_k for each k *)
@@ -183,13 +183,14 @@ Lemma nnupd_nnupd_k_dist k P: (|=n=> P)%I ≡{k}≡ (|=n=>_k P)%I.
specialize (HPF n'' x''). exfalso.
eapply laterN_big; last (unseal; eauto).
eauto. omega.
- * inversion Hle; subst.
+ * inversion Hle; simpl; subst.
** unseal. intros (HnnP&HnnP_IH) n k' x' ?? HPF.
case (decide (k' < n)).
*** move: laterN_small; uPred.unseal; naive_solver.
*** intros. exfalso. assert (n ≤ k'). omega.
assert (n = S k ∨ n < S k) as [->|] by omega.
- **** eapply laterN_big; eauto; unseal. eapply HnnP; eauto.
+ **** eapply laterN_big; eauto; unseal.
+ eapply HnnP; eauto. move: HPF; by unseal.
**** move:nnupd_k_elim. unseal. intros Hnnupdk.
eapply laterN_big; eauto. unseal.
eapply (Hnnupdk n k); first omega; eauto.
@@ -326,7 +327,6 @@ Proof.
specialize (Hf3 (S k) (S k) ε). rewrite right_id in Hf3 *. unseal.
intros Hf3. eapply Hf3; eauto.
intros ??? Hx'. rewrite left_id in Hx' *=> Hx'.
- unseal.
assert (n' < S k ∨ n' = S k) as [|] by omega.
* intros. move:(laterN_small n' (S k) x' False). rewrite //=. unseal. intros Hsmall.
eapply Hsmall; eauto.
@@ -353,7 +353,7 @@ Lemma adequacy φ n : Nat.iter n (λ P, |=n=> â–· P)%I ⌜φâŒ%I → ¬¬ φ.
Proof.
cut (∀ x, ✓{S n} x → Nat.iter n (λ P, |=n=> â–· P)%I ⌜φâŒ%I (S n) x → ¬¬φ).
{ intros help H. eapply (help ∅); eauto using ucmra_unit_validN.
- eapply H; try unseal; eauto using ucmra_unit_validN. red; rewrite //=. }
+ eapply H; eauto using ucmra_unit_validN. by unseal. }
destruct n.
- rewrite //=; unseal; auto.
- intros ??? Hfal.
diff --git a/theories/base_logic/hlist.v b/theories/base_logic/hlist.v
deleted file mode 100644
index a035aad02..000000000
--- a/theories/base_logic/hlist.v
+++ /dev/null
@@ -1,43 +0,0 @@
-From stdpp Require Export hlist.
-From iris.base_logic Require Export base_logic.
-Set Default Proof Using "Type".
-Import uPred.
-
-Fixpoint uPred_hexist {M As} : himpl As (uPred M) → uPred M :=
- match As return himpl As (uPred M) → uPred M with
- | tnil => id
- | tcons A As => λ Φ, ∃ x, uPred_hexist (Φ x)
- end%I.
-Fixpoint uPred_hforall {M As} : himpl As (uPred M) → uPred M :=
- match As return himpl As (uPred M) → uPred M with
- | tnil => id
- | tcons A As => λ Φ, ∀ x, uPred_hforall (Φ x)
- end%I.
-
-Section hlist.
-Context {M : ucmraT}.
-
-Lemma hexist_exist {As B} (f : himpl As B) (Φ : B → uPred M) :
- uPred_hexist (hcompose Φ f) ⊣⊢ ∃ xs : hlist As, Φ (f xs).
-Proof.
- apply (anti_symm _).
- - induction As as [|A As IH]; simpl.
- + by rewrite -(exist_intro hnil) .
- + apply exist_elim=> x; rewrite IH; apply exist_elim=> xs.
- by rewrite -(exist_intro (hcons x xs)).
- - apply exist_elim=> xs; induction xs as [|A As x xs IH]; simpl; auto.
- by rewrite -(exist_intro x) IH.
-Qed.
-
-Lemma hforall_forall {As B} (f : himpl As B) (Φ : B → uPred M) :
- uPred_hforall (hcompose Φ f) ⊣⊢ ∀ xs : hlist As, Φ (f xs).
-Proof.
- apply (anti_symm _).
- - apply forall_intro=> xs; induction xs as [|A As x xs IH]; simpl; auto.
- by rewrite (forall_elim x) IH.
- - induction As as [|A As IH]; simpl.
- + by rewrite (forall_elim hnil) .
- + apply forall_intro=> x; rewrite -IH; apply forall_intro=> xs.
- by rewrite (forall_elim (hcons x xs)).
-Qed.
-End hlist.
diff --git a/theories/base_logic/lib/auth.v b/theories/base_logic/lib/auth.v
index adcd5859d..bd849ac1f 100644
--- a/theories/base_logic/lib/auth.v
+++ b/theories/base_logic/lib/auth.v
@@ -1,7 +1,6 @@
From iris.base_logic.lib Require Export invariants.
From iris.algebra Require Export auth.
From iris.algebra Require Import gmap.
-From iris.base_logic Require Import big_op.
From iris.proofmode Require Import tactics.
Set Default Proof Using "Type".
Import uPred.
@@ -73,6 +72,7 @@ Section auth.
Lemma auth_own_op γ a b : auth_own γ (a ⋅ b) ⊣⊢ auth_own γ a ∗ auth_own γ b.
Proof. by rewrite /auth_own -own_op auth_frag_op. Qed.
+(*
Global Instance from_and_auth_own γ a b1 b2 :
IsOp a b1 b2 →
FromAnd false (auth_own γ a) (auth_own γ b1) (auth_own γ b2) | 90.
@@ -89,6 +89,7 @@ Section auth.
IsOp a b1 b2 →
IntoAnd p (auth_own γ a) (auth_own γ b1) (auth_own γ b2) | 90.
Proof. intros. apply mk_into_and_sep. by rewrite (is_op a) auth_own_op. Qed.
+*)
Lemma auth_own_mono γ a b : a ≼ b → auth_own γ b ⊢ auth_own γ a.
Proof. intros [? ->]. by rewrite auth_own_op sep_elim_l. Qed.
diff --git a/theories/base_logic/lib/boxes.v b/theories/base_logic/lib/boxes.v
index 3d7a7ca77..5449c5bec 100644
--- a/theories/base_logic/lib/boxes.v
+++ b/theories/base_logic/lib/boxes.v
@@ -1,6 +1,5 @@
From iris.base_logic.lib Require Export invariants.
From iris.algebra Require Import auth gmap agree.
-From iris.base_logic Require Import big_op.
From iris.proofmode Require Import tactics.
Set Default Proof Using "Type".
Import uPred.
@@ -101,7 +100,7 @@ Qed.
Lemma box_alloc : box N ∅ True%I.
Proof.
- iIntros; iExists (λ _, True)%I; iSplit; last done.
+ iIntros; iExists (λ _, True)%I; iSplit; last by auto.
iNext. by rewrite big_opM_empty.
Qed.
@@ -209,11 +208,11 @@ Lemma box_fill E f P :
Proof.
iIntros (?) "H HP"; iDestruct "H" as (Φ) "[#HeqP Hf]".
iExists Φ; iSplitR; first by rewrite big_opM_fmap.
- rewrite internal_eq_iff later_iff big_opM_commute.
+ rewrite internal_eq_iff later_iff big_sepM_later.
iDestruct ("HeqP" with "HP") as "HP".
iCombine "Hf" "HP" as "Hf".
rewrite -big_opM_opM big_opM_fmap; iApply (fupd_big_sepM _ _ f).
- iApply (@big_sepM_impl with "[$Hf]").
+ iApply (@big_sepM_impl with "Hf").
iIntros "!#" (γ b' ?) "[(Hγ' & #$ & #$) HΦ]".
iInv N as (b) "[>Hγ _]" "Hclose".
iMod (box_own_auth_update γ with "[Hγ Hγ']") as "[Hγ $]"; first by iFrame.
@@ -238,7 +237,7 @@ Proof.
iMod ("Hclose" with "[Hγ]"); first (iNext; iExists false; iFrame; eauto).
iFrame "HγΦ Hinv". by iApply "HΦ". }
iModIntro; iSplitL "HΦ".
- - rewrite internal_eq_iff later_iff big_opM_commute. by iApply "HeqP".
+ - rewrite internal_eq_iff later_iff big_sepM_later. by iApply "HeqP".
- iExists Φ; iSplit; by rewrite big_opM_fmap.
Qed.
@@ -273,7 +272,7 @@ Proof.
iExists γ1, γ2. iIntros "{$% $#} !>". iSplit; last iSplit; try iPureIntro.
{ by eapply lookup_insert_None. }
{ by apply (lookup_insert_None (delete γ f) γ1 γ2 true). }
- iNext. eapply internal_eq_rewrite_contractive; [by apply _| |by eauto].
+ iNext. eapply internal_eq_rewrite_contractive'; [by apply _| |by eauto].
iNext. iRewrite "Heq". iPureIntro. by rewrite assoc (comm _ Q2).
- iMod (slice_delete_empty with "Hslice Hbox") as (P') "[Heq Hbox]"; try done.
iMod (slice_insert_empty with "Hbox") as (γ1 ?) "[#Hslice1 Hbox]".
@@ -281,7 +280,7 @@ Proof.
iExists γ1, γ2. iIntros "{$% $#} !>". iSplit; last iSplit; try iPureIntro.
{ by eapply lookup_insert_None. }
{ by apply (lookup_insert_None (delete γ f) γ1 γ2 false). }
- iNext. eapply internal_eq_rewrite_contractive; [by apply _| |by eauto].
+ iNext. eapply internal_eq_rewrite_contractive'; [by apply _| |by eauto].
iNext. iRewrite "Heq". iPureIntro. by rewrite assoc (comm _ Q2).
Qed.
@@ -298,14 +297,14 @@ Proof.
iMod (slice_insert_full _ _ _ _ (Q1 ∗ Q2)%I with "[$HQ1 $HQ2] Hbox")
as (γ ?) "[#Hslice Hbox]"; first done.
iExists γ. iIntros "{$% $#} !>". iNext.
- eapply internal_eq_rewrite_contractive; [by apply _| |by eauto].
+ eapply internal_eq_rewrite_contractive'; [by apply _| |by eauto].
iNext. iRewrite "Heq1". iRewrite "Heq2". by rewrite assoc.
- iMod (slice_delete_empty with "Hslice1 Hbox") as (P1) "(Heq1 & Hbox)"; try done.
iMod (slice_delete_empty with "Hslice2 Hbox") as (P2) "(Heq2 & Hbox)"; first done.
{ by simplify_map_eq. }
iMod (slice_insert_empty with "Hbox") as (γ ?) "[#Hslice Hbox]".
iExists γ. iIntros "{$% $#} !>". iNext.
- eapply internal_eq_rewrite_contractive; [by apply _| |by eauto].
+ eapply internal_eq_rewrite_contractive'; [by apply _| |by eauto].
iNext. iRewrite "Heq1". iRewrite "Heq2". by rewrite assoc.
Qed.
End box.
diff --git a/theories/base_logic/lib/cancelable_invariants.v b/theories/base_logic/lib/cancelable_invariants.v
index 3a4f1c92b..b85789b5a 100644
--- a/theories/base_logic/lib/cancelable_invariants.v
+++ b/theories/base_logic/lib/cancelable_invariants.v
@@ -1,4 +1,5 @@
-From iris.base_logic.lib Require Export invariants fractional.
+From iris.base_logic.lib Require Export invariants.
+From iris.bi Require Import fractional.
From iris.algebra Require Export frac.
From iris.proofmode Require Import tactics.
Set Default Proof Using "Type".
diff --git a/theories/base_logic/lib/counter_examples.v b/theories/base_logic/lib/counter_examples.v
index 259eb66d2..a7bbb9585 100644
--- a/theories/base_logic/lib/counter_examples.v
+++ b/theories/base_logic/lib/counter_examples.v
@@ -1,4 +1,4 @@
-From iris.base_logic Require Import base_logic soundness.
+From iris.base_logic Require Import base_logic soundness proofmode.
From iris.proofmode Require Import tactics.
Set Default Proof Using "Type*".
@@ -7,7 +7,7 @@ name-dependent allocation. *)
Module savedprop. Section savedprop.
Context (M : ucmraT).
Notation iProp := (uPred M).
- Notation "¬ P" := (□ (P → False))%I : uPred_scope.
+ Notation "¬ P" := (□ (P → False))%I : bi_scope.
Implicit Types P : iProp.
(** Saved Propositions and the update modality *)
@@ -41,7 +41,7 @@ Module savedprop. Section savedprop.
Lemma contradiction : False.
Proof using All.
apply (@soundness M False 1); simpl.
- iIntros "". iMod A_alloc as (i) "#H".
+ iMod A_alloc as (i) "#H".
iPoseProof (saved_NA with "H") as "HN".
iModIntro. iNext.
iApply "HN". iApply saved_A. done.
@@ -108,25 +108,25 @@ Module inv. Section inv.
Proof. intros P Q ?. by apply fupd_mono. Qed.
Instance fupd_proper E : Proper ((⊣⊢) ==> (⊣⊢)) (fupd E).
Proof.
- intros P Q; rewrite !uPred.equiv_spec=> -[??]; split; by apply fupd_mono.
+ intros P Q; rewrite !bi.equiv_spec=> -[??]; split; by apply fupd_mono.
Qed.
Lemma fupd_frame_r E P Q : fupd E P ∗ Q ⊢ fupd E (P ∗ Q).
Proof. by rewrite comm fupd_frame_l comm. Qed.
Global Instance elim_fupd_fupd E P Q : ElimModal (fupd E P) P (fupd E Q) (fupd E Q).
- Proof. by rewrite /ElimModal fupd_frame_r uPred.wand_elim_r fupd_fupd. Qed.
+ Proof. by rewrite /ElimModal fupd_frame_r bi.wand_elim_r fupd_fupd. Qed.
Global Instance elim_fupd0_fupd1 P Q : ElimModal (fupd M0 P) P (fupd M1 Q) (fupd M1 Q).
Proof.
- by rewrite /ElimModal fupd_frame_r uPred.wand_elim_r fupd_mask_mono fupd_fupd.
+ by rewrite /ElimModal fupd_frame_r bi.wand_elim_r fupd_mask_mono fupd_fupd.
Qed.
Global Instance exists_split_fupd0 {A} E P (Φ : A → iProp) :
FromExist P Φ → FromExist (fupd E P) (λ a, fupd E (Φ a)).
Proof.
- rewrite /FromExist=>HP. apply uPred.exist_elim=> a.
- apply fupd_mono. by rewrite -HP -(uPred.exist_intro a).
+ rewrite /FromExist=>HP. apply bi.exist_elim=> a.
+ apply fupd_mono. by rewrite -HP -(bi.exist_intro a).
Qed.
(** Now to the actual counterexample. We start with a weird form of saved propositions. *)
@@ -163,7 +163,7 @@ Module inv. Section inv.
Qed.
(** And now we tie a bad knot. *)
- Notation "¬ P" := (□ (P -∗ fupd M1 False))%I : uPred_scope.
+ Notation "¬ P" := (□ (P -∗ fupd M1 False))%I : bi_scope.
Definition A i : iProp := ∃ P, ¬P ∗ saved i P.
Global Instance A_persistent i : Persistent (A i) := _.
diff --git a/theories/base_logic/lib/fancy_updates.v b/theories/base_logic/lib/fancy_updates.v
index f7b856828..e5976b340 100644
--- a/theories/base_logic/lib/fancy_updates.v
+++ b/theories/base_logic/lib/fancy_updates.v
@@ -2,7 +2,6 @@ From iris.base_logic.lib Require Export own.
From stdpp Require Export coPset.
From iris.base_logic.lib Require Import wsat.
From iris.algebra Require Import gmap.
-From iris.base_logic Require Import big_op.
From iris.proofmode Require Import tactics classes.
Set Default Proof Using "Type".
Export invG.
@@ -19,19 +18,19 @@ Instance: Params (@fupd) 4.
Notation "|={ E1 , E2 }=> Q" := (fupd E1 E2 Q)
(at level 99, E1, E2 at level 50, Q at level 200,
- format "|={ E1 , E2 }=> Q") : uPred_scope.
+ format "|={ E1 , E2 }=> Q") : bi_scope.
Notation "P ={ E1 , E2 }=∗ Q" := (P -∗ |={E1,E2}=> Q)%I
(at level 99, E1,E2 at level 50, Q at level 200,
- format "P ={ E1 , E2 }=∗ Q") : uPred_scope.
+ format "P ={ E1 , E2 }=∗ Q") : bi_scope.
Notation "P ={ E1 , E2 }=∗ Q" := (P -∗ |={E1,E2}=> Q)
(at level 99, E1, E2 at level 50, Q at level 200, only parsing) : C_scope.
Notation "|={ E }=> Q" := (fupd E E Q)
(at level 99, E at level 50, Q at level 200,
- format "|={ E }=> Q") : uPred_scope.
+ format "|={ E }=> Q") : bi_scope.
Notation "P ={ E }=∗ Q" := (P -∗ |={E}=> Q)%I
(at level 99, E at level 50, Q at level 200,
- format "P ={ E }=∗ Q") : uPred_scope.
+ format "P ={ E }=∗ Q") : bi_scope.
Notation "P ={ E }=∗ Q" := (P -∗ |={E}=> Q)
(at level 99, E at level 50, Q at level 200, only parsing) : C_scope.
@@ -154,22 +153,37 @@ Section proofmode_classes.
FromAssumption p P (|==> Q) → FromAssumption p P (|={E}=> Q)%I.
Proof. rewrite /FromAssumption=>->. apply bupd_fupd. Qed.
- Global Instance wand_weaken_fupd E1 E2 P Q P' Q' :
- WandWeaken false P Q P' Q' →
- WandWeaken' false P Q (|={E1,E2}=> P') (|={E1,E2}=> Q').
+ Global Instance into_wand_fupd E p q R P Q :
+ IntoWand false false R P Q →
+ IntoWand p q (|={E}=> R) (|={E}=> P) (|={E}=> Q).
Proof.
- rewrite /WandWeaken' /WandWeaken=>->. apply wand_intro_l. by rewrite fupd_wand_r.
+ rewrite /IntoWand /= => HR. rewrite !bare_persistently_if_elim HR.
+ apply wand_intro_l. by rewrite fupd_sep wand_elim_r.
Qed.
- Global Instance from_and_fupd E P Q1 Q2 :
- FromAnd false P Q1 Q2 → FromAnd false (|={E}=> P) (|={E}=> Q1) (|={E}=> Q2).
- Proof. rewrite /FromAnd=><-. apply fupd_sep. Qed.
+ Global Instance into_wand_fupd_persistent 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 bare_persistently_if_elim HR.
+ apply wand_intro_l. by rewrite fupd_frame_l wand_elim_r.
+ Qed.
+
+ Global Instance into_wand_fupd_args 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 bare_persistently_if_elim fupd_wand_r.
+ Qed.
+
+ Global Instance from_sep_fupd E P Q1 Q2 :
+ FromSep P Q1 Q2 → FromSep (|={E}=> P) (|={E}=> Q1) (|={E}=> Q2).
+ Proof. rewrite /FromSep =><-. apply fupd_sep. Qed.
- Global Instance or_split_fupd E1 E2 P Q1 Q2 :
+ Global Instance from_or_fupd 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; auto with I. Qed.
- Global Instance exists_split_fupd {A} E1 E2 P (Φ : A → iProp Σ) :
+ Global Instance from_exist_fupd {A} E1 E2 P (Φ : A → iProp Σ) :
FromExist P Φ → FromExist (|={E1,E2}=> P) (λ a, |={E1,E2}=> Φ a)%I.
Proof.
rewrite /FromExist=><-. apply exist_elim=> a. by rewrite -(exist_intro a).
@@ -204,16 +218,16 @@ Hint Extern 2 (coq_tactics.of_envs _ ⊢ |={_}=> _) => iModIntro.
Notation "|={ E1 , E2 }â–·=> Q" := (|={E1,E2}=> (â–· |={E2,E1}=> Q))%I
(at level 99, E1, E2 at level 50, Q at level 200,
- format "|={ E1 , E2 }â–·=> Q") : uPred_scope.
+ format "|={ E1 , E2 }â–·=> Q") : bi_scope.
Notation "P ={ E1 , E2 }▷=∗ Q" := (P -∗ |={ E1 , E2 }▷=> Q)%I
(at level 99, E1, E2 at level 50, Q at level 200,
- format "P ={ E1 , E2 }▷=∗ Q") : uPred_scope.
+ format "P ={ E1 , E2 }▷=∗ Q") : bi_scope.
Notation "|={ E }â–·=> Q" := (|={E,E}â–·=> Q)%I
(at level 99, E at level 50, Q at level 200,
- format "|={ E }â–·=> Q") : uPred_scope.
+ format "|={ E }â–·=> Q") : bi_scope.
Notation "P ={ E }▷=∗ Q" := (P ={E,E}▷=∗ Q)%I
(at level 99, E at level 50, Q at level 200,
- format "P ={ E }▷=∗ Q") : uPred_scope.
+ format "P ={ E }▷=∗ Q") : bi_scope.
Section step_fupd.
Context `{invG Σ}.
diff --git a/theories/base_logic/lib/fancy_updates_from_vs.v b/theories/base_logic/lib/fancy_updates_from_vs.v
index 5e6bb63a3..a353be049 100644
--- a/theories/base_logic/lib/fancy_updates_from_vs.v
+++ b/theories/base_logic/lib/fancy_updates_from_vs.v
@@ -1,6 +1,7 @@
(* This file shows that the fancy update can be encoded in terms of the
view shift, and that the laws of the fancy update can be derived from the
laws of the view shift. *)
+From iris.base_logic Require Import proofmode.
From iris.proofmode Require Import tactics.
From stdpp Require Export coPset.
Set Default Proof Using "Type*".
@@ -10,7 +11,7 @@ Context {M} (vs : coPset → coPset → uPred M → uPred M → uPred M).
Notation "P ={ E1 , E2 }=> Q" := (vs E1 E2 P Q)
(at level 99, E1,E2 at level 50, Q at level 200,
- format "P ={ E1 , E2 }=> Q") : uPred_scope.
+ format "P ={ E1 , E2 }=> Q") : bi_scope.
Context (vs_ne : ∀ E1 E2, NonExpansive2 (vs E1 E2)).
Context (vs_persistent : ∀ E1 E2 P Q, Persistent (P ={E1,E2}=> Q)).
@@ -32,7 +33,7 @@ Definition fupd (E1 E2 : coPset) (P : uPred M) : uPred M :=
Notation "|={ E1 , E2 }=> Q" := (fupd E1 E2 Q)
(at level 99, E1, E2 at level 50, Q at level 200,
- format "|={ E1 , E2 }=> Q") : uPred_scope.
+ format "|={ E1 , E2 }=> Q") : bi_scope.
Global Instance fupd_ne E1 E2 : NonExpansive (@fupd E1 E2).
Proof. solve_proper. Qed.
diff --git a/theories/base_logic/lib/gen_heap.v b/theories/base_logic/lib/gen_heap.v
index 2f27f2965..c851970e9 100644
--- a/theories/base_logic/lib/gen_heap.v
+++ b/theories/base_logic/lib/gen_heap.v
@@ -1,6 +1,7 @@
From iris.algebra Require Import auth gmap frac agree.
+From iris.base_logic Require Import proofmode.
From iris.base_logic.lib Require Export own.
-From iris.base_logic.lib Require Import fractional.
+From iris.bi Require Import fractional.
From iris.proofmode Require Import tactics.
Set Default Proof Using "Type".
Import uPred.
@@ -41,12 +42,12 @@ Section definitions.
End definitions.
Local Notation "l ↦{ q } v" := (mapsto l q v)
- (at level 20, q at level 50, format "l ↦{ q } v") : uPred_scope.
-Local Notation "l ↦ v" := (mapsto l 1 v) (at level 20) : uPred_scope.
+ (at level 20, q at level 50, format "l ↦{ q } v") : bi_scope.
+Local Notation "l ↦ v" := (mapsto l 1 v) (at level 20) : bi_scope.
Local Notation "l ↦{ q } -" := (∃ v, l ↦{q} v)%I
- (at level 20, q at level 50, format "l ↦{ q } -") : uPred_scope.
-Local Notation "l ↦ -" := (l ↦{1} -)%I (at level 20) : uPred_scope.
+ (at level 20, q at level 50, format "l ↦{ q } -") : bi_scope.
+Local Notation "l ↦ -" := (l ↦{1} -)%I (at level 20) : bi_scope.
Section to_gen_heap.
Context (L V : Type) `{Countable L}.
diff --git a/theories/base_logic/lib/invariants.v b/theories/base_logic/lib/invariants.v
index 1608c9a29..cb1c7bffd 100644
--- a/theories/base_logic/lib/invariants.v
+++ b/theories/base_logic/lib/invariants.v
@@ -64,9 +64,9 @@ Proof.
iSplitL "Hi"; first by eauto. iIntros "HP [Hw HE\N]".
iDestruct (ownI_close with "[$Hw $Hi $HP $HD]") as "[$ HEi]".
do 2 iModIntro. iSplitL; [|done].
- iCombine "HEi" "HEN\i" as "HEN"; iCombine "HEN" "HE\N" as "HE".
+ iCombine "HEi HEN\i HE\N" as "HEN".
rewrite -?ownE_op; [|set_solver..].
- rewrite -!union_difference_L //; set_solver.
+ rewrite assoc_L -!union_difference_L //; set_solver.
Qed.
Lemma inv_open E N P :
diff --git a/theories/base_logic/lib/iprop.v b/theories/base_logic/lib/iprop.v
index b0462acf5..4cacc5c4f 100644
--- a/theories/base_logic/lib/iprop.v
+++ b/theories/base_logic/lib/iprop.v
@@ -152,6 +152,5 @@ Lemma iProp_unfold_equivI {Σ} (P Q : iProp Σ) :
iProp_unfold P ≡ iProp_unfold Q ⊢ (P ≡ Q : iProp Σ).
Proof.
rewrite -{2}(iProp_fold_unfold P) -{2}(iProp_fold_unfold Q).
- eapply (uPred.internal_eq_rewrite _ _ (λ z,
- iProp_fold (iProp_unfold P) ≡ iProp_fold z))%I; auto with I; solve_proper.
+ apply: bi.f_equiv.
Qed.
diff --git a/theories/base_logic/lib/own.v b/theories/base_logic/lib/own.v
index 9381789f3..c8488c385 100644
--- a/theories/base_logic/lib/own.v
+++ b/theories/base_logic/lib/own.v
@@ -1,7 +1,6 @@
From iris.algebra Require Import iprod gmap.
-From iris.base_logic Require Import big_op.
-From iris.base_logic Require Export iprop.
-From iris.proofmode Require Import classes.
+From iris.base_logic.lib Require Export iprop.
+From iris.base_logic Require Import proofmode_classes.
Set Default Proof Using "Type".
Import uPred.
@@ -84,7 +83,7 @@ Global Instance own_proper γ :
Lemma own_op γ a1 a2 : own γ (a1 ⋅ a2) ⊣⊢ own γ a1 ∗ own γ a2.
Proof. by rewrite !own_eq /own_def -ownM_op iRes_singleton_op. Qed.
Lemma own_mono γ a1 a2 : a2 ≼ a1 → own γ a1 ⊢ own γ a2.
-Proof. move=> [c ->]. rewrite own_op. eauto with I. Qed.
+Proof. move=> [c ->]. by rewrite own_op sep_elim_l. Qed.
Global Instance own_mono' γ : Proper (flip (≼) ==> (⊢)) (@own Σ A _ γ).
Proof. intros a1 a2. apply own_mono. Qed.
@@ -102,7 +101,7 @@ Proof. apply wand_intro_r. by rewrite -own_op own_valid. Qed.
Lemma own_valid_3 γ a1 a2 a3 : own γ a1 -∗ own γ a2 -∗ own γ a3 -∗ ✓ (a1 ⋅ a2 ⋅ a3).
Proof. do 2 apply wand_intro_r. by rewrite -!own_op own_valid. Qed.
Lemma own_valid_r γ a : own γ a ⊢ own γ a ∗ ✓ a.
-Proof. apply: uPred.sep_entails_r. apply own_valid. Qed.
+Proof. apply: bi.persistent_entails_r. apply own_valid. Qed.
Lemma own_valid_l γ a : own γ a ⊢ ✓ a ∗ own γ a.
Proof. by rewrite comm -own_valid_r. Qed.
@@ -119,7 +118,7 @@ Lemma own_alloc_strong a (G : gset gname) :
Proof.
intros Ha.
rewrite -(bupd_mono (∃ m, ⌜∃ γ, γ ∉ G ∧ m = iRes_singleton γ a⌠∧ uPred_ownM m)%I).
- - rewrite /uPred_valid ownM_unit.
+ - rewrite /uPred_valid /bi_valid ownM_empty.
eapply bupd_ownM_updateP, (iprod_singleton_updateP_empty (inG_id _));
first (eapply alloc_updateP_strong', cmra_transport_valid, Ha);
naive_solver.
@@ -128,7 +127,7 @@ Proof.
Qed.
Lemma own_alloc a : ✓ a → (|==> ∃ γ, own γ a)%I.
Proof.
- intros Ha. rewrite /uPred_valid (own_alloc_strong a ∅) //; [].
+ intros Ha. rewrite /uPred_valid /bi_valid (own_alloc_strong a ∅) //; [].
apply bupd_mono, exist_mono=>?. eauto with I.
Qed.
@@ -169,7 +168,7 @@ Arguments own_update_3 {_ _} [_] _ _ _ _ _ _.
Lemma own_unit A `{inG Σ (A:ucmraT)} γ : (|==> own γ ε)%I.
Proof.
- rewrite /uPred_valid ownM_unit !own_eq /own_def.
+ rewrite /uPred_valid /bi_valid ownM_empty !own_eq /own_def.
apply bupd_ownM_update, iprod_singleton_update_empty.
apply (alloc_unit_singleton_update (cmra_transport inG_prf ε)); last done.
- apply cmra_transport_valid, ucmra_unit_valid.
@@ -186,17 +185,21 @@ Section proofmode_classes.
Context `{inG Σ A}.
Implicit Types a b : A.
+ Global Instance into_sep_own p γ a b1 b2 :
+ IsOp a b1 b2 → IntoSep p (own γ a) (own γ b1) (own γ b2).
+ Proof. intros. by rewrite /IntoSep (is_op a) own_op. Qed.
Global Instance into_and_own p γ a b1 b2 :
IsOp a b1 b2 → IntoAnd p (own γ a) (own γ b1) (own γ b2).
- Proof. intros. apply mk_into_and_sep. by rewrite (is_op a) own_op. Qed.
- Global Instance from_and_own γ a b1 b2 :
- IsOp a b1 b2 → FromAnd false (own γ a) (own γ b1) (own γ b2).
- Proof. intros. by rewrite /FromAnd -own_op -is_op. Qed.
+ Proof. intros. by rewrite /IntoAnd (is_op a) own_op sep_and. Qed.
+
+ Global Instance from_sep_own γ a b1 b2 :
+ IsOp a b1 b2 → FromSep (own γ a) (own γ b1) (own γ b2).
+ Proof. intros. by rewrite /FromSep -own_op -is_op. Qed.
Global Instance from_and_own_persistent γ a b1 b2 :
- IsOp a b1 b2 → Or (CoreId b1) (CoreId b2) →
- FromAnd true (own γ a) (own γ b1) (own γ b2).
+ IsOp a b1 b2 → TCOr (CoreId b1) (CoreId b2) →
+ FromAnd (own γ a) (own γ b1) (own γ b2).
Proof.
- intros ? Hper; apply mk_from_and_persistent; [destruct Hper; apply _|].
- by rewrite -own_op -is_op.
+ intros ? Hb. rewrite /FromAnd (is_op a) own_op.
+ destruct Hb. by rewrite persistent_and_sep_l. by rewrite persistent_and_sep_r.
Qed.
End proofmode_classes.
diff --git a/theories/base_logic/lib/saved_prop.v b/theories/base_logic/lib/saved_prop.v
index 4ce4a3ce2..6bc0bda63 100644
--- a/theories/base_logic/lib/saved_prop.v
+++ b/theories/base_logic/lib/saved_prop.v
@@ -44,7 +44,6 @@ Section saved_prop.
{ intros z. rewrite /G1 /G2 -cFunctor_compose -{2}[z]cFunctor_id.
apply (ne_proper (cFunctor_map F)); split=>?; apply iProp_fold_unfold. }
rewrite -{2}[x]help -{2}[y]help. apply later_mono.
- apply (internal_eq_rewrite (G1 x) (G1 y) (λ z, G2 (G1 x) ≡ G2 z))%I;
- first solve_proper; auto with I.
+ apply f_equiv. solve_proper.
Qed.
End saved_prop.
diff --git a/theories/base_logic/lib/viewshifts.v b/theories/base_logic/lib/viewshifts.v
index e1b5bafc2..4534a0bd2 100644
--- a/theories/base_logic/lib/viewshifts.v
+++ b/theories/base_logic/lib/viewshifts.v
@@ -9,10 +9,10 @@ Arguments vs {_ _} _ _ _%I _%I.
Instance: Params (@vs) 4.
Notation "P ={ E1 , E2 }=> Q" := (vs E1 E2 P Q)
(at level 99, E1,E2 at level 50, Q at level 200,
- format "P ={ E1 , E2 }=> Q") : uPred_scope.
+ format "P ={ E1 , E2 }=> Q") : bi_scope.
Notation "P ={ E }=> Q" := (P ={E,E}=> Q)%I
(at level 99, E at level 50, Q at level 200,
- format "P ={ E }=> Q") : uPred_scope.
+ format "P ={ E }=> Q") : bi_scope.
Notation "P ={ E1 , E2 }=> Q" := (P ={E1,E2}=> Q)%I
(at level 99, E1,E2 at level 50, Q at level 200,
@@ -81,5 +81,5 @@ Lemma vs_alloc N P : ▷ P ={↑N}=> inv N P.
Proof. iIntros "!# HP". by iApply inv_alloc. Qed.
Lemma wand_fupd_alt E1 E2 P Q : (P ={E1,E2}=∗ Q) ⊣⊢ ∃ R, R ∗ (P ∗ R ={E1,E2}=> Q).
-Proof. rewrite uPred.wand_alt. by setoid_rewrite uPred.persistently_impl_wand. Qed.
+Proof. rewrite bi.wand_alt. by setoid_rewrite bi.persistently_impl_wand. Qed.
End vs.
diff --git a/theories/base_logic/lib/wsat.v b/theories/base_logic/lib/wsat.v
index 4a0fa2698..4517e5bb5 100644
--- a/theories/base_logic/lib/wsat.v
+++ b/theories/base_logic/lib/wsat.v
@@ -1,8 +1,8 @@
From iris.base_logic.lib Require Export own.
From stdpp Require Export coPset.
From iris.algebra Require Import gmap auth agree gset coPset.
-From iris.base_logic Require Import big_op.
From iris.proofmode Require Import tactics.
+From iris.base_logic Require Import proofmode.
Set Default Proof Using "Type".
Module invG.
@@ -53,7 +53,10 @@ Global Instance ownI_persistent i P : Persistent (ownI i P).
Proof. rewrite /ownI. apply _. Qed.
Lemma ownE_empty : (|==> ownE ∅)%I.
-Proof. by rewrite /uPred_valid (own_unit (coPset_disjUR) enabled_name). Qed.
+Proof.
+ rewrite /uPred_valid /bi_valid.
+ by rewrite (own_unit (coPset_disjUR) enabled_name).
+Qed.
Lemma ownE_op E1 E2 : E1 ⊥ E2 → ownE (E1 ∪ E2) ⊣⊢ ownE E1 ∗ ownE E2.
Proof. intros. by rewrite /ownE -own_op coPset_disj_union. Qed.
Lemma ownE_disjoint E1 E2 : ownE E1 ∗ ownE E2 ⊢ ⌜E1 ⊥ E2âŒ.
@@ -68,7 +71,10 @@ Lemma ownE_singleton_twice i : ownE {[i]} ∗ ownE {[i]} ⊢ False.
Proof. rewrite ownE_disjoint. iIntros (?); set_solver. Qed.
Lemma ownD_empty : (|==> ownD ∅)%I.
-Proof. by rewrite /uPred_valid (own_unit (gset_disjUR positive) disabled_name). Qed.
+Proof.
+ rewrite /uPred_valid /bi_valid.
+ by rewrite (own_unit (gset_disjUR positive) disabled_name).
+Qed.
Lemma ownD_op E1 E2 : E1 ⊥ E2 → ownD (E1 ∪ E2) ⊣⊢ ownD E1 ∗ ownD E2.
Proof. intros. by rewrite /ownD -own_op gset_disj_union. Qed.
Lemma ownD_disjoint E1 E2 : ownD E1 ∗ ownD E2 ⊢ ⌜E1 ⊥ E2âŒ.
@@ -90,7 +96,7 @@ Proof.
rewrite -own_op own_valid auth_validI /=. iIntros "[#HI #HvI]".
iDestruct "HI" as (I') "HI". rewrite gmap_equivI gmap_validI.
iSpecialize ("HI" $! i). iSpecialize ("HvI" $! i).
- rewrite left_id_L lookup_fmap lookup_op lookup_singleton uPred.option_equivI.
+ rewrite left_id_L lookup_fmap lookup_op lookup_singleton bi.option_equivI.
case: (I !! i)=> [Q|] /=; [|case: (I' !! i)=> [Q'|] /=; by iExFalso].
iExists Q; iSplit; first done.
iAssert (invariant_unfold Q ≡ invariant_unfold P)%I as "?".
@@ -98,7 +104,7 @@ Proof.
iRewrite "HI" in "HvI". rewrite uPred.option_validI agree_validI.
iRewrite -"HvI" in "HI". by rewrite agree_idemp. }
rewrite /invariant_unfold.
- by rewrite agree_equivI uPred.later_equivI iProp_unfold_equivI.
+ by rewrite agree_equivI bi.later_equivI iProp_unfold_equivI.
Qed.
Lemma ownI_open i P : wsat ∗ ownI i P ∗ ownE {[i]} ⊢ wsat ∗ ▷ P ∗ ownD {[i]}.
diff --git a/theories/base_logic/primitive.v b/theories/base_logic/primitive.v
deleted file mode 100644
index 18d99c201..000000000
--- a/theories/base_logic/primitive.v
+++ /dev/null
@@ -1,603 +0,0 @@
-From iris.base_logic Require Export upred.
-From iris.algebra Require Export updates.
-Set Default Proof Using "Type".
-Local Hint Extern 1 (_ ≼ _) => etrans; [eassumption|].
-Local Hint Extern 1 (_ ≼ _) => etrans; [|eassumption].
-Local Hint Extern 10 (_ ≤ _) => omega.
-
-(** logical connectives *)
-Program Definition uPred_pure_def {M} (φ : Prop) : uPred M :=
- {| uPred_holds n x := φ |}.
-Solve Obligations with done.
-Definition uPred_pure_aux : seal (@uPred_pure_def). by eexists. Qed.
-Definition uPred_pure {M} := unseal uPred_pure_aux M.
-Definition uPred_pure_eq :
- @uPred_pure = @uPred_pure_def := seal_eq uPred_pure_aux.
-
-Instance uPred_inhabited M : Inhabited (uPred M) := populate (uPred_pure True).
-
-Program Definition uPred_and_def {M} (P Q : uPred M) : uPred M :=
- {| uPred_holds n x := P n x ∧ Q n x |}.
-Solve Obligations with naive_solver eauto 2 with uPred_def.
-Definition uPred_and_aux : seal (@uPred_and_def). by eexists. Qed.
-Definition uPred_and {M} := unseal uPred_and_aux M.
-Definition uPred_and_eq: @uPred_and = @uPred_and_def := seal_eq uPred_and_aux.
-
-Program Definition uPred_or_def {M} (P Q : uPred M) : uPred M :=
- {| uPred_holds n x := P n x ∨ Q n x |}.
-Solve Obligations with naive_solver eauto 2 with uPred_def.
-Definition uPred_or_aux : seal (@uPred_or_def). by eexists. Qed.
-Definition uPred_or {M} := unseal uPred_or_aux M.
-Definition uPred_or_eq: @uPred_or = @uPred_or_def := seal_eq uPred_or_aux.
-
-Program Definition uPred_impl_def {M} (P Q : uPred M) : uPred M :=
- {| uPred_holds n x := ∀ n' x',
- x ≼ x' → n' ≤ n → ✓{n'} x' → P n' x' → Q n' x' |}.
-Next Obligation.
- intros M P Q n1 x1 x1' HPQ [x2 Hx1'] n2 x3 [x4 Hx3] ?; simpl in *.
- rewrite Hx3 (dist_le _ _ _ _ Hx1'); auto. intros ??.
- eapply HPQ; auto. exists (x2 â‹… x4); by rewrite assoc.
-Qed.
-Next Obligation. intros M P Q [|n1] [|n2] x; auto with lia. Qed.
-Definition uPred_impl_aux : seal (@uPred_impl_def). by eexists. Qed.
-Definition uPred_impl {M} := unseal uPred_impl_aux M.
-Definition uPred_impl_eq :
- @uPred_impl = @uPred_impl_def := seal_eq uPred_impl_aux.
-
-Program Definition uPred_forall_def {M A} (Ψ : A → uPred M) : uPred M :=
- {| uPred_holds n x := ∀ a, Ψ a n x |}.
-Solve Obligations with naive_solver eauto 2 with uPred_def.
-Definition uPred_forall_aux : seal (@uPred_forall_def). by eexists. Qed.
-Definition uPred_forall {M A} := unseal uPred_forall_aux M A.
-Definition uPred_forall_eq :
- @uPred_forall = @uPred_forall_def := seal_eq uPred_forall_aux.
-
-Program Definition uPred_exist_def {M A} (Ψ : A → uPred M) : uPred M :=
- {| uPred_holds n x := ∃ a, Ψ a n x |}.
-Solve Obligations with naive_solver eauto 2 with uPred_def.
-Definition uPred_exist_aux : seal (@uPred_exist_def). by eexists. Qed.
-Definition uPred_exist {M A} := unseal uPred_exist_aux M A.
-Definition uPred_exist_eq: @uPred_exist = @uPred_exist_def := seal_eq uPred_exist_aux.
-
-Program Definition uPred_internal_eq_def {M} {A : ofeT} (a1 a2 : A) : uPred M :=
- {| uPred_holds n x := a1 ≡{n}≡ a2 |}.
-Solve Obligations with naive_solver eauto 2 using (dist_le (A:=A)).
-Definition uPred_internal_eq_aux : seal (@uPred_internal_eq_def). by eexists. Qed.
-Definition uPred_internal_eq {M A} := unseal uPred_internal_eq_aux M A.
-Definition uPred_internal_eq_eq:
- @uPred_internal_eq = @uPred_internal_eq_def := seal_eq uPred_internal_eq_aux.
-
-Program Definition uPred_sep_def {M} (P Q : uPred M) : uPred M :=
- {| uPred_holds n x := ∃ x1 x2, x ≡{n}≡ x1 ⋅ x2 ∧ P n x1 ∧ Q n x2 |}.
-Next Obligation.
- intros M P Q n x y (x1&x2&Hx&?&?) [z Hy].
- exists x1, (x2 â‹… z); split_and?; eauto using uPred_mono, cmra_includedN_l.
- by rewrite Hy Hx assoc.
-Qed.
-Next Obligation.
- intros M P Q n1 n2 x (x1&x2&Hx&?&?) ?; rewrite {1}(dist_le _ _ _ _ Hx) // =>?.
- exists x1, x2; ofe_subst; split_and!;
- eauto using dist_le, uPred_closed, cmra_validN_op_l, cmra_validN_op_r.
-Qed.
-Definition uPred_sep_aux : seal (@uPred_sep_def). by eexists. Qed.
-Definition uPred_sep {M} := unseal uPred_sep_aux M.
-Definition uPred_sep_eq: @uPred_sep = @uPred_sep_def := seal_eq uPred_sep_aux.
-
-Program Definition uPred_wand_def {M} (P Q : uPred M) : uPred M :=
- {| uPred_holds n x := ∀ n' x',
- n' ≤ n → ✓{n'} (x ⋅ x') → P n' x' → Q n' (x ⋅ x') |}.
-Next Obligation.
- intros M P Q n x1 x1' HPQ ? n3 x3 ???; simpl in *.
- apply uPred_mono with (x1 â‹… x3);
- eauto using cmra_validN_includedN, cmra_monoN_r, cmra_includedN_le.
-Qed.
-Next Obligation. naive_solver. Qed.
-Definition uPred_wand_aux : seal (@uPred_wand_def). by eexists. Qed.
-Definition uPred_wand {M} := unseal uPred_wand_aux M.
-Definition uPred_wand_eq :
- @uPred_wand = @uPred_wand_def := seal_eq uPred_wand_aux.
-
-Program Definition uPred_persistently_def {M} (P : uPred M) : uPred M :=
- {| uPred_holds n x := P n (core x) |}.
-Next Obligation.
- intros M; naive_solver eauto using uPred_mono, @cmra_core_monoN.
-Qed.
-Next Obligation. naive_solver eauto using uPred_closed, @cmra_core_validN. Qed.
-Definition uPred_persistently_aux : seal (@uPred_persistently_def). by eexists. Qed.
-Definition uPred_persistently {M} := unseal uPred_persistently_aux M.
-Definition uPred_persistently_eq :
- @uPred_persistently = @uPred_persistently_def := seal_eq uPred_persistently_aux.
-
-Program Definition uPred_later_def {M} (P : uPred M) : uPred M :=
- {| uPred_holds n x := match n return _ with 0 => True | S n' => P n' x end |}.
-Next Obligation.
- intros M P [|n] x1 x2; eauto using uPred_mono, cmra_includedN_S.
-Qed.
-Next Obligation.
- intros M P [|n1] [|n2] x; eauto using uPred_closed, cmra_validN_S with lia.
-Qed.
-Definition uPred_later_aux : seal (@uPred_later_def). by eexists. Qed.
-Definition uPred_later {M} := unseal uPred_later_aux M.
-Definition uPred_later_eq :
- @uPred_later = @uPred_later_def := seal_eq uPred_later_aux.
-
-Program Definition uPred_ownM_def {M : ucmraT} (a : M) : uPred M :=
- {| uPred_holds n x := a ≼{n} x |}.
-Next Obligation.
- intros M a n x1 x [a' Hx1] [x2 ->].
- exists (a' â‹… x2). by rewrite (assoc op) Hx1.
-Qed.
-Next Obligation. naive_solver eauto using cmra_includedN_le. Qed.
-Definition uPred_ownM_aux : seal (@uPred_ownM_def). by eexists. Qed.
-Definition uPred_ownM {M} := unseal uPred_ownM_aux M.
-Definition uPred_ownM_eq :
- @uPred_ownM = @uPred_ownM_def := seal_eq uPred_ownM_aux.
-
-Program Definition uPred_cmra_valid_def {M} {A : cmraT} (a : A) : uPred M :=
- {| uPred_holds n x := ✓{n} a |}.
-Solve Obligations with naive_solver eauto 2 using cmra_validN_le.
-Definition uPred_cmra_valid_aux : seal (@uPred_cmra_valid_def). by eexists. Qed.
-Definition uPred_cmra_valid {M A} := unseal uPred_cmra_valid_aux M A.
-Definition uPred_cmra_valid_eq :
- @uPred_cmra_valid = @uPred_cmra_valid_def := seal_eq uPred_cmra_valid_aux.
-
-Program Definition uPred_bupd_def {M} (Q : uPred M) : uPred M :=
- {| uPred_holds n x := ∀ k yf,
- k ≤ n → ✓{k} (x ⋅ yf) → ∃ x', ✓{k} (x' ⋅ yf) ∧ Q k x' |}.
-Next Obligation.
- intros M Q n x1 x2 HQ [x3 Hx] k yf Hk.
- rewrite (dist_le _ _ _ _ Hx); last lia. intros Hxy.
- destruct (HQ k (x3 â‹… yf)) as (x'&?&?); [auto|by rewrite assoc|].
- exists (x' â‹… x3); split; first by rewrite -assoc.
- apply uPred_mono with x'; eauto using cmra_includedN_l.
-Qed.
-Next Obligation. naive_solver. Qed.
-Definition uPred_bupd_aux : seal (@uPred_bupd_def). by eexists. Qed.
-Definition uPred_bupd {M} := unseal uPred_bupd_aux M.
-Definition uPred_bupd_eq : @uPred_bupd = @uPred_bupd_def := seal_eq uPred_bupd_aux.
-
-(* Latest notation *)
-Notation "'⌜' φ 'âŒ'" := (uPred_pure φ%C%type)
- (at level 1, φ at level 200, format "⌜ φ âŒ") : uPred_scope.
-Notation "'False'" := (uPred_pure False) : uPred_scope.
-Notation "'True'" := (uPred_pure True) : uPred_scope.
-Infix "∧" := uPred_and : uPred_scope.
-Notation "(∧)" := uPred_and (only parsing) : uPred_scope.
-Infix "∨" := uPred_or : uPred_scope.
-Notation "(∨)" := uPred_or (only parsing) : uPred_scope.
-Infix "→" := uPred_impl : uPred_scope.
-Infix "∗" := uPred_sep (at level 80, right associativity) : uPred_scope.
-Notation "(∗)" := uPred_sep (only parsing) : uPred_scope.
-Notation "P -∗ Q" := (uPred_wand P Q)
- (at level 99, Q at level 200, right associativity) : uPred_scope.
-Notation "∀ x .. y , P" :=
- (uPred_forall (λ x, .. (uPred_forall (λ y, P)) ..)%I)
- (at level 200, x binder, y binder, right associativity) : uPred_scope.
-Notation "∃ x .. y , P" :=
- (uPred_exist (λ x, .. (uPred_exist (λ y, P)) ..)%I)
- (at level 200, x binder, y binder, right associativity) : uPred_scope.
-Notation "â–¡ P" := (uPred_persistently P)
- (at level 20, right associativity) : uPred_scope.
-Notation "â–· P" := (uPred_later P)
- (at level 20, right associativity) : uPred_scope.
-Infix "≡" := uPred_internal_eq : uPred_scope.
-Notation "✓ x" := (uPred_cmra_valid x) (at level 20) : uPred_scope.
-Notation "|==> Q" := (uPred_bupd Q)
- (at level 99, Q at level 200, format "|==> Q") : uPred_scope.
-Notation "P ==∗ Q" := (P ⊢ |==> Q)
- (at level 99, Q at level 200, only parsing) : C_scope.
-Notation "P ==∗ Q" := (P -∗ |==> Q)%I
- (at level 99, Q at level 200, format "P ==∗ Q") : uPred_scope.
-
-Coercion uPred_valid {M} (P : uPred M) : Prop := True%I ⊢ P.
-Typeclasses Opaque uPred_valid.
-
-Notation "P -∗ Q" := (P ⊢ Q)
- (at level 99, Q at level 200, right associativity) : C_scope.
-
-Module uPred.
-Definition unseal_eqs :=
- (uPred_pure_eq, uPred_and_eq, uPred_or_eq, uPred_impl_eq, uPred_forall_eq,
- uPred_exist_eq, uPred_internal_eq_eq, uPred_sep_eq, uPred_wand_eq, uPred_persistently_eq,
- uPred_later_eq, uPred_ownM_eq, uPred_cmra_valid_eq, uPred_bupd_eq).
-Ltac unseal := rewrite !unseal_eqs /=.
-
-Section primitive.
-Context {M : ucmraT}.
-Implicit Types φ : Prop.
-Implicit Types P Q : uPred M.
-Implicit Types A : Type.
-Notation "P ⊢ Q" := (@uPred_entails M P%I Q%I). (* Force implicit argument M *)
-Notation "P ⊣⊢ Q" := (equiv (A:=uPred M) P%I Q%I). (* Force implicit argument M *)
-Arguments uPred_holds {_} !_ _ _ /.
-Hint Immediate uPred_in_entails.
-
-(** Non-expansiveness and setoid morphisms *)
-Global Instance pure_proper : Proper (iff ==> (⊣⊢)) (@uPred_pure M) | 0.
-Proof. intros φ1 φ2 Hφ. by unseal; split=> -[|n] ?; try apply Hφ. Qed.
-Global Instance pure_ne n : Proper (iff ==> dist n) (@uPred_pure M) | 1.
-Proof. by intros φ1 φ2 ->. Qed.
-
-Global Instance and_ne : NonExpansive2 (@uPred_and M).
-Proof.
- intros n P P' HP Q Q' HQ; unseal; split=> x n' ??.
- split; (intros [??]; split; [by apply HP|by apply HQ]).
-Qed.
-Global Instance and_proper :
- Proper ((⊣⊢) ==> (⊣⊢) ==> (⊣⊢)) (@uPred_and M) := ne_proper_2 _.
-Global Instance or_ne : NonExpansive2 (@uPred_or M).
-Proof.
- intros n P P' HP Q Q' HQ; split=> x n' ??.
- unseal; split; (intros [?|?]; [left; by apply HP|right; by apply HQ]).
-Qed.
-Global Instance or_proper :
- Proper ((⊣⊢) ==> (⊣⊢) ==> (⊣⊢)) (@uPred_or M) := ne_proper_2 _.
-Global Instance impl_ne :
- NonExpansive2 (@uPred_impl M).
-Proof.
- intros n P P' HP Q Q' HQ; split=> x n' ??.
- unseal; split; intros HPQ x' n'' ????; apply HQ, HPQ, HP; auto.
-Qed.
-Global Instance impl_proper :
- Proper ((⊣⊢) ==> (⊣⊢) ==> (⊣⊢)) (@uPred_impl M) := ne_proper_2 _.
-Global Instance sep_ne : NonExpansive2 (@uPred_sep M).
-Proof.
- intros n P P' HP Q Q' HQ; split=> n' x ??.
- unseal; split; intros (x1&x2&?&?&?); ofe_subst x;
- exists x1, x2; split_and!; try (apply HP || apply HQ);
- eauto using cmra_validN_op_l, cmra_validN_op_r.
-Qed.
-Global Instance sep_proper :
- Proper ((⊣⊢) ==> (⊣⊢) ==> (⊣⊢)) (@uPred_sep M) := ne_proper_2 _.
-Global Instance wand_ne :
- NonExpansive2 (@uPred_wand M).
-Proof.
- intros n P P' HP Q Q' HQ; split=> n' x ??; unseal; split; intros HPQ x' n'' ???;
- apply HQ, HPQ, HP; eauto using cmra_validN_op_r.
-Qed.
-Global Instance wand_proper :
- Proper ((⊣⊢) ==> (⊣⊢) ==> (⊣⊢)) (@uPred_wand M) := ne_proper_2 _.
-Global Instance internal_eq_ne (A : ofeT) :
- NonExpansive2 (@uPred_internal_eq M A).
-Proof.
- intros n x x' Hx y y' Hy; split=> n' z; unseal; split; intros; simpl in *.
- - by rewrite -(dist_le _ _ _ _ Hx) -?(dist_le _ _ _ _ Hy); auto.
- - by rewrite (dist_le _ _ _ _ Hx) ?(dist_le _ _ _ _ Hy); auto.
-Qed.
-Global Instance internal_eq_proper (A : ofeT) :
- Proper ((≡) ==> (≡) ==> (⊣⊢)) (@uPred_internal_eq M A) := ne_proper_2 _.
-Global Instance forall_ne A n :
- Proper (pointwise_relation _ (dist n) ==> dist n) (@uPred_forall M A).
-Proof.
- by intros Ψ1 Ψ2 HΨ; unseal; split=> n' x; split; intros HP a; apply HΨ.
-Qed.
-Global Instance forall_proper A :
- Proper (pointwise_relation _ (⊣⊢) ==> (⊣⊢)) (@uPred_forall M A).
-Proof.
- by intros Ψ1 Ψ2 HΨ; unseal; split=> n' x; split; intros HP a; apply HΨ.
-Qed.
-Global Instance exist_ne A n :
- Proper (pointwise_relation _ (dist n) ==> dist n) (@uPred_exist M A).
-Proof.
- intros Ψ1 Ψ2 HΨ.
- unseal; split=> n' x ??; split; intros [a ?]; exists a; by apply HΨ.
-Qed.
-Global Instance exist_proper A :
- Proper (pointwise_relation _ (⊣⊢) ==> (⊣⊢)) (@uPred_exist M A).
-Proof.
- intros Ψ1 Ψ2 HΨ.
- unseal; split=> n' x ?; split; intros [a ?]; exists a; by apply HΨ.
-Qed.
-Global Instance later_contractive : Contractive (@uPred_later M).
-Proof.
- unseal; intros [|n] P Q HPQ; split=> -[|n'] x ?? //=; try omega.
- apply HPQ; eauto using cmra_validN_S.
-Qed.
-Global Instance later_proper' :
- Proper ((⊣⊢) ==> (⊣⊢)) (@uPred_later M) := ne_proper _.
-Global Instance persistently_ne : NonExpansive (@uPred_persistently M).
-Proof.
- intros n P1 P2 HP.
- unseal; split=> n' x; split; apply HP; eauto using @cmra_core_validN.
-Qed.
-Global Instance persistently_proper :
- Proper ((⊣⊢) ==> (⊣⊢)) (@uPred_persistently M) := ne_proper _.
-Global Instance ownM_ne : NonExpansive (@uPred_ownM M).
-Proof.
- intros n a b Ha.
- unseal; split=> n' x ? /=. by rewrite (dist_le _ _ _ _ Ha); last lia.
-Qed.
-Global Instance ownM_proper: Proper ((≡) ==> (⊣⊢)) (@uPred_ownM M) := ne_proper _.
-Global Instance cmra_valid_ne {A : cmraT} :
- NonExpansive (@uPred_cmra_valid M A).
-Proof.
- intros n a b Ha; unseal; split=> n' x ? /=.
- by rewrite (dist_le _ _ _ _ Ha); last lia.
-Qed.
-Global Instance cmra_valid_proper {A : cmraT} :
- Proper ((≡) ==> (⊣⊢)) (@uPred_cmra_valid M A) := ne_proper _.
-Global Instance bupd_ne : NonExpansive (@uPred_bupd M).
-Proof.
- intros n P Q HPQ.
- unseal; split=> n' x; split; intros HP k yf ??;
- destruct (HP k yf) as (x'&?&?); auto;
- exists x'; split; auto; apply HPQ; eauto using cmra_validN_op_l.
-Qed.
-Global Instance bupd_proper : Proper ((≡) ==> (≡)) (@uPred_bupd M) := ne_proper _.
-Global Instance uPred_valid_proper : Proper ((⊣⊢) ==> iff) (@uPred_valid M).
-Proof. solve_proper. Qed.
-Global Instance uPred_valid_mono : Proper ((⊢) ==> impl) (@uPred_valid M).
-Proof. solve_proper. Qed.
-Global Instance uPred_valid_flip_mono :
- Proper (flip (⊢) ==> flip impl) (@uPred_valid M).
-Proof. solve_proper. Qed.
-
-(** Introduction and elimination rules *)
-Lemma pure_intro φ P : φ → P ⊢ ⌜φâŒ.
-Proof. by intros ?; unseal; split. Qed.
-Lemma pure_elim' φ P : (φ → True ⊢ P) → ⌜φ⌠⊢ P.
-Proof. unseal; intros HP; split=> n x ??. by apply HP. Qed.
-Lemma pure_forall_2 {A} (φ : A → Prop) : (∀ x : A, ⌜φ xâŒ) ⊢ ⌜∀ x : A, φ xâŒ.
-Proof. by unseal. Qed.
-
-Lemma and_elim_l P Q : P ∧ Q ⊢ P.
-Proof. by unseal; split=> n x ? [??]. Qed.
-Lemma and_elim_r P Q : P ∧ Q ⊢ Q.
-Proof. by unseal; split=> n x ? [??]. Qed.
-Lemma and_intro P Q R : (P ⊢ Q) → (P ⊢ R) → P ⊢ Q ∧ R.
-Proof. intros HQ HR; unseal; split=> n x ??; by split; [apply HQ|apply HR]. Qed.
-
-Lemma or_intro_l P Q : P ⊢ P ∨ Q.
-Proof. unseal; split=> n x ??; left; auto. Qed.
-Lemma or_intro_r P Q : Q ⊢ P ∨ Q.
-Proof. unseal; split=> n x ??; right; auto. Qed.
-Lemma or_elim P Q R : (P ⊢ R) → (Q ⊢ R) → P ∨ Q ⊢ R.
-Proof. intros HP HQ; unseal; split=> n x ? [?|?]. by apply HP. by apply HQ. Qed.
-
-Lemma impl_intro_r P Q R : (P ∧ Q ⊢ R) → P ⊢ Q → R.
-Proof.
- unseal; intros HQ; split=> n x ?? n' x' ????. apply HQ;
- naive_solver eauto using uPred_mono, uPred_closed, cmra_included_includedN.
-Qed.
-Lemma impl_elim P Q R : (P ⊢ Q → R) → (P ⊢ Q) → P ⊢ R.
-Proof. by unseal; intros HP HP'; split=> n x ??; apply HP with n x, HP'. Qed.
-
-Lemma forall_intro {A} P (Ψ : A → uPred M): (∀ a, P ⊢ Ψ a) → P ⊢ ∀ a, Ψ a.
-Proof. unseal; intros HPΨ; split=> n x ?? a; by apply HPΨ. Qed.
-Lemma forall_elim {A} {Ψ : A → uPred M} a : (∀ a, Ψ a) ⊢ Ψ a.
-Proof. unseal; split=> n x ? HP; apply HP. Qed.
-
-Lemma exist_intro {A} {Ψ : A → uPred M} a : Ψ a ⊢ ∃ a, Ψ a.
-Proof. unseal; split=> n x ??; by exists a. Qed.
-Lemma exist_elim {A} (Φ : A → uPred M) Q : (∀ a, Φ a ⊢ Q) → (∃ a, Φ a) ⊢ Q.
-Proof. unseal; intros HΦΨ; split=> n x ? [a ?]; by apply HΦΨ with a. Qed.
-
-Lemma internal_eq_refl {A : ofeT} (a : A) : uPred_valid (M:=M) (a ≡ a).
-Proof. unseal; by split=> n x ??; simpl. Qed.
-Lemma internal_eq_rewrite {A : ofeT} a b (Ψ : A → uPred M) P
- {HΨ : NonExpansive Ψ} : (P ⊢ a ≡ b) → (P ⊢ Ψ a) → P ⊢ Ψ b.
-Proof.
- unseal; intros Hab Ha; split=> n x ??. apply HΨ with n a; auto.
- - by symmetry; apply Hab with x.
- - by apply Ha.
-Qed.
-
-(* BI connectives *)
-Lemma sep_mono P P' Q Q' : (P ⊢ Q) → (P' ⊢ Q') → P ∗ P' ⊢ Q ∗ Q'.
-Proof.
- intros HQ HQ'; unseal.
- split; intros n' x ? (x1&x2&?&?&?); exists x1,x2; ofe_subst x;
- eauto 7 using cmra_validN_op_l, cmra_validN_op_r, uPred_in_entails.
-Qed.
-Lemma True_sep_1 P : P ⊢ True ∗ P.
-Proof.
- unseal; split; intros n x ??. exists (core x), x. by rewrite cmra_core_l.
-Qed.
-Lemma True_sep_2 P : True ∗ P ⊢ P.
-Proof.
- unseal; split; intros n x ? (x1&x2&?&_&?); ofe_subst;
- eauto using uPred_mono, cmra_includedN_r.
-Qed.
-Lemma sep_comm' P Q : P ∗ Q ⊢ Q ∗ P.
-Proof.
- unseal; split; intros n x ? (x1&x2&?&?&?); exists x2, x1; by rewrite (comm op).
-Qed.
-Lemma sep_assoc' P Q R : (P ∗ Q) ∗ R ⊢ P ∗ (Q ∗ R).
-Proof.
- unseal; split; intros n x ? (x1&x2&Hx&(y1&y2&Hy&?&?)&?).
- exists y1, (y2 â‹… x2); split_and?; auto.
- + by rewrite (assoc op) -Hy -Hx.
- + by exists y2, x2.
-Qed.
-Lemma wand_intro_r P Q R : (P ∗ Q ⊢ R) → P ⊢ Q -∗ R.
-Proof.
- unseal=> HPQR; split=> n x ?? n' x' ???; apply HPQR; auto.
- exists x, x'; split_and?; auto.
- eapply uPred_closed with n; eauto using cmra_validN_op_l.
-Qed.
-Lemma wand_elim_l' P Q R : (P ⊢ Q -∗ R) → P ∗ Q ⊢ R.
-Proof.
- unseal =>HPQR. split; intros n x ? (?&?&?&?&?). ofe_subst.
- eapply HPQR; eauto using cmra_validN_op_l.
-Qed.
-
-(* Always *)
-Lemma persistently_mono P Q : (P ⊢ Q) → □ P ⊢ □ Q.
-Proof. intros HP; unseal; split=> n x ? /=. by apply HP, cmra_core_validN. Qed.
-Lemma persistently_elim P : □ P ⊢ P.
-Proof.
- unseal; split=> n x ? /=.
- eauto using uPred_mono, @cmra_included_core, cmra_included_includedN.
-Qed.
-Lemma persistently_idemp_2 P : □ P ⊢ □ □ P.
-Proof. unseal; split=> n x ?? /=. by rewrite cmra_core_idemp. Qed.
-
-Lemma persistently_forall_2 {A} (Ψ : A → uPred M) : (∀ a, □ Ψ a) ⊢ (□ ∀ a, Ψ a).
-Proof. by unseal. Qed.
-Lemma persistently_exist_1 {A} (Ψ : A → uPred M) : (□ ∃ a, Ψ a) ⊢ (∃ a, □ Ψ a).
-Proof. by unseal. Qed.
-
-Lemma persistently_and_sep_l_1 P Q : □ P ∧ Q ⊢ □ P ∗ Q.
-Proof.
- unseal; split=> n x ? [??]; exists (core x), x; simpl in *.
- by rewrite cmra_core_l cmra_core_idemp.
-Qed.
-
-(* Later *)
-Lemma later_mono P Q : (P ⊢ Q) → ▷ P ⊢ ▷ Q.
-Proof.
- unseal=> HP; split=>-[|n] x ??; [done|apply HP; eauto using cmra_validN_S].
-Qed.
-Lemma löb P : (▷ P → P) ⊢ P.
-Proof.
- unseal; split=> n x ? HP; induction n as [|n IH]; [by apply HP|].
- apply HP, IH, uPred_closed with (S n); eauto using cmra_validN_S.
-Qed.
-Lemma later_forall_2 {A} (Φ : A → uPred M) : (∀ a, ▷ Φ a) ⊢ ▷ ∀ a, Φ a.
-Proof. unseal; by split=> -[|n] x. Qed.
-Lemma later_exist_false {A} (Φ : A → uPred M) :
- (▷ ∃ a, Φ a) ⊢ ▷ False ∨ (∃ a, ▷ Φ a).
-Proof. unseal; split=> -[|[|n]] x /=; eauto. Qed.
-Lemma later_sep P Q : ▷ (P ∗ Q) ⊣⊢ ▷ P ∗ ▷ Q.
-Proof.
- unseal; split=> n x ?; split.
- - destruct n as [|n]; simpl.
- { by exists x, (core x); rewrite cmra_core_r. }
- intros (x1&x2&Hx&?&?); destruct (cmra_extend n x x1 x2)
- as (y1&y2&Hx'&Hy1&Hy2); eauto using cmra_validN_S; simpl in *.
- exists y1, y2; split; [by rewrite Hx'|by rewrite Hy1 Hy2].
- - destruct n as [|n]; simpl; [done|intros (x1&x2&Hx&?&?)].
- exists x1, x2; eauto using dist_S.
-Qed.
-Lemma later_false_excluded_middle P : ▷ P ⊢ ▷ False ∨ (▷ False → P).
-Proof.
- unseal; split=> -[|n] x ? /= HP; [by left|right].
- intros [|n'] x' ????; [|done].
- eauto using uPred_closed, uPred_mono, cmra_included_includedN.
-Qed.
-Lemma persistently_later P : □ ▷ P ⊣⊢ ▷ □ P.
-Proof. by unseal. Qed.
-
-(* Own *)
-Lemma ownM_op (a1 a2 : M) :
- uPred_ownM (a1 ⋅ a2) ⊣⊢ uPred_ownM a1 ∗ uPred_ownM a2.
-Proof.
- unseal; split=> n x ?; split.
- - intros [z ?]; exists a1, (a2 â‹… z); split; [by rewrite (assoc op)|].
- split. by exists (core a1); rewrite cmra_core_r. by exists z.
- - intros (y1&y2&Hx&[z1 Hy1]&[z2 Hy2]); exists (z1 â‹… z2).
- by rewrite (assoc op _ z1) -(comm op z1) (assoc op z1)
- -(assoc op _ a2) (comm op z1) -Hy1 -Hy2.
-Qed.
-Lemma persistently_ownM_core (a : M) : uPred_ownM a ⊢ □ uPred_ownM (core a).
-Proof.
- split=> n x /=; unseal; intros Hx. simpl. by apply cmra_core_monoN.
-Qed.
-Lemma ownM_unit : uPred_valid (M:=M) (uPred_ownM ε).
-Proof. unseal; split=> n x ??; by exists x; rewrite left_id. Qed.
-Lemma later_ownM a : ▷ uPred_ownM a ⊢ ∃ b, uPred_ownM b ∧ ▷ (a ≡ b).
-Proof.
- unseal; split=> -[|n] x /= ? Hax; first by eauto using ucmra_unit_leastN.
- destruct Hax as [y ?].
- destruct (cmra_extend n x a y) as (a'&y'&Hx&?&?); auto using cmra_validN_S.
- exists a'. rewrite Hx. eauto using cmra_includedN_l.
-Qed.
-
-(* Valid *)
-Lemma ownM_valid (a : M) : uPred_ownM a ⊢ ✓ a.
-Proof.
- unseal; split=> n x Hv [a' ?]; ofe_subst; eauto using cmra_validN_op_l.
-Qed.
-Lemma cmra_valid_intro {A : cmraT} (a : A) : ✓ a → uPred_valid (M:=M) (✓ a).
-Proof. unseal=> ?; split=> n x ? _ /=; by apply cmra_valid_validN. Qed.
-Lemma cmra_valid_elim {A : cmraT} (a : A) : ¬ ✓{0} a → ✓ a ⊢ False.
-Proof. unseal=> Ha; split=> n x ??; apply Ha, cmra_validN_le with n; auto. Qed.
-Lemma persistently_cmra_valid_1 {A : cmraT} (a : A) : ✓ a ⊢ □ ✓ a.
-Proof. by unseal. Qed.
-Lemma cmra_valid_weaken {A : cmraT} (a b : A) : ✓ (a ⋅ b) ⊢ ✓ a.
-Proof. unseal; split=> n x _; apply cmra_validN_op_l. Qed.
-
-(* Basic update modality *)
-Lemma bupd_intro P : P ==∗ P.
-Proof.
- unseal. split=> n x ? HP k yf ?; exists x; split; first done.
- apply uPred_closed with n; eauto using cmra_validN_op_l.
-Qed.
-Lemma bupd_mono P Q : (P ⊢ Q) → (|==> P) ==∗ Q.
-Proof.
- unseal. intros HPQ; split=> n x ? HP k yf ??.
- destruct (HP k yf) as (x'&?&?); eauto.
- exists x'; split; eauto using uPred_in_entails, cmra_validN_op_l.
-Qed.
-Lemma bupd_trans P : (|==> |==> P) ==∗ P.
-Proof. unseal; split; naive_solver. Qed.
-Lemma bupd_frame_r P R : (|==> P) ∗ R ==∗ P ∗ R.
-Proof.
- unseal; split; intros n x ? (x1&x2&Hx&HP&?) k yf ??.
- destruct (HP k (x2 â‹… yf)) as (x'&?&?); eauto.
- { by rewrite assoc -(dist_le _ _ _ _ Hx); last lia. }
- exists (x' â‹… x2); split; first by rewrite -assoc.
- exists x', x2; split_and?; auto.
- apply uPred_closed with n; eauto 3 using cmra_validN_op_l, cmra_validN_op_r.
-Qed.
-Lemma bupd_ownM_updateP x (Φ : M → Prop) :
- x ~~>: Φ → uPred_ownM x ==∗ ∃ y, ⌜Φ y⌠∧ uPred_ownM y.
-Proof.
- unseal=> Hup; split=> n x2 ? [x3 Hx] k yf ??.
- destruct (Hup k (Some (x3 â‹… yf))) as (y&?&?); simpl in *.
- { rewrite /= assoc -(dist_le _ _ _ _ Hx); auto. }
- exists (y â‹… x3); split; first by rewrite -assoc.
- exists y; eauto using cmra_includedN_l.
-Qed.
-
-(* Products *)
-Lemma prod_equivI {A B : ofeT} (x y : A * B) : x ≡ y ⊣⊢ x.1 ≡ y.1 ∧ x.2 ≡ y.2.
-Proof. by unseal. Qed.
-Lemma prod_validI {A B : cmraT} (x : A * B) : ✓ x ⊣⊢ ✓ x.1 ∧ ✓ x.2.
-Proof. by unseal. Qed.
-
-(* Type-level Later *)
-Lemma later_equivI {A : ofeT} (x y : A) : Next x ≡ Next y ⊣⊢ ▷ (x ≡ y).
-Proof. by unseal. Qed.
-
-(* Discrete *)
-Lemma discrete_valid {A : cmraT} `{!CmraDiscrete A} (a : A) : ✓ a ⊣⊢ ⌜✓ aâŒ.
-Proof. unseal; split=> n x _. by rewrite /= -cmra_discrete_valid_iff. Qed.
-Lemma discrete_eq {A : ofeT} (a b : A) : Discrete a → a ≡ b ⊣⊢ ⌜a ≡ bâŒ.
-Proof.
- unseal=> ?. apply (anti_symm (⊢)); split=> n x ?; by apply (discrete_iff n).
-Qed.
-
-(* Option *)
-Lemma option_equivI {A : ofeT} (mx my : option A) :
- mx ≡ my ⊣⊢ match mx, my with
- | Some x, Some y => x ≡ y | None, None => True | _, _ => False
- end.
-Proof.
- unseal. do 2 split. by destruct 1. by destruct mx, my; try constructor.
-Qed.
-Lemma option_validI {A : cmraT} (mx : option A) :
- ✓ mx ⊣⊢ match mx with Some x => ✓ x | None => True end.
-Proof. unseal. by destruct mx. Qed.
-
-(* Contractive functions *)
-Lemma contractiveI {A B : ofeT} (f : A → B) :
- Contractive f ↔ (∀ a b, ▷ (a ≡ b) ⊢ f a ≡ f b).
-Proof.
- split; unseal; intros Hf.
- - intros a b; split=> n x _; apply Hf.
- - intros i a b; eapply Hf, ucmra_unit_validN.
-Qed.
-
-(* Functions *)
-Lemma ofe_funC_equivI {A B} (f g : A -c> B) : f ≡ g ⊣⊢ ∀ x, f x ≡ g x.
-Proof. by unseal. Qed.
-Lemma ofe_morC_equivI {A B : ofeT} (f g : A -n> B) : f ≡ g ⊣⊢ ∀ x, f x ≡ g x.
-Proof. by unseal. Qed.
-
-(* Sig ofes *)
-Lemma sig_equivI {A : ofeT} (P : A → Prop) (x y : sigC P) :
- x ≡ y ⊣⊢ proj1_sig x ≡ proj1_sig y.
-Proof. by unseal. Qed.
-End primitive.
-End uPred.
diff --git a/theories/base_logic/proofmode.v b/theories/base_logic/proofmode.v
new file mode 100644
index 000000000..f7144fc2a
--- /dev/null
+++ b/theories/base_logic/proofmode.v
@@ -0,0 +1,126 @@
+From iris.base_logic Require Export base_logic.
+From iris.proofmode Require Export tactics.
+From iris.base_logic Require Import proofmode_classes.
+Import uPred.
+Import bi.
+
+Hint Extern 1 (coq_tactics.of_envs _ ⊢ |==> _) => iModIntro.
+
+Section class_instances.
+Context {M : ucmraT}.
+Implicit Types P Q R : uPred M.
+
+Global Instance from_assumption_bupd p P Q :
+ FromAssumption p P Q → FromAssumption p P (|==> Q).
+Proof. rewrite /FromAssumption=>->. apply bupd_intro. Qed.
+
+Global Instance into_pure_cmra_valid `{CmraDiscrete A} (a : A) :
+ @IntoPure (uPredI M) (✓ a) (✓ a).
+Proof. by rewrite /IntoPure discrete_valid. Qed.
+
+Global Instance from_pure_bupd P φ : FromPure P φ → FromPure (|==> P) φ.
+Proof. rewrite /FromPure=> ->. apply bupd_intro. Qed.
+
+Global Instance from_pure_cmra_valid {A : cmraT} (a : A) :
+ @FromPure (uPredI M) (✓ a) (✓ a).
+Proof.
+ rewrite /FromPure. eapply bi.pure_elim; [done|]=> ?.
+ rewrite -cmra_valid_intro //. by apply pure_intro.
+Qed.
+
+Global Instance into_wand_bupd p q R P Q :
+ IntoWand false false R P Q → IntoWand p q (|==> R) (|==> P) (|==> Q).
+Proof.
+ rewrite /IntoWand /= => HR. rewrite !bare_persistently_if_elim HR.
+ apply wand_intro_l. by rewrite bupd_sep wand_elim_r.
+Qed.
+
+Global Instance into_wand_bupd_persistent p q R P Q :
+ IntoWand false q R P Q → IntoWand p q (|==> R) P (|==> Q).
+Proof.
+ rewrite /IntoWand /= => HR. rewrite bare_persistently_if_elim HR.
+ apply wand_intro_l. by rewrite bupd_frame_l wand_elim_r.
+Qed.
+
+Global Instance into_wand_bupd_args 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 bare_persistently_if_elim bupd_wand_r.
+Qed.
+
+(* FromOp *)
+(* TODO: Worst case there could be a lot of backtracking on these instances,
+try to refactor. *)
+Global Instance is_op_pair {A B : cmraT} (a b1 b2 : A) (a' b1' b2' : B) :
+ IsOp a b1 b2 → IsOp a' b1' b2' → IsOp' (a,a') (b1,b1') (b2,b2').
+Proof. by constructor. Qed.
+Global Instance is_op_pair_core_id_l {A B : cmraT} (a : A) (a' b1' b2' : B) :
+ CoreId a → IsOp a' b1' b2' → IsOp' (a,a') (a,b1') (a,b2').
+Proof. constructor=> //=. by rewrite -core_id_dup. Qed.
+Global Instance is_op_pair_core_id_r {A B : cmraT} (a b1 b2 : A) (a' : B) :
+ CoreId a' → IsOp a b1 b2 → IsOp' (a,a') (b1,a') (b2,a').
+Proof. constructor=> //=. by rewrite -core_id_dup. Qed.
+
+Global Instance is_op_Some {A : cmraT} (a : A) b1 b2 :
+ IsOp a b1 b2 → IsOp' (Some a) (Some b1) (Some b2).
+Proof. by constructor. Qed.
+(* This one has a higher precendence than [is_op_op] so we get a [+] instead of
+an [â‹…]. *)
+Global Instance is_op_plus (n1 n2 : nat) : IsOp (n1 + n2) n1 n2.
+Proof. done. Qed.
+
+Global Instance from_sep_ownM (a b1 b2 : M) :
+ IsOp a b1 b2 →
+ FromSep (uPred_ownM a) (uPred_ownM b1) (uPred_ownM b2).
+Proof. intros. by rewrite /FromSep -ownM_op -is_op. Qed.
+Global Instance from_sep_ownM_core_id (a b1 b2 : M) :
+ IsOp a b1 b2 → TCOr (CoreId b1) (CoreId b2) →
+ FromAnd (uPred_ownM a) (uPred_ownM b1) (uPred_ownM b2).
+Proof.
+ intros ? H. rewrite /FromAnd (is_op a) ownM_op.
+ destruct H. by rewrite persistent_and_sep_l. by rewrite persistent_and_sep_r.
+Qed.
+
+Global Instance into_and_ownM p (a b1 b2 : M) :
+ IsOp a b1 b2 → IntoAnd p (uPred_ownM a) (uPred_ownM b1) (uPred_ownM b2).
+Proof.
+ intros. apply bare_persistently_if_mono. by rewrite (is_op a) ownM_op sep_and.
+Qed.
+
+Global Instance into_sep_ownM p (a b1 b2 : M) :
+ IsOp a b1 b2 → IntoSep p (uPred_ownM a) (uPred_ownM b1) (uPred_ownM b2).
+Proof. intros. by rewrite /IntoSep (is_op a) ownM_op. Qed.
+
+Global Instance from_sep_bupd P Q1 Q2 :
+ FromSep P Q1 Q2 → FromSep (|==> P) (|==> Q1) (|==> Q2).
+Proof. rewrite /FromSep=><-. apply bupd_sep. Qed.
+
+Global Instance from_or_bupd 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.
+
+Global Instance from_exist_bupd {A} P (Φ : A → uPred M) :
+ FromExist P Φ → FromExist (|==> P) (λ a, |==> Φ a)%I.
+Proof.
+ rewrite /FromExist=><-. apply exist_elim=> a. by rewrite -(exist_intro a).
+Qed.
+
+Global Instance from_modal_bupd P : FromModal (|==> P) P.
+Proof. apply bupd_intro. Qed.
+
+Global Instance elim_modal_bupd P Q : ElimModal (|==> P) P (|==> Q) (|==> Q).
+Proof. by rewrite /ElimModal bupd_frame_r wand_elim_r bupd_trans. Qed.
+
+Global Instance is_except_0_bupd 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 frame_bupd p R P Q : Frame p R P Q → Frame p R (|==> P) (|==> Q).
+Proof. rewrite /Frame=><-. by rewrite bupd_frame_l. Qed.
+End class_instances.
diff --git a/theories/base_logic/proofmode_classes.v b/theories/base_logic/proofmode_classes.v
new file mode 100644
index 000000000..e24217f6c
--- /dev/null
+++ b/theories/base_logic/proofmode_classes.v
@@ -0,0 +1,33 @@
+From iris.proofmode Require Export classes.
+From iris.base_logic Require Export base_logic.
+
+(* There are various versions of [IsOp] with different modes:
+
+- [IsOp a b1 b2]: this one has no mode, it can be used regardless of whether
+ any of the arguments is an evar. This class has only one direct instance:
+ [IsOp (a â‹… b) a b].
+- [IsOp' a b1 b2]: requires either [a] to start with a constructor, OR [b1] and
+ [b2] to start with a constructor. All usual instances should be of this
+ class to avoid loops.
+- [IsOp'LR a b1 b2]: requires either [a] to start with a constructor. This one
+ has just one instance: [IsOp'LR (a â‹… b) a b] with a very low precendence.
+ This is important so that when performing, for example, an [iDestruct] on
+ [own γ (q1 + q2)] where [q1] and [q2] are fractions, we actually get
+ [own γ q1] and [own γ q2] instead of [own γ ((q1 + q2)/2)] twice.
+*)
+Class IsOp {A : cmraT} (a b1 b2 : A) := is_op : a ≡ b1 ⋅ b2.
+Arguments is_op {_} _ _ _ {_}.
+Hint Mode IsOp + - - - : typeclass_instances.
+
+Instance is_op_op {A : cmraT} (a b : A) : IsOp (a â‹… b) a b | 100.
+Proof. by rewrite /IsOp. Qed.
+
+Class IsOp' {A : cmraT} (a b1 b2 : A) := is_op' :> IsOp a b1 b2.
+Hint Mode IsOp' + ! - - : typeclass_instances.
+Hint Mode IsOp' + - ! ! : typeclass_instances.
+
+Class IsOp'LR {A : cmraT} (a b1 b2 : A) := is_op_lr : IsOp a b1 b2.
+Existing Instance is_op_lr | 0.
+Hint Mode IsOp'LR + ! - - : typeclass_instances.
+Instance is_op_lr_op {A : cmraT} (a b : A) : IsOp'LR (a â‹… b) a b | 0.
+Proof. by rewrite /IsOp'LR /IsOp. Qed.
\ No newline at end of file
diff --git a/theories/base_logic/soundness.v b/theories/base_logic/soundness.v
index e2c764eee..e4d3b97b1 100644
--- a/theories/base_logic/soundness.v
+++ b/theories/base_logic/soundness.v
@@ -6,20 +6,22 @@ Section adequacy.
Context {M : ucmraT}.
(** Consistency and adequancy statements *)
-Lemma soundness φ n : (Nat.iter n (λ P, |==> ▷ P) (@uPred_pure M φ))%I → φ.
+Lemma soundness φ n :
+ bi_valid (PROP:=uPredI M) (Nat.iter n (λ P, |==> â–· P) (⌜ φ âŒ))%I → φ.
Proof.
cut (∀ x, ✓{n} x → Nat.iter n (λ P, |==> ▷ P)%I (@uPred_pure M φ) n x → φ).
{ intros help H. eapply (help ∅); eauto using ucmra_unit_validN.
- eapply H; try unseal; by eauto using ucmra_unit_validN. }
+ eapply H; first by eauto using ucmra_unit_validN.
+ rewrite /bi_emp /= /uPred_emp. by unseal. }
unseal. induction n as [|n IH]=> x Hx Hupd; auto.
destruct (Hupd (S n) ε) as (x'&?&?); rewrite ?right_id; auto.
eapply IH with x'; eauto using cmra_validN_S, cmra_validN_op_l.
Qed.
Corollary consistency_modal n :
- ¬ (Nat.iter n (λ P, |==> ▷ P) (False : uPred M))%I.
+ ¬bi_valid (PROP:=uPredI M) (Nat.iter n (λ P, |==> ▷ P) (False : uPred M))%I.
Proof. exact (soundness False n). Qed.
-Corollary consistency : ¬ (False : uPred M)%I.
+Corollary consistency : ¬bi_valid (PROP:=uPredI M) False.
Proof. exact (consistency_modal 0). Qed.
End adequacy.
diff --git a/theories/base_logic/upred.v b/theories/base_logic/upred.v
index 801608cd7..b1ade65d7 100644
--- a/theories/base_logic/upred.v
+++ b/theories/base_logic/upred.v
@@ -1,5 +1,9 @@
-From iris.algebra Require Export cmra.
+From iris.algebra Require Export cmra updates.
+From iris.bi Require Export interface.
Set Default Proof Using "Type".
+Local Hint Extern 1 (_ ≼ _) => etrans; [eassumption|].
+Local Hint Extern 1 (_ ≼ _) => etrans; [|eassumption].
+Local Hint Extern 10 (_ ≤ _) => omega.
(** The basic definition of the uPred type, its metric and functor laws.
You probably do not want to import this file. Instead, import
@@ -35,8 +39,7 @@ Arguments uPred_holds {_} _ _ _ : simpl never.
Add Printing Constructor uPred.
Instance: Params (@uPred_holds) 3.
-Delimit Scope uPred_scope with I.
-Bind Scope uPred_scope with uPred.
+Bind Scope bi_scope with uPred.
Arguments uPred_holds {_} _%I _ _.
Section cofe.
@@ -151,54 +154,417 @@ Qed.
(** logical entailement *)
Inductive uPred_entails {M} (P Q : uPred M) : Prop :=
{ uPred_in_entails : ∀ n x, ✓{n} x → P n x → Q n x }.
-Hint Extern 0 (uPred_entails _ _) => reflexivity.
-Instance uPred_entails_rewrite_relation M : RewriteRelation (@uPred_entails M).
-
Hint Resolve uPred_mono uPred_closed : uPred_def.
-(** Notations *)
-Notation "P ⊢ Q" := (uPred_entails P%I Q%I)
- (at level 99, Q at level 200, right associativity) : C_scope.
-Notation "(⊢)" := uPred_entails (only parsing) : C_scope.
-Notation "P ⊣⊢ Q" := (equiv (A:=uPred _) P%I Q%I)
- (at level 95, no associativity) : C_scope.
-Notation "(⊣⊢)" := (equiv (A:=uPred _)) (only parsing) : C_scope.
+(** logical connectives *)
+Program Definition uPred_pure_def {M} (φ : Prop) : uPred M :=
+ {| uPred_holds n x := φ |}.
+Solve Obligations with done.
+Definition uPred_pure_aux : seal (@uPred_pure_def). by eexists. Qed.
+Definition uPred_pure {M} := unseal uPred_pure_aux M.
+Definition uPred_pure_eq :
+ @uPred_pure = @uPred_pure_def := seal_eq uPred_pure_aux.
+
+Definition uPred_emp {M} : uPred M := uPred_pure True.
+
+Program Definition uPred_and_def {M} (P Q : uPred M) : uPred M :=
+ {| uPred_holds n x := P n x ∧ Q n x |}.
+Solve Obligations with naive_solver eauto 2 with uPred_def.
+Definition uPred_and_aux : seal (@uPred_and_def). by eexists. Qed.
+Definition uPred_and {M} := unseal uPred_and_aux M.
+Definition uPred_and_eq: @uPred_and = @uPred_and_def := seal_eq uPred_and_aux.
+
+Program Definition uPred_or_def {M} (P Q : uPred M) : uPred M :=
+ {| uPred_holds n x := P n x ∨ Q n x |}.
+Solve Obligations with naive_solver eauto 2 with uPred_def.
+Definition uPred_or_aux : seal (@uPred_or_def). by eexists. Qed.
+Definition uPred_or {M} := unseal uPred_or_aux M.
+Definition uPred_or_eq: @uPred_or = @uPred_or_def := seal_eq uPred_or_aux.
+
+Program Definition uPred_impl_def {M} (P Q : uPred M) : uPred M :=
+ {| uPred_holds n x := ∀ n' x',
+ x ≼ x' → n' ≤ n → ✓{n'} x' → P n' x' → Q n' x' |}.
+Next Obligation.
+ intros M P Q n1 x1 x1' HPQ [x2 Hx1'] n2 x3 [x4 Hx3] ?; simpl in *.
+ rewrite Hx3 (dist_le _ _ _ _ Hx1'); auto. intros ??.
+ eapply HPQ; auto. exists (x2 â‹… x4); by rewrite assoc.
+Qed.
+Next Obligation. intros M P Q [|n1] [|n2] x; auto with lia. Qed.
+Definition uPred_impl_aux : seal (@uPred_impl_def). by eexists. Qed.
+Definition uPred_impl {M} := unseal uPred_impl_aux M.
+Definition uPred_impl_eq :
+ @uPred_impl = @uPred_impl_def := seal_eq uPred_impl_aux.
+
+Program Definition uPred_forall_def {M A} (Ψ : A → uPred M) : uPred M :=
+ {| uPred_holds n x := ∀ a, Ψ a n x |}.
+Solve Obligations with naive_solver eauto 2 with uPred_def.
+Definition uPred_forall_aux : seal (@uPred_forall_def). by eexists. Qed.
+Definition uPred_forall {M A} := unseal uPred_forall_aux M A.
+Definition uPred_forall_eq :
+ @uPred_forall = @uPred_forall_def := seal_eq uPred_forall_aux.
+
+Program Definition uPred_exist_def {M A} (Ψ : A → uPred M) : uPred M :=
+ {| uPred_holds n x := ∃ a, Ψ a n x |}.
+Solve Obligations with naive_solver eauto 2 with uPred_def.
+Definition uPred_exist_aux : seal (@uPred_exist_def). by eexists. Qed.
+Definition uPred_exist {M A} := unseal uPred_exist_aux M A.
+Definition uPred_exist_eq: @uPred_exist = @uPred_exist_def := seal_eq uPred_exist_aux.
+
+Program Definition uPred_internal_eq_def {M} {A : ofeT} (a1 a2 : A) : uPred M :=
+ {| uPred_holds n x := a1 ≡{n}≡ a2 |}.
+Solve Obligations with naive_solver eauto 2 using (dist_le (A:=A)).
+Definition uPred_internal_eq_aux : seal (@uPred_internal_eq_def). by eexists. Qed.
+Definition uPred_internal_eq {M A} := unseal uPred_internal_eq_aux M A.
+Definition uPred_internal_eq_eq:
+ @uPred_internal_eq = @uPred_internal_eq_def := seal_eq uPred_internal_eq_aux.
+
+Program Definition uPred_sep_def {M} (P Q : uPred M) : uPred M :=
+ {| uPred_holds n x := ∃ x1 x2, x ≡{n}≡ x1 ⋅ x2 ∧ P n x1 ∧ Q n x2 |}.
+Next Obligation.
+ intros M P Q n x y (x1&x2&Hx&?&?) [z Hy].
+ exists x1, (x2 â‹… z); split_and?; eauto using uPred_mono, cmra_includedN_l.
+ by rewrite Hy Hx assoc.
+Qed.
+Next Obligation.
+ intros M P Q n1 n2 x (x1&x2&Hx&?&?) ?; rewrite {1}(dist_le _ _ _ _ Hx) // =>?.
+ exists x1, x2; ofe_subst; split_and!;
+ eauto using dist_le, uPred_closed, cmra_validN_op_l, cmra_validN_op_r.
+Qed.
+Definition uPred_sep_aux : seal (@uPred_sep_def). by eexists. Qed.
+Definition uPred_sep {M} := unseal uPred_sep_aux M.
+Definition uPred_sep_eq: @uPred_sep = @uPred_sep_def := seal_eq uPred_sep_aux.
+
+Program Definition uPred_wand_def {M} (P Q : uPred M) : uPred M :=
+ {| uPred_holds n x := ∀ n' x',
+ n' ≤ n → ✓{n'} (x ⋅ x') → P n' x' → Q n' (x ⋅ x') |}.
+Next Obligation.
+ intros M P Q n x1 x1' HPQ ? n3 x3 ???; simpl in *.
+ apply uPred_mono with (x1 â‹… x3);
+ eauto using cmra_validN_includedN, cmra_monoN_r, cmra_includedN_le.
+Qed.
+Next Obligation. naive_solver. Qed.
+Definition uPred_wand_aux : seal (@uPred_wand_def). by eexists. Qed.
+Definition uPred_wand {M} := unseal uPred_wand_aux M.
+Definition uPred_wand_eq :
+ @uPred_wand = @uPred_wand_def := seal_eq uPred_wand_aux.
+
+Program Definition uPred_persistently_def {M} (P : uPred M) : uPred M :=
+ {| uPred_holds n x := P n (core x) |}.
+Next Obligation.
+ intros M; naive_solver eauto using uPred_mono, @cmra_core_monoN.
+Qed.
+Next Obligation. naive_solver eauto using uPred_closed, @cmra_core_validN. Qed.
+Definition uPred_persistently_aux : seal (@uPred_persistently_def). by eexists. Qed.
+Definition uPred_persistently {M} := unseal uPred_persistently_aux M.
+Definition uPred_persistently_eq :
+ @uPred_persistently = @uPred_persistently_def := seal_eq uPred_persistently_aux.
+
+Program Definition uPred_later_def {M} (P : uPred M) : uPred M :=
+ {| uPred_holds n x := match n return _ with 0 => True | S n' => P n' x end |}.
+Next Obligation.
+ intros M P [|n] x1 x2; eauto using uPred_mono, cmra_includedN_S.
+Qed.
+Next Obligation.
+ intros M P [|n1] [|n2] x; eauto using uPred_closed, cmra_validN_S with lia.
+Qed.
+Definition uPred_later_aux : seal (@uPred_later_def). by eexists. Qed.
+Definition uPred_later {M} := unseal uPred_later_aux M.
+Definition uPred_later_eq :
+ @uPred_later = @uPred_later_def := seal_eq uPred_later_aux.
+
+Program Definition uPred_ownM_def {M : ucmraT} (a : M) : uPred M :=
+ {| uPred_holds n x := a ≼{n} x |}.
+Next Obligation.
+ intros M a n x1 x [a' Hx1] [x2 ->].
+ exists (a' â‹… x2). by rewrite (assoc op) Hx1.
+Qed.
+Next Obligation. naive_solver eauto using cmra_includedN_le. Qed.
+Definition uPred_ownM_aux : seal (@uPred_ownM_def). by eexists. Qed.
+Definition uPred_ownM {M} := unseal uPred_ownM_aux M.
+Definition uPred_ownM_eq :
+ @uPred_ownM = @uPred_ownM_def := seal_eq uPred_ownM_aux.
+
+Program Definition uPred_cmra_valid_def {M} {A : cmraT} (a : A) : uPred M :=
+ {| uPred_holds n x := ✓{n} a |}.
+Solve Obligations with naive_solver eauto 2 using cmra_validN_le.
+Definition uPred_cmra_valid_aux : seal (@uPred_cmra_valid_def). by eexists. Qed.
+Definition uPred_cmra_valid {M A} := unseal uPred_cmra_valid_aux M A.
+Definition uPred_cmra_valid_eq :
+ @uPred_cmra_valid = @uPred_cmra_valid_def := seal_eq uPred_cmra_valid_aux.
+
+Program Definition uPred_bupd_def {M} (Q : uPred M) : uPred M :=
+ {| uPred_holds n x := ∀ k yf,
+ k ≤ n → ✓{k} (x ⋅ yf) → ∃ x', ✓{k} (x' ⋅ yf) ∧ Q k x' |}.
+Next Obligation.
+ intros M Q n x1 x2 HQ [x3 Hx] k yf Hk.
+ rewrite (dist_le _ _ _ _ Hx); last lia. intros Hxy.
+ destruct (HQ k (x3 â‹… yf)) as (x'&?&?); [auto|by rewrite assoc|].
+ exists (x' â‹… x3); split; first by rewrite -assoc.
+ apply uPred_mono with x'; eauto using cmra_includedN_l.
+Qed.
+Next Obligation. naive_solver. Qed.
+Definition uPred_bupd_aux : seal (@uPred_bupd_def). by eexists. Qed.
+Definition uPred_bupd {M} := unseal uPred_bupd_aux M.
+Definition uPred_bupd_eq : @uPred_bupd = @uPred_bupd_def := seal_eq uPred_bupd_aux.
+
+Module uPred_unseal.
+Definition unseal_eqs :=
+ (uPred_pure_eq, uPred_and_eq, uPred_or_eq, uPred_impl_eq, uPred_forall_eq,
+ uPred_exist_eq, uPred_internal_eq_eq, uPred_sep_eq, uPred_wand_eq,
+ uPred_persistently_eq, uPred_later_eq, uPred_ownM_eq, uPred_cmra_valid_eq,
+ uPred_bupd_eq).
+Ltac unseal := rewrite
+ /bi_emp /= /uPred_emp /bi_pure /bi_and /bi_or /bi_impl
+ /bi_forall /bi_exist /bi_internal_eq /bi_sep /bi_wand /bi_persistently
+ /bi_later /=
+ /sbi_emp /sbi_pure /sbi_and /sbi_or /sbi_impl
+ /sbi_forall /sbi_exist /sbi_internal_eq /sbi_sep /sbi_wand /sbi_persistently /=
+ !unseal_eqs /=.
+End uPred_unseal.
+Import uPred_unseal.
+
+Local Arguments uPred_holds {_} !_ _ _ /.
+
+Lemma uPred_bi_mixin (M : ucmraT) : BIMixin
+ uPred_entails uPred_emp uPred_pure uPred_and uPred_or uPred_impl
+ (@uPred_forall M) (@uPred_exist M) (@uPred_internal_eq M)
+ uPred_sep uPred_wand uPred_persistently.
+Proof.
+ split.
+ - (* PreOrder uPred_entails *)
+ split.
+ + by intros P; split=> x i.
+ + by intros P Q Q' HP HQ; split=> x i ??; apply HQ, HP.
+ - (* (P ⊣⊢ Q) ↔ (P ⊢ Q) ∧ (Q ⊢ P) *)
+ intros P Q. split.
+ + intros HPQ; split; split=> x i; apply HPQ.
+ + intros [HPQ HQP]; split=> x n; by split; [apply HPQ|apply HQP].
+ - (* Proper (iff ==> dist n) (@uPred_pure M) *)
+ intros φ1 φ2 Hφ. by unseal; split=> -[|n] ?; try apply Hφ.
+ - (* NonExpansive2 uPred_and *)
+ intros n P P' HP Q Q' HQ; unseal; split=> x n' ??.
+ split; (intros [??]; split; [by apply HP|by apply HQ]).
+ - (* NonExpansive2 uPred_or *)
+ intros n P P' HP Q Q' HQ; split=> x n' ??.
+ unseal; split; (intros [?|?]; [left; by apply HP|right; by apply HQ]).
+ - (* NonExpansive2 uPred_impl *)
+ intros n P P' HP Q Q' HQ; split=> x n' ??.
+ unseal; split; intros HPQ x' n'' ????; apply HQ, HPQ, HP; auto.
+ - (* Proper (pointwise_relation A (dist n) ==> dist n) uPred_forall *)
+ by intros A n Ψ1 Ψ2 HΨ; unseal; split=> n' x; split; intros HP a; apply HΨ.
+ - (* Proper (pointwise_relation A (dist n) ==> dist n) uPred_exist *)
+ intros A n Ψ1 Ψ2 HΨ.
+ unseal; split=> n' x ??; split; intros [a ?]; exists a; by apply HΨ.
+ - (* NonExpansive2 uPred_sep *)
+ intros n P P' HP Q Q' HQ; split=> n' x ??.
+ unseal; split; intros (x1&x2&?&?&?); ofe_subst x;
+ exists x1, x2; split_and!; try (apply HP || apply HQ);
+ eauto using cmra_validN_op_l, cmra_validN_op_r.
+ - (* NonExpansive2 uPred_wand *)
+ intros n P P' HP Q Q' HQ; split=> n' x ??.
+ unseal; split; intros HPQ x' n'' ???;
+ apply HQ, HPQ, HP; eauto using cmra_validN_op_r.
+ - (* NonExpansive uPred_persistently *)
+ intros n P1 P2 HP.
+ unseal; split=> n' x; split; apply HP; eauto using @cmra_core_validN.
+ - (* NonExpansive2 (@uPred_internal_eq M A) *)
+ intros A n x x' Hx y y' Hy; split=> n' z; unseal; split; intros; simpl in *.
+ + by rewrite -(dist_le _ _ _ _ Hx) -?(dist_le _ _ _ _ Hy); auto.
+ + by rewrite (dist_le _ _ _ _ Hx) ?(dist_le _ _ _ _ Hy); auto.
+ - (* φ → P ⊢ ⌜φ⌠*)
+ intros P φ ?. unseal; by split.
+ - (* (φ → True ⊢ P) → ⌜φ⌠⊢ P *)
+ intros φ P. unseal=> HP; split=> n x ??. by apply HP.
+ - (* (∀ x : A, ⌜φ xâŒ) ⊢ ⌜∀ x : A, φ x⌠*)
+ by unseal.
+ - (* P ∧ Q ⊢ P *)
+ intros P Q. unseal; by split=> n x ? [??].
+ - (* P ∧ Q ⊢ Q *)
+ intros P Q. unseal; by split=> n x ? [??].
+ - (* (P ⊢ Q) → (P ⊢ R) → P ⊢ Q ∧ R *)
+ intros P Q R HQ HR; unseal; split=> n x ??; by split; [apply HQ|apply HR].
+ - (* P ⊢ P ∨ Q *)
+ intros P Q. unseal; split=> n x ??; left; auto.
+ - (* Q ⊢ P ∨ Q *)
+ intros P Q. unseal; split=> n x ??; right; auto.
+ - (* (P ⊢ R) → (Q ⊢ R) → P ∨ Q ⊢ R *)
+ intros P Q R HP HQ. unseal; split=> n x ? [?|?]. by apply HP. by apply HQ.
+ - (* (P ∧ Q ⊢ R) → P ⊢ Q → R. *)
+ intros P Q R. unseal => HQ; split=> n x ?? n' x' ????. apply HQ;
+ naive_solver eauto using uPred_mono, uPred_closed, cmra_included_includedN.
+ - (* (P ⊢ Q → R) → P ∧ Q ⊢ R *)
+ intros P Q R. unseal=> HP; split=> n x ? [??]. apply HP with n x; auto.
+ - (* (∀ a, P ⊢ Ψ a) → P ⊢ ∀ a, Ψ a *)
+ intros A P Ψ. unseal; intros HPΨ; split=> n x ?? a; by apply HPΨ.
+ - (* (∀ a, Ψ a) ⊢ Ψ a *)
+ intros A Ψ a. unseal; split=> n x ? HP; apply HP.
+ - (* Ψ a ⊢ ∃ a, Ψ a *)
+ intros A Ψ a. unseal; split=> n x ??; by exists a.
+ - (* (∀ a, Ψ a ⊢ Q) → (∃ a, Ψ a) ⊢ Q *)
+ intros A Ψ Q. unseal; intros HΨ; split=> n x ? [a ?]; by apply HΨ with a.
+ - (* P ⊢ a ≡ a *)
+ intros A P a. unseal; by split=> n x ?? /=.
+ - (* a ≡ b ⊢ Ψ a → Ψ b *)
+ intros A a b Ψ Hnonexp.
+ unseal; split=> n x ? Hab n' x' ??? HΨ. eapply Hnonexp with n a; auto.
+ - (* (∀ x, f x ≡ g x) ⊢ f ≡ g *)
+ by unseal.
+ - (* `x ≡ `y ⊢ x ≡ y *)
+ by unseal.
+ - (* Discrete a → a ≡ b ⊣⊢ ⌜a ≡ b⌠*)
+ intros A a b ?. unseal; split=> n x ?; by apply (discrete_iff n).
+ - (* (P ⊢ Q) → (P' ⊢ Q') → P ∗ P' ⊢ Q ∗ Q' *)
+ intros P P' Q Q' HQ HQ'; unseal.
+ split; intros n' x ? (x1&x2&?&?&?); exists x1,x2; ofe_subst x;
+ eauto 7 using cmra_validN_op_l, cmra_validN_op_r, uPred_in_entails.
+ - (* P ⊢ emp ∗ P *)
+ intros P. rewrite /uPred_emp. unseal; split=> n x ?? /=.
+ exists (core x), x. by rewrite cmra_core_l.
+ - (* emp ∗ P ⊢ P *)
+ intros P. unseal; split; intros n x ? (x1&x2&?&_&?); ofe_subst;
+ eauto using uPred_mono, cmra_includedN_r.
+ - (* P ∗ Q ⊢ Q ∗ P *)
+ intros P Q. unseal; split; intros n x ? (x1&x2&?&?&?).
+ exists x2, x1; by rewrite (comm op).
+ - (* (P ∗ Q) ∗ R ⊢ P ∗ (Q ∗ R) *)
+ intros P Q R. unseal; split; intros n x ? (x1&x2&Hx&(y1&y2&Hy&?&?)&?).
+ exists y1, (y2 â‹… x2); split_and?; auto.
+ + by rewrite (assoc op) -Hy -Hx.
+ + by exists y2, x2.
+ - (* (P ∗ Q ⊢ R) → P ⊢ Q -∗ R *)
+ intros P Q R. unseal=> HPQR; split=> n x ?? n' x' ???; apply HPQR; auto.
+ exists x, x'; split_and?; auto.
+ eapply uPred_closed with n; eauto using cmra_validN_op_l.
+ - (* (P ⊢ Q -∗ R) → P ∗ Q ⊢ R *)
+ intros P Q R. unseal=> HPQR. split; intros n x ? (?&?&?&?&?). ofe_subst.
+ eapply HPQR; eauto using cmra_validN_op_l.
+ - (* emp ∧ (Q ∗ R) ⊢ (emp ∧ Q) ∗ R (ADMISSIBLE) *)
+ intros Q R. unfold uPred_emp; unseal; split; intros n x ? [_ (x1&x2&?&?&?)].
+ exists x1, x2; simpl; auto.
+ - (* (P ⊢ Q) → □ P ⊢ □ Q *)
+ intros P QR HP. unseal; split=> n x ? /=. by apply HP, cmra_core_validN.
+ - (* □ P ⊢ □ □ P *)
+ intros P. unseal; split=> n x ?? /=. by rewrite cmra_core_idemp.
+ - (* (∀ a, □ Ψ a) ⊢ □ ∀ a, Ψ a *)
+ by unseal.
+ - (* □ (∃ a, Ψ a) ⊢ ∃ a, □ Ψ a *)
+ by unseal.
+ - (* P ⊢ □ emp (ADMISSIBLE) *)
+ intros P. unfold uPred_emp; unseal; by split=> n x ? _.
+ - (* emp ∧ □ P ⊢ P *)
+ intros P. unseal; split=> n x ? [_ ?]; simpl in *.
+ eauto using uPred_mono, @cmra_included_core, cmra_included_includedN.
+ - (* □ P ∗ Q ⊢ □ P (ADMISSIBLE) *)
+ intros P Q. move: (uPred_persistently P)=> P'.
+ unseal; split; intros n x ? (x1&x2&?&?&_); ofe_subst;
+ eauto using uPred_mono, cmra_includedN_l.
+ - (* □ P ∧ (Q ∗ R) ⊢ (□ P ∧ Q) ∗ R (ADMISSIBLE) *)
+ intros P Q R. unseal; split; intros n x ? [? (x1&x2&Hx&?&?)]; simpl in *.
+ exists (core (x1 â‹… x2) â‹… x1), x2. split_and!.
+ + by rewrite -assoc cmra_core_l.
+ + eapply uPred_mono; first done. rewrite -{1}cmra_core_idemp Hx.
+ eapply cmra_core_monoN, cmra_includedN_l.
+ + eauto using uPred_mono, cmra_includedN_r.
+ + done.
+Qed.
+
+Lemma uPred_sbi_mixin (M : ucmraT) : SBIMixin
+ uPred_entails uPred_emp uPred_pure uPred_or uPred_impl
+ (@uPred_forall M) (@uPred_exist M) (@uPred_internal_eq M)
+ uPred_sep uPred_persistently uPred_later.
+Proof.
+ split.
+ - (* Contractive bi_later *)
+ unseal; intros [|n] P Q HPQ; split=> -[|n'] x ?? //=; try omega.
+ apply HPQ; eauto using cmra_validN_S.
+ - (* Next x ≡ Next y ⊢ ▷ (x ≡ y) *)
+ by unseal.
+ - (* ▷ (x ≡ y) ⊢ Next x ≡ Next y *)
+ by unseal.
+ - (* (P ⊢ Q) → ▷ P ⊢ ▷ Q *)
+ intros P Q.
+ unseal=> HP; split=>-[|n] x ??; [done|apply HP; eauto using cmra_validN_S].
+ - (* (▷ P → P) ⊢ P *)
+ intros P. unseal; split=> n x ? HP; induction n as [|n IH]; [by apply HP|].
+ apply HP, IH, uPred_closed with (S n); eauto using cmra_validN_S.
+ - (* (∀ a, ▷ Φ a) ⊢ ▷ ∀ a, Φ a *)
+ intros A Φ. unseal; by split=> -[|n] x.
+ - (* (▷ ∃ a, Φ a) ⊢ ▷ False ∨ (∃ a, ▷ Φ a) *)
+ intros A Φ. unseal; split=> -[|[|n]] x /=; eauto.
+ - (* ▷ emp ⊢ ▷ False ∨ emp *)
+ rewrite /uPred_emp. unseal; split; by right.
+ - (* ▷ (P ∗ Q) ⊢ ▷ P ∗ ▷ Q *)
+ intros P Q. unseal; split=> -[|n] x ? /=.
+ { by exists x, (core x); rewrite cmra_core_r. }
+ intros (x1&x2&Hx&?&?); destruct (cmra_extend n x x1 x2)
+ as (y1&y2&Hx'&Hy1&Hy2); eauto using cmra_validN_S; simpl in *.
+ exists y1, y2; split; [by rewrite Hx'|by rewrite Hy1 Hy2].
+ - (* ▷ P ∗ ▷ Q ⊢ ▷ (P ∗ Q) *)
+ intros P Q. unseal; split=> -[|n] x ? /=; [done|intros (x1&x2&Hx&?&?)].
+ exists x1, x2; eauto using dist_S.
+ - (* ▷ □ P ⊢ □ ▷ P *)
+ by unseal.
+ - (* □ ▷ P ⊢ ▷ □ P *)
+ by unseal.
+ - (* ▷ P ⊢ ▷ False ∨ (▷ False → P) *)
+ intros P. unseal; split=> -[|n] x ? /= HP; [by left|right].
+ intros [|n'] x' ????; [|done].
+ eauto using uPred_closed, uPred_mono, cmra_included_includedN.
+Qed.
+
+Canonical Structure uPredI (M : ucmraT) : bi :=
+ {| bi_ofe_mixin := ofe_mixin_of (uPred M); bi_bi_mixin := uPred_bi_mixin M |}.
+Canonical Structure uPredSI (M : ucmraT) : sbi :=
+ {| sbi_ofe_mixin := ofe_mixin_of (uPred M);
+ sbi_bi_mixin := uPred_bi_mixin M; sbi_sbi_mixin := uPred_sbi_mixin M |}.
+
+Coercion uPred_valid {M} : uPred M → Prop := bi_valid.
+
+(* Latest notation *)
+Notation "✓ x" := (uPred_cmra_valid x) (at level 20) : bi_scope.
+Notation "|==> Q" := (uPred_bupd Q)
+ (at level 99, Q at level 200, format "|==> Q") : bi_scope.
+Notation "P ==∗ Q" := (P ⊢ |==> Q)
+ (at level 99, Q at level 200, only parsing) : C_scope.
+Notation "P ==∗ Q" := (P -∗ |==> Q)%I
+ (at level 99, Q at level 200, format "P ==∗ Q") : bi_scope.
Module uPred.
-Section entails.
+Include uPred_unseal.
+Section uPred.
Context {M : ucmraT}.
+Implicit Types φ : Prop.
Implicit Types P Q : uPred M.
+Implicit Types A : Type.
+Arguments uPred_holds {_} !_ _ _ /.
+Hint Immediate uPred_in_entails.
-Global Instance entails_po : PreOrder (@uPred_entails M).
+Global Instance ownM_ne : NonExpansive (@uPred_ownM M).
Proof.
- split.
- - by intros P; split=> x i.
- - by intros P Q Q' HP HQ; split=> x i ??; apply HQ, HP.
+ intros n a b Ha.
+ unseal; split=> n' x ? /=. by rewrite (dist_le _ _ _ _ Ha); last lia.
Qed.
-Global Instance entails_anti_sym : AntiSymm (⊣⊢) (@uPred_entails M).
-Proof. intros P Q HPQ HQP; split=> x n; by split; [apply HPQ|apply HQP]. Qed.
+Global Instance ownM_proper: Proper ((≡) ==> (⊣⊢)) (@uPred_ownM M) := ne_proper _.
-Lemma equiv_spec P Q : (P ⊣⊢ Q) ↔ (P ⊢ Q) ∧ (Q ⊢ P).
+Global Instance cmra_valid_ne {A : cmraT} :
+ NonExpansive (@uPred_cmra_valid M A).
Proof.
- split; [|by intros [??]; apply (anti_symm (⊢))].
- intros HPQ; split; split=> x i; apply HPQ.
+ intros n a b Ha; unseal; split=> n' x ? /=.
+ by rewrite (dist_le _ _ _ _ Ha); last lia.
Qed.
-Lemma equiv_entails P Q : (P ⊣⊢ Q) → (P ⊢ Q).
-Proof. apply equiv_spec. Qed.
-Lemma equiv_entails_sym P Q : (Q ⊣⊢ P) → (P ⊢ Q).
-Proof. apply equiv_spec. Qed.
-Global Instance entails_proper :
- Proper ((⊣⊢) ==> (⊣⊢) ==> iff) ((⊢) : relation (uPred M)).
+Global Instance cmra_valid_proper {A : cmraT} :
+ Proper ((≡) ==> (⊣⊢)) (@uPred_cmra_valid M A) := ne_proper _.
+
+Global Instance bupd_ne : NonExpansive (@uPred_bupd M).
Proof.
- move => P1 P2 /equiv_spec [HP1 HP2] Q1 Q2 /equiv_spec [HQ1 HQ2]; split; intros.
- - by trans P1; [|trans Q1].
- - by trans P2; [|trans Q2].
+ intros n P Q HPQ.
+ unseal; split=> n' x; split; intros HP k yf ??;
+ destruct (HP k yf) as (x'&?&?); auto;
+ exists x'; split; auto; apply HPQ; eauto using cmra_validN_op_l.
Qed.
-Lemma entails_equiv_l (P Q R : uPred M) : (P ⊣⊢ Q) → (Q ⊢ R) → (P ⊢ R).
-Proof. by intros ->. Qed.
-Lemma entails_equiv_r (P Q R : uPred M) : (P ⊢ Q) → (Q ⊣⊢ R) → (P ⊢ R).
-Proof. by intros ? <-. Qed.
+Global Instance bupd_proper : Proper ((≡) ==> (≡)) (@uPred_bupd M) := ne_proper _.
+(** Limits *)
Lemma entails_lim (cP cQ : chain (uPredC M)) :
(∀ n, cP n ⊢ cQ n) → compl cP ⊢ compl cQ.
Proof.
@@ -206,8 +572,90 @@ Proof.
eapply uPred_holds_ne, Hlim, HP; eauto using conv_compl.
Qed.
-Lemma limit_preserving_entails `{Cofe A} (Φ Ψ : A → uPred M) :
- NonExpansive Φ → NonExpansive Ψ → LimitPreserving (λ x, Φ x ⊢ Ψ x).
-Proof. intros HΦ HΨ c Hc. rewrite -!compl_chain_map /=. by apply entails_lim. Qed.
-End entails.
+(* Own *)
+Lemma ownM_op (a1 a2 : M) :
+ uPred_ownM (a1 ⋅ a2) ⊣⊢ uPred_ownM a1 ∗ uPred_ownM a2.
+Proof.
+ rewrite /bi_sep /=; unseal. split=> n x ?; split.
+ - intros [z ?]; exists a1, (a2 â‹… z); split; [by rewrite (assoc op)|].
+ split. by exists (core a1); rewrite cmra_core_r. by exists z.
+ - intros (y1&y2&Hx&[z1 Hy1]&[z2 Hy2]); exists (z1 â‹… z2).
+ by rewrite (assoc op _ z1) -(comm op z1) (assoc op z1)
+ -(assoc op _ a2) (comm op z1) -Hy1 -Hy2.
+Qed.
+Lemma persistently_ownM_core (a : M) : uPred_ownM a ⊢ □ uPred_ownM (core a).
+Proof.
+ rewrite /bi_persistently /=. unseal.
+ split=> n x Hx /=. by apply cmra_core_monoN.
+Qed.
+Lemma ownM_empty : bi_valid (uPred_ownM (ε:M)).
+Proof. unseal; split=> n x ??; by exists x; rewrite left_id. Qed.
+Lemma later_ownM (a : M) : ▷ uPred_ownM a ⊢ ∃ b, uPred_ownM b ∧ ▷ (a ≡ b).
+Proof.
+ rewrite /bi_and /bi_later /bi_exist /bi_internal_eq /=; unseal.
+ split=> -[|n] x /= ? Hax; first by eauto using ucmra_unit_leastN.
+ destruct Hax as [y ?].
+ destruct (cmra_extend n x a y) as (a'&y'&Hx&?&?); auto using cmra_validN_S.
+ exists a'. rewrite Hx. eauto using cmra_includedN_l.
+Qed.
+
+(* Valid *)
+Lemma discrete_valid {A : cmraT} `{!CmraDiscrete A} (a : A) :
+ ✓ a ⊣⊢ (⌜✓ a⌠: uPred M).
+Proof. unseal. split=> n x _. by rewrite /= -cmra_discrete_valid_iff. Qed.
+Lemma ownM_valid (a : M) : uPred_ownM a ⊢ ✓ a.
+Proof.
+ unseal; split=> n x Hv [a' ?]; ofe_subst; eauto using cmra_validN_op_l.
+Qed.
+Lemma cmra_valid_intro {A : cmraT} (a : A) :
+ ✓ a → bi_valid (PROP:=uPredI M) (✓ a).
+Proof. unseal=> ?; split=> n x ? _ /=; by apply cmra_valid_validN. Qed.
+Lemma cmra_valid_elim {A : cmraT} (a : A) : ¬ ✓{0} a → ✓ a ⊢ (False : uPred M).
+Proof.
+ intros Ha. unseal. split=> n x ??; apply Ha, cmra_validN_le with n; auto.
+Qed.
+Lemma persistently_cmra_valid_1 {A : cmraT} (a : A) : ✓ a ⊢ □ (✓ a : uPred M).
+Proof. by unseal. Qed.
+Lemma cmra_valid_weaken {A : cmraT} (a b : A) : ✓ (a ⋅ b) ⊢ (✓ a : uPred M).
+Proof. unseal; split=> n x _; apply cmra_validN_op_l. Qed.
+
+Lemma prod_validI {A B : cmraT} (x : A * B) : ✓ x ⊣⊢ (✓ x.1 ∧ ✓ x.2 : uPred M).
+Proof. by unseal. Qed.
+Lemma option_validI {A : cmraT} (mx : option A) :
+ ✓ mx ⊣⊢ match mx with Some x => ✓ x | None => True : uPred M end.
+Proof. unseal. by destruct mx. Qed.
+
+(* Basic update modality *)
+Lemma bupd_intro P : P ==∗ P.
+Proof.
+ unseal. split=> n x ? HP k yf ?; exists x; split; first done.
+ apply uPred_closed with n; eauto using cmra_validN_op_l.
+Qed.
+Lemma bupd_mono P Q : (P ⊢ Q) → (|==> P) ==∗ Q.
+Proof.
+ unseal. intros HPQ; split=> n x ? HP k yf ??.
+ destruct (HP k yf) as (x'&?&?); eauto.
+ exists x'; split; eauto using uPred_in_entails, cmra_validN_op_l.
+Qed.
+Lemma bupd_trans P : (|==> |==> P) ==∗ P.
+Proof. unseal; split; naive_solver. Qed.
+Lemma bupd_frame_r P R : (|==> P) ∗ R ==∗ P ∗ R.
+Proof.
+ unseal. split; intros n x ? (x1&x2&Hx&HP&?) k yf ??.
+ destruct (HP k (x2 â‹… yf)) as (x'&?&?); eauto.
+ { by rewrite assoc -(dist_le _ _ _ _ Hx); last lia. }
+ exists (x' â‹… x2); split; first by rewrite -assoc.
+ exists x', x2; split_and?; auto.
+ apply uPred_closed with n; eauto 3 using cmra_validN_op_l, cmra_validN_op_r.
+Qed.
+Lemma bupd_ownM_updateP x (Φ : M → Prop) :
+ x ~~>: Φ → uPred_ownM x ==∗ ∃ y, ⌜Φ y⌠∧ uPred_ownM y.
+Proof.
+ intros Hup. unseal. split=> n x2 ? [x3 Hx] k yf ??.
+ destruct (Hup k (Some (x3 â‹… yf))) as (y&?&?); simpl in *.
+ { rewrite /= assoc -(dist_le _ _ _ _ Hx); auto. }
+ exists (y â‹… x3); split; first by rewrite -assoc.
+ exists y; eauto using cmra_includedN_l.
+Qed.
+End uPred.
End uPred.
diff --git a/theories/bi/bi.v b/theories/bi/bi.v
new file mode 100644
index 000000000..f4c5f8fc6
--- /dev/null
+++ b/theories/bi/bi.v
@@ -0,0 +1,19 @@
+From iris.bi Require Export interface derived big_op.
+Set Default Proof Using "Type".
+
+Module Import bi.
+ Export bi.interface.bi.
+ Export bi.derived.bi.
+ Export bi.big_op.bi.
+End bi.
+
+(* Hint DB for the logic *)
+Hint Resolve pure_intro.
+Hint Resolve or_elim or_intro_l' or_intro_r' : BI.
+Hint Resolve and_intro and_elim_l' and_elim_r' : BI.
+Hint Resolve persistently_mono : BI.
+Hint Resolve sep_elim_l sep_elim_r sep_mono : BI.
+Hint Immediate True_intro False_elim : BI.
+(*
+Hint Immediate iff_refl internal_eq_refl' : BI.
+*)
\ No newline at end of file
diff --git a/theories/base_logic/big_op.v b/theories/bi/big_op.v
similarity index 57%
rename from theories/base_logic/big_op.v
rename to theories/bi/big_op.v
index 6079c922a..65a40c78f 100644
--- a/theories/base_logic/big_op.v
+++ b/theories/bi/big_op.v
@@ -1,51 +1,52 @@
-From iris.algebra Require Export list big_op.
-From iris.base_logic Require Export base_logic.
-From stdpp Require Import gmap fin_collections gmultiset functions.
+From iris.algebra Require Export big_op.
+From iris.bi Require Export derived.
+From stdpp Require Import countable fin_collections functions.
Set Default Proof Using "Type".
-Import uPred.
(* Notations *)
-Notation "'[∗' 'list]' k ↦ x ∈ l , P" := (big_opL uPred_sep (λ k x, P) l)
+Notation "'[∗' 'list]' k ↦ x ∈ l , P" := (big_opL bi_sep (λ k x, P) l)
(at level 200, l at level 10, k, x at level 1, right associativity,
- format "[∗ list] k ↦ x ∈ l , P") : uPred_scope.
-Notation "'[∗' 'list]' x ∈ l , P" := (big_opL uPred_sep (λ _ x, P) l)
+ format "[∗ list] k ↦ x ∈ l , P") : bi_scope.
+Notation "'[∗' 'list]' x ∈ l , P" := (big_opL bi_sep (λ _ x, P) l)
(at level 200, l at level 10, x at level 1, right associativity,
- format "[∗ list] x ∈ l , P") : uPred_scope.
+ format "[∗ list] x ∈ l , P") : bi_scope.
Notation "'[∗]' Ps" :=
- (big_opL uPred_sep (λ _ x, x) Ps) (at level 20) : uPred_scope.
+ (big_opL bi_sep (λ _ x, x) Ps) (at level 20) : bi_scope.
-Notation "'[∗' 'map]' k ↦ x ∈ m , P" := (big_opM uPred_sep (λ k x, P) m)
+Notation "'[∗' 'map]' k ↦ x ∈ m , P" := (big_opM bi_sep (λ k x, P) m)
(at level 200, m at level 10, k, x at level 1, right associativity,
- format "[∗ map] k ↦ x ∈ m , P") : uPred_scope.
-Notation "'[∗' 'map]' x ∈ m , P" := (big_opM uPred_sep (λ _ x, P) m)
+ format "[∗ map] k ↦ x ∈ m , P") : bi_scope.
+Notation "'[∗' 'map]' x ∈ m , P" := (big_opM bi_sep (λ _ x, P) m)
(at level 200, m at level 10, x at level 1, right associativity,
- format "[∗ map] x ∈ m , P") : uPred_scope.
+ format "[∗ map] x ∈ m , P") : bi_scope.
-Notation "'[∗' 'set]' x ∈ X , P" := (big_opS uPred_sep (λ x, P) X)
+Notation "'[∗' 'set]' x ∈ X , P" := (big_opS bi_sep (λ x, P) X)
(at level 200, X at level 10, x at level 1, right associativity,
- format "[∗ set] x ∈ X , P") : uPred_scope.
+ format "[∗ set] x ∈ X , P") : bi_scope.
-Notation "'[∗' 'mset]' x ∈ X , P" := (big_opMS uPred_sep (λ x, P) X)
+Notation "'[∗' 'mset]' x ∈ X , P" := (big_opMS bi_sep (λ x, P) X)
(at level 200, X at level 10, x at level 1, right associativity,
- format "[∗ mset] x ∈ X , P") : uPred_scope.
+ format "[∗ mset] x ∈ X , P") : bi_scope.
(** * Properties *)
-Section big_op.
-Context {M : ucmraT}.
-Implicit Types Ps Qs : list (uPred M).
+Module bi.
+Import interface.bi derived.bi.
+Section bi_big_op.
+Context {PROP : bi}.
+Implicit Types Ps Qs : list PROP.
Implicit Types A : Type.
(** ** Big ops over lists *)
Section list.
Context {A : Type}.
Implicit Types l : list A.
- Implicit Types Φ Ψ : nat → A → uPred M.
+ Implicit Types Φ Ψ : nat → A → PROP.
- Lemma big_sepL_nil Φ : ([∗ list] k↦y ∈ nil, Φ k y) ⊣⊢ True.
+ Lemma big_sepL_nil Φ : ([∗ list] k↦y ∈ nil, Φ k y) ⊣⊢ emp.
Proof. done. Qed.
- Lemma big_sepL_nil' P Φ : P ⊢ [∗ list] k↦y ∈ nil, Φ k y.
- Proof. apply True_intro. Qed.
+ Lemma big_sepL_nil' `{AffineBI PROP} P Φ : P ⊢ [∗ list] k↦y ∈ nil, Φ k y.
+ Proof. apply (affine _). Qed.
Lemma big_sepL_cons Φ x l :
([∗ list] k↦y ∈ x :: l, Φ k y) ⊣⊢ Φ 0 x ∗ [∗ list] k↦y ∈ l, Φ (S k) y.
Proof. by rewrite big_opL_cons. Qed.
@@ -64,18 +65,23 @@ Section list.
(∀ k y, l !! k = Some y → Φ k y ⊣⊢ Ψ k y) →
([∗ list] k ↦ y ∈ l, Φ k y) ⊣⊢ ([∗ list] k ↦ y ∈ l, Ψ k y).
Proof. apply big_opL_proper. Qed.
- Lemma big_sepL_submseteq (Φ : A → uPred M) l1 l2 :
+ Lemma big_sepL_submseteq `{AffineBI PROP} (Φ : A → PROP) l1 l2 :
l1 ⊆+ l2 → ([∗ list] y ∈ l2, Φ y) ⊢ [∗ list] y ∈ l1, Φ y.
- Proof. intros [l ->]%submseteq_Permutation. by rewrite big_sepL_app sep_elim_l. Qed.
+ Proof.
+ intros [l ->]%submseteq_Permutation. by rewrite big_sepL_app sep_elim_l.
+ Qed.
Global Instance big_sepL_mono' :
Proper (pointwise_relation _ (pointwise_relation _ (⊢)) ==> (=) ==> (⊢))
- (big_opL (@uPred_sep M) (A:=A)).
+ (big_opL (@bi_sep PROP) (A:=A)).
Proof. intros f g Hf m ? <-. apply big_opL_forall; apply _ || intros; apply Hf. Qed.
Global Instance big_sep_mono' :
- Proper (Forall2 (⊢) ==> (⊢)) (big_opL (@uPred_sep M) (λ _ P, P)).
+ Proper (Forall2 (⊢) ==> (⊢)) (big_opL (@bi_sep M) (λ _ P, P)).
Proof. by induction 1 as [|P Q Ps Qs HPQ ? IH]; rewrite /= ?HPQ ?IH. Qed.
+ Lemma big_sepL_emp l : ([∗ list] k↦y ∈ l, emp) ⊣⊢ (emp : PROP).
+ Proof. by rewrite big_opL_unit. Qed.
+
Lemma big_sepL_lookup_acc Φ l i x :
l !! i = Some x →
([∗ list] k↦y ∈ l, Φ k y) ⊢ Φ i x ∗ (Φ i x -∗ ([∗ list] k↦y ∈ l, Φ k y)).
@@ -85,17 +91,17 @@ Section list.
rewrite assoc -!(comm _ (Φ _ _)) -assoc. by apply sep_mono_r, wand_intro_l.
Qed.
- Lemma big_sepL_lookup Φ l i x :
+ Lemma big_sepL_lookup Φ l i x `{!Absorbing (Φ i x)} :
l !! i = Some x → ([∗ list] k↦y ∈ l, Φ k y) ⊢ Φ i x.
- Proof. intros. by rewrite big_sepL_lookup_acc // sep_elim_l. Qed.
+ Proof. intros. rewrite big_sepL_lookup_acc // sep_elim_l. Qed.
- Lemma big_sepL_elem_of (Φ : A → uPred M) l x :
+ Lemma big_sepL_elem_of (Φ : A → PROP) l x `{!Absorbing (Φ x)} :
x ∈ l → ([∗ list] y ∈ l, Φ y) ⊢ Φ x.
Proof.
intros [i ?]%elem_of_list_lookup; eauto using (big_sepL_lookup (λ _, Φ)).
Qed.
- Lemma big_sepL_fmap {B} (f : A → B) (Φ : nat → B → uPred M) l :
+ Lemma big_sepL_fmap {B} (f : A → B) (Φ : nat → B → PROP) l :
([∗ list] k↦y ∈ f <$> l, Φ k y) ⊣⊢ ([∗ list] k↦y ∈ l, Φ k (f y)).
Proof. by rewrite big_opL_fmap. Qed.
@@ -107,88 +113,73 @@ Section list.
Lemma big_sepL_and Φ Ψ l :
([∗ list] k↦x ∈ l, Φ k x ∧ Ψ k x)
⊢ ([∗ list] k↦x ∈ l, Φ k x) ∧ ([∗ list] k↦x ∈ l, Ψ k x).
- Proof. auto using big_sepL_mono with I. Qed.
-
- Lemma big_sepL_later Φ l :
- ▷ ([∗ list] k↦x ∈ l, Φ k x) ⊣⊢ ([∗ list] k↦x ∈ l, ▷ Φ k x).
- Proof. apply (big_opL_commute _). Qed.
-
- Lemma big_sepL_laterN Φ n l :
- ▷^n ([∗ list] k↦x ∈ l, Φ k x) ⊣⊢ ([∗ list] k↦x ∈ l, ▷^n Φ k x).
- Proof. apply (big_opL_commute _). Qed.
+ Proof. auto using and_intro, big_sepL_mono, and_elim_l, and_elim_r. Qed.
- Lemma big_sepL_persistently Φ l :
+ Lemma big_sepL_persistently `{AffineBI PROP} Φ l :
(□ [∗ list] k↦x ∈ l, Φ k x) ⊣⊢ ([∗ list] k↦x ∈ l, □ Φ k x).
Proof. apply (big_opL_commute _). Qed.
- Lemma big_sepL_persistently_if p Φ l :
- □?p ([∗ list] k↦x ∈ l, Φ k x) ⊣⊢ ([∗ list] k↦x ∈ l, □?p Φ k x).
- Proof. apply (big_opL_commute _). Qed.
-
- Lemma big_sepL_forall Φ l :
+ Lemma big_sepL_forall `{AffineBI PROP} Φ l :
(∀ k x, Persistent (Φ k x)) →
([∗ list] k↦x ∈ l, Φ k x) ⊣⊢ (∀ k x, ⌜l !! k = Some x⌠→ Φ k x).
Proof.
intros HΦ. apply (anti_symm _).
{ apply forall_intro=> k; apply forall_intro=> x.
- apply impl_intro_l, pure_elim_l=> ?; by apply big_sepL_lookup. }
- revert Φ HΦ. induction l as [|x l IH]=> Φ HΦ.
- { rewrite big_sepL_nil; auto with I. }
- rewrite big_sepL_cons. rewrite -and_sep_l; apply and_intro.
+ apply impl_intro_l, pure_elim_l=> ?; by apply: big_sepL_lookup. }
+ revert Φ HΦ. induction l as [|x l IH]=> Φ HΦ; [by auto using big_sepL_nil'|].
+ rewrite big_sepL_cons. rewrite -persistent_and_sep_l; apply and_intro.
- by rewrite (forall_elim 0) (forall_elim x) pure_True // True_impl.
- rewrite -IH. apply forall_intro=> k; by rewrite (forall_elim (S k)).
Qed.
Lemma big_sepL_impl Φ Ψ l :
- □ (∀ k x, ⌜l !! k = Some x⌠→ Φ k x → Ψ k x) ∧ ([∗ list] k↦x ∈ l, Φ k x)
- ⊢ [∗ list] k↦x ∈ l, Ψ k x.
+ ([∗ list] k↦x ∈ l, Φ k x) -∗
+ ⬕ (∀ k x, ⌜l !! k = Some x⌠→ Φ k x -∗ Ψ k x) -∗
+ [∗ list] k↦x ∈ l, Ψ k x.
Proof.
- rewrite persistently_and_sep_l. do 2 setoid_rewrite persistently_forall.
- setoid_rewrite persistently_impl; setoid_rewrite persistently_pure.
- rewrite -big_sepL_forall -big_sepL_sepL. apply big_sepL_mono; auto=> k x ?.
- by rewrite persistently_impl_wand persistently_elim wand_elim_l.
+ apply wand_intro_l. revert Φ Ψ. induction l as [|x l IH]=> Φ Ψ /=.
+ { by rewrite sep_elim_r. }
+ rewrite bare_persistently_sep_dup -assoc [(⬕ _ ∗ _)%I]comm -!assoc assoc.
+ apply sep_mono.
+ - rewrite (forall_elim 0) (forall_elim x) pure_True // True_impl.
+ by rewrite bare_persistently_elim wand_elim_l.
+ - rewrite comm -(IH (Φ ∘ S) (Ψ ∘ S)) /=.
+ apply sep_mono_l, bare_mono, persistently_mono.
+ apply forall_intro=> k. by rewrite (forall_elim (S k)).
Qed.
- Global Instance big_sepL_nil_persistent Φ :
+ Global Instance big_sepL_nil_persistent `{AffineBI PROP} Φ :
Persistent ([∗ list] k↦x ∈ [], Φ k x).
Proof. simpl; apply _. Qed.
- Global Instance big_sepL_persistent Φ l :
+ Global Instance big_sepL_persistent1 Φ l :
+ (∀ k x, Persistent (Φ k x)) →
+ l ≠[] →
+ Persistent ([∗ list] k↦x ∈ l, Φ k x).
+ Proof.
+ intros. rewrite /Persistent (big_opL_commute1 bi_persistently (R:=(≡))) //.
+ apply big_opL_proper=> k y ?. by apply persistent_persistently.
+ Qed.
+ Global Instance big_sepL_persistent `{AffineBI PROP} Φ l :
(∀ k x, Persistent (Φ k x)) → Persistent ([∗ list] k↦x ∈ l, Φ k x).
Proof. revert Φ. induction l as [|x l IH]=> Φ ? /=; apply _. Qed.
- Global Instance big_sepL_persistent_id Ps :
+ Global Instance big_sepL_persistent_id `{AffineBI PROP} Ps :
TCForall Persistent Ps → Persistent ([∗] Ps).
Proof. induction 1; simpl; apply _. Qed.
-
- Global Instance big_sepL_nil_timeless Φ :
- Timeless ([∗ list] k↦x ∈ [], Φ k x).
- Proof. simpl; apply _. Qed.
- Global Instance big_sepL_timeless Φ l :
- (∀ k x, Timeless (Φ k x)) → Timeless ([∗ list] k↦x ∈ l, Φ k x).
- Proof. revert Φ. induction l as [|x l IH]=> Φ ? /=; apply _. Qed.
- Global Instance big_sepL_timeless_id Ps :
- TCForall Timeless Ps → Timeless ([∗] Ps).
- Proof. induction 1; simpl; apply _. Qed.
End list.
Section list2.
Context {A : Type}.
Implicit Types l : list A.
- Implicit Types Φ Ψ : nat → A → uPred M.
+ Implicit Types Φ Ψ : nat → A → PROP.
(* Some lemmas depend on the generalized versions of the above ones. *)
Lemma big_sepL_zip_with {B C} Φ f (l1 : list B) (l2 : list C) :
([∗ list] k↦x ∈ zip_with f l1 l2, Φ k x)
- ⊣⊢ ([∗ list] k↦x ∈ l1, ∀ y, ⌜l2 !! k = Some y⌠→ Φ k (f x y)).
+ ⊣⊢ ([∗ list] k↦x ∈ l1, if l2 !! k is Some y then Φ k (f x y) else emp).
Proof.
- revert Φ l2; induction l1 as [|x l1 IH]=> Φ [|y l2] //.
- - apply (anti_symm _), True_intro.
- trans ([∗ list] _↦_ ∈ x :: l1, True : uPred M)%I.
- + rewrite big_sepL_forall. auto using forall_intro, impl_intro_l, True_intro.
- + apply big_sepL_mono=> k y _. apply forall_intro=> z.
- by apply impl_intro_l, pure_elim_l.
- - rewrite /= IH. apply sep_proper=> //. apply (anti_symm _).
- + apply forall_intro=>z /=. by apply impl_intro_r, pure_elim_r=>-[->].
- + rewrite (forall_elim y) /=. by eapply impl_elim, pure_intro.
+ revert Φ l2; induction l1 as [|x l1 IH]=> Φ [|y l2] //=.
+ - by rewrite big_sepL_emp left_id.
+ - by rewrite IH.
Qed.
End list2.
@@ -196,30 +187,29 @@ End list2.
Section gmap.
Context `{Countable K} {A : Type}.
Implicit Types m : gmap K A.
- Implicit Types Φ Ψ : K → A → uPred M.
+ Implicit Types Φ Ψ : K → A → PROP.
- Lemma big_sepM_mono Φ Ψ m1 m2 :
- m2 ⊆ m1 → (∀ k x, m2 !! k = Some x → Φ k x ⊢ Ψ k x) →
- ([∗ map] k ↦ x ∈ m1, Φ k x) ⊢ [∗ map] k ↦ x ∈ m2, Ψ k x.
- Proof.
- intros Hm HΦ. trans ([∗ map] k↦x ∈ m2, Φ k x)%I.
- - rewrite /big_opM. by apply big_sepL_submseteq, map_to_list_submseteq.
- - apply big_opM_forall; apply _ || auto.
- Qed.
+ Lemma big_sepM_mono Φ Ψ m :
+ (∀ k x, m !! k = Some x → Φ k x ⊢ Ψ k x) →
+ ([∗ map] k ↦ x ∈ m, Φ k x) ⊢ [∗ map] k ↦ x ∈ m, Ψ k x.
+ Proof. apply big_opM_forall; apply _ || auto. Qed.
Lemma big_sepM_proper Φ Ψ m :
(∀ k x, m !! k = Some x → Φ k x ⊣⊢ Ψ k x) →
([∗ map] k ↦ x ∈ m, Φ k x) ⊣⊢ ([∗ map] k ↦ x ∈ m, Ψ k x).
Proof. apply big_opM_proper. Qed.
+ Lemma big_sepM_subseteq `{AffineBI PROP} Φ m1 m2 :
+ m2 ⊆ m1 → ([∗ map] k ↦ x ∈ m1, Φ k x) ⊢ [∗ map] k ↦ x ∈ m2, Φ k x.
+ Proof. intros. by apply big_sepL_submseteq, map_to_list_submseteq. Qed.
Global Instance big_sepM_mono' :
Proper (pointwise_relation _ (pointwise_relation _ (⊢)) ==> (=) ==> (⊢))
- (big_opM (@uPred_sep M) (K:=K) (A:=A)).
- Proof. intros f g Hf m ? <-. apply big_opM_forall; apply _ || intros; apply Hf. Qed.
+ (big_opM (@bi_sep PROP) (K:=K) (A:=A)).
+ Proof. intros f g Hf m ? <-. apply big_sepM_mono=> ???; apply Hf. Qed.
- Lemma big_sepM_empty Φ : ([∗ map] k↦x ∈ ∅, Φ k x) ⊣⊢ True.
+ Lemma big_sepM_empty Φ : ([∗ map] k↦x ∈ ∅, Φ k x) ⊣⊢ emp.
Proof. by rewrite big_opM_empty. Qed.
- Lemma big_sepM_empty' P Φ : P ⊢ [∗ map] k↦x ∈ ∅, Φ k x.
- Proof. rewrite big_sepM_empty. apply True_intro. Qed.
+ Lemma big_sepM_empty' `{AffineBI PROP} P Φ : P ⊢ [∗ map] k↦x ∈ ∅, Φ k x.
+ Proof. rewrite big_sepM_empty. apply: affine. Qed.
Lemma big_sepM_insert Φ m i x :
m !! i = None →
@@ -238,18 +228,18 @@ Section gmap.
intros. rewrite big_sepM_delete //. by apply sep_mono_r, wand_intro_l.
Qed.
- Lemma big_sepM_lookup Φ m i x :
+ Lemma big_sepM_lookup Φ m i x `{!Absorbing (Φ i x)} :
m !! i = Some x → ([∗ map] k↦y ∈ m, Φ k y) ⊢ Φ i x.
Proof. intros. by rewrite big_sepM_lookup_acc // sep_elim_l. Qed.
- Lemma big_sepM_lookup_dom (Φ : K → uPred M) m i :
+ Lemma big_sepM_lookup_dom (Φ : K → PROP) m i `{!Absorbing (Φ i)} :
is_Some (m !! i) → ([∗ map] k↦_ ∈ m, Φ k) ⊢ Φ i.
Proof. intros [x ?]. by eapply (big_sepM_lookup (λ i x, Φ i)). Qed.
Lemma big_sepM_singleton Φ i x : ([∗ map] k↦y ∈ {[i:=x]}, Φ k y) ⊣⊢ Φ i x.
Proof. by rewrite big_opM_singleton. Qed.
- Lemma big_sepM_fmap {B} (f : A → B) (Φ : K → B → uPred M) m :
+ Lemma big_sepM_fmap {B} (f : A → B) (Φ : K → B → PROP) m :
([∗ map] k↦y ∈ f <$> m, Φ k y) ⊣⊢ ([∗ map] k↦y ∈ m, Φ k (f y)).
Proof. by rewrite big_opM_fmap. Qed.
@@ -278,13 +268,13 @@ Section gmap.
rewrite -insert_delete big_sepM_insert ?lookup_delete //.
Qed.
- Lemma big_sepM_fn_insert {B} (Ψ : K → A → B → uPred M) (f : K → B) m i x b :
+ Lemma big_sepM_fn_insert {B} (Ψ : K → A → B → PROP) (f : K → B) m i x b :
m !! i = None →
([∗ map] k↦y ∈ <[i:=x]> m, Ψ k y (<[i:=b]> f k))
⊣⊢ (Ψ i x b ∗ [∗ map] k↦y ∈ m, Ψ k y (f k)).
Proof. apply big_opM_fn_insert. Qed.
- Lemma big_sepM_fn_insert' (Φ : K → uPred M) m i x P :
+ Lemma big_sepM_fn_insert' (Φ : K → PROP) m i x P :
m !! i = None →
([∗ map] k↦y ∈ <[i:=x]> m, <[i:=P]> Φ k) ⊣⊢ (P ∗ [∗ map] k↦y ∈ m, Φ k).
Proof. apply big_opM_fn_insert'. Qed.
@@ -297,33 +287,21 @@ Section gmap.
Lemma big_sepM_and Φ Ψ m :
([∗ map] k↦x ∈ m, Φ k x ∧ Ψ k x)
⊢ ([∗ map] k↦x ∈ m, Φ k x) ∧ ([∗ map] k↦x ∈ m, Ψ k x).
- Proof. auto using big_sepM_mono with I. Qed.
-
- Lemma big_sepM_later Φ m :
- ▷ ([∗ map] k↦x ∈ m, Φ k x) ⊣⊢ ([∗ map] k↦x ∈ m, ▷ Φ k x).
- Proof. apply (big_opM_commute _). Qed.
+ Proof. auto using and_intro, big_sepM_mono, and_elim_l, and_elim_r. Qed.
- Lemma big_sepM_laterN Φ n m :
- ▷^n ([∗ map] k↦x ∈ m, Φ k x) ⊣⊢ ([∗ map] k↦x ∈ m, ▷^n Φ k x).
- Proof. apply (big_opM_commute _). Qed.
-
- Lemma big_sepM_persistently Φ m :
+ Lemma big_sepM_persistently `{AffineBI PROP} Φ m :
(□ [∗ map] k↦x ∈ m, Φ k x) ⊣⊢ ([∗ map] k↦x ∈ m, □ Φ k x).
Proof. apply (big_opM_commute _). Qed.
- Lemma big_sepM_persistently_if p Φ m :
- □?p ([∗ map] k↦x ∈ m, Φ k x) ⊣⊢ ([∗ map] k↦x ∈ m, □?p Φ k x).
- Proof. apply (big_opM_commute _). Qed.
-
- Lemma big_sepM_forall Φ m :
+ Lemma big_sepM_forall `{AffineBI PROP} Φ m :
(∀ k x, Persistent (Φ k x)) →
([∗ map] k↦x ∈ m, Φ k x) ⊣⊢ (∀ k x, ⌜m !! k = Some x⌠→ Φ k x).
Proof.
intros. apply (anti_symm _).
{ apply forall_intro=> k; apply forall_intro=> x.
- apply impl_intro_l, pure_elim_l=> ?; by apply big_sepM_lookup. }
- induction m as [|i x m ? IH] using map_ind; [rewrite ?big_sepM_empty; auto|].
- rewrite big_sepM_insert // -and_sep_l. apply and_intro.
+ apply impl_intro_l, pure_elim_l=> ?; by apply: big_sepM_lookup. }
+ induction m as [|i x m ? IH] using map_ind; auto using big_sepM_empty'.
+ rewrite big_sepM_insert // -persistent_and_sep_l. apply and_intro.
- rewrite (forall_elim i) (forall_elim x) lookup_insert.
by rewrite pure_True // True_impl.
- rewrite -IH. apply forall_mono=> k; apply forall_mono=> y.
@@ -333,27 +311,29 @@ Section gmap.
Qed.
Lemma big_sepM_impl Φ Ψ m :
- □ (∀ k x, ⌜m !! k = Some x⌠→ Φ k x → Ψ k x) ∧ ([∗ map] k↦x ∈ m, Φ k x)
- ⊢ [∗ map] k↦x ∈ m, Ψ k x.
+ ([∗ map] k↦x ∈ m, Φ k x) -∗
+ ⬕ (∀ k x, ⌜m !! k = Some x⌠→ Φ k x -∗ Ψ k x) -∗
+ [∗ map] k↦x ∈ m, Ψ k x.
Proof.
- rewrite persistently_and_sep_l. do 2 setoid_rewrite persistently_forall.
- setoid_rewrite persistently_impl; setoid_rewrite persistently_pure.
- rewrite -big_sepM_forall -big_sepM_sepM. apply big_sepM_mono; auto=> k x ?.
- by rewrite persistently_impl_wand persistently_elim wand_elim_l.
+ apply wand_intro_l. induction m as [|i x m ? IH] using map_ind.
+ { by rewrite sep_elim_r. }
+ rewrite !big_sepM_insert // bare_persistently_sep_dup.
+ rewrite -assoc [(⬕ _ ∗ _)%I]comm -!assoc assoc. apply sep_mono.
+ - rewrite (forall_elim i) (forall_elim x) pure_True ?lookup_insert //.
+ by rewrite True_impl bare_persistently_elim wand_elim_l.
+ - rewrite comm -IH /=.
+ apply sep_mono_l, bare_mono, persistently_mono, forall_mono=> k.
+ apply forall_mono=> y. apply impl_intro_l, pure_elim_l=> ?.
+ rewrite lookup_insert_ne; last by intros ?; simplify_map_eq.
+ by rewrite pure_True // True_impl.
Qed.
- Global Instance big_sepM_empty_persistent Φ :
+ Global Instance big_sepM_empty_persistent `{AffineBI PROP} Φ :
Persistent ([∗ map] k↦x ∈ ∅, Φ k x).
Proof. rewrite /big_opM map_to_list_empty. apply _. Qed.
- Global Instance big_sepM_persistent Φ m :
+ Global Instance big_sepM_persistent `{AffineBI PROP} Φ m :
(∀ k x, Persistent (Φ k x)) → Persistent ([∗ map] k↦x ∈ m, Φ k x).
Proof. intros. apply big_sepL_persistent=> _ [??]; apply _. Qed.
- Global Instance big_sepM_nil_timeless Φ :
- Timeless ([∗ map] k↦x ∈ ∅, Φ k x).
- Proof. rewrite /big_opM map_to_list_empty. apply _. Qed.
- Global Instance big_sepM_timeless Φ m :
- (∀ k x, Timeless (Φ k x)) → Timeless ([∗ map] k↦x ∈ m, Φ k x).
- Proof. intros. apply big_sepL_timeless=> _ [??]; apply _. Qed.
End gmap.
@@ -361,35 +341,34 @@ End gmap.
Section gset.
Context `{Countable A}.
Implicit Types X : gset A.
- Implicit Types Φ : A → uPred M.
+ Implicit Types Φ : A → PROP.
- Lemma big_sepS_mono Φ Ψ X Y :
- Y ⊆ X → (∀ x, x ∈ Y → Φ x ⊢ Ψ x) →
- ([∗ set] x ∈ X, Φ x) ⊢ [∗ set] x ∈ Y, Ψ x.
- Proof.
- intros HX HΦ. trans ([∗ set] x ∈ Y, Φ x)%I.
- - rewrite /big_opM. by apply big_sepL_submseteq, elements_submseteq.
- - apply big_opS_forall; apply _ || auto.
- Qed.
+ Lemma big_sepS_mono Φ Ψ X :
+ (∀ x, x ∈ X → Φ x ⊢ Ψ x) →
+ ([∗ set] x ∈ X, Φ x) ⊢ [∗ set] x ∈ X, Ψ x.
+ Proof. intros. apply big_opS_forall; apply _ || auto. Qed.
Lemma big_sepS_proper Φ Ψ X :
(∀ x, x ∈ X → Φ x ⊣⊢ Ψ x) →
([∗ set] x ∈ X, Φ x) ⊣⊢ ([∗ set] x ∈ X, Ψ x).
Proof. apply big_opS_proper. Qed.
+ Lemma big_sepS_subseteq `{AffineBI PROP} Φ X Y :
+ Y ⊆ X → ([∗ set] x ∈ X, Φ x) ⊢ [∗ set] x ∈ Y, Φ x.
+ Proof. intros. by apply big_sepL_submseteq, elements_submseteq. Qed.
Global Instance big_sepS_mono' :
- Proper (pointwise_relation _ (⊢) ==> (=) ==> (⊢)) (big_opS (@uPred_sep M) (A:=A)).
- Proof. intros f g Hf m ? <-. apply big_opS_forall; apply _ || intros; apply Hf. Qed.
+ Proper (pointwise_relation _ (⊢) ==> (=) ==> (⊢)) (big_opS (@bi_sep PROP) (A:=A)).
+ Proof. intros f g Hf m ? <-. by apply big_sepS_mono. Qed.
- Lemma big_sepS_empty Φ : ([∗ set] x ∈ ∅, Φ x) ⊣⊢ True.
+ Lemma big_sepS_empty Φ : ([∗ set] x ∈ ∅, Φ x) ⊣⊢ emp.
Proof. by rewrite big_opS_empty. Qed.
- Lemma big_sepS_empty' P Φ : P ⊢ [∗ set] x ∈ ∅, Φ x.
- Proof. rewrite big_sepS_empty. apply True_intro. Qed.
+ Lemma big_sepS_empty' `{!AffineBI PROP} P Φ : P ⊢ [∗ set] x ∈ ∅, Φ x.
+ Proof. rewrite big_sepS_empty. apply: affine. Qed.
Lemma big_sepS_insert Φ X x :
x ∉ X → ([∗ set] y ∈ {[ x ]} ∪ X, Φ y) ⊣⊢ (Φ x ∗ [∗ set] y ∈ X, Φ y).
Proof. apply big_opS_insert. Qed.
- Lemma big_sepS_fn_insert {B} (Ψ : A → B → uPred M) f X x b :
+ Lemma big_sepS_fn_insert {B} (Ψ : A → B → PROP) f X x b :
x ∉ X →
([∗ set] y ∈ {[ x ]} ∪ X, Ψ y (<[x:=b]> f y))
⊣⊢ (Ψ x b ∗ [∗ set] y ∈ X, Ψ y (f y)).
@@ -408,8 +387,9 @@ Section gset.
x ∈ X → ([∗ set] y ∈ X, Φ y) ⊣⊢ Φ x ∗ [∗ set] y ∈ X ∖ {[ x ]}, Φ y.
Proof. apply big_opS_delete. Qed.
- Lemma big_sepS_elem_of Φ X x : x ∈ X → ([∗ set] y ∈ X, Φ y) ⊢ Φ x.
- Proof. intros. rewrite big_sepS_delete //. auto with I. Qed.
+ Lemma big_sepS_elem_of Φ X x `{!Absorbing (Φ x)} :
+ x ∈ X → ([∗ set] y ∈ X, Φ y) ⊢ Φ x.
+ Proof. intros. rewrite big_sepS_delete; auto. Qed.
Lemma big_sepS_elem_of_acc Φ X x :
x ∈ X →
@@ -421,88 +401,95 @@ Section gset.
Lemma big_sepS_singleton Φ x : ([∗ set] y ∈ {[ x ]}, Φ y) ⊣⊢ Φ x.
Proof. apply big_opS_singleton. Qed.
- Lemma big_sepS_filter (P : A → Prop) `{∀ x, Decision (P x)} Φ X :
- ([∗ set] y ∈ filter P X, Φ y) ⊣⊢ ([∗ set] y ∈ X, ⌜P y⌠→ Φ y).
+ Lemma big_sepS_filter' (P : A → Prop) `{∀ x, Decision (P x)} Φ X :
+ ([∗ set] y ∈ filter P X, Φ y)
+ ⊣⊢ ([∗ set] y ∈ X, if decide (P y) then Φ y else emp).
Proof.
induction X as [|x X ? IH] using collection_ind_L.
{ by rewrite filter_empty_L !big_sepS_empty. }
destruct (decide (P x)).
- rewrite filter_union_L filter_singleton_L //.
rewrite !big_sepS_insert //; last set_solver.
- by rewrite IH pure_True // left_id.
+ by rewrite decide_True // IH.
- rewrite filter_union_L filter_singleton_not_L // left_id_L.
- by rewrite !big_sepS_insert // IH pure_False // False_impl left_id.
+ by rewrite !big_sepS_insert // decide_False // IH left_id.
Qed.
- Lemma big_sepS_filter_acc (P : A → Prop) `{∀ y, Decision (P y)} Φ X Y :
+ Lemma big_sepS_filter_acc' (P : A → Prop) `{∀ y, Decision (P y)} Φ X Y :
(∀ y, y ∈ Y → P y → y ∈ X) →
([∗ set] y ∈ X, Φ y) -∗
- ([∗ set] y ∈ Y, ⌜P y⌠→ Φ y) ∗
- (([∗ set] y ∈ Y, ⌜P y⌠→ Φ y) -∗ [∗ set] y ∈ X, Φ y).
+ ([∗ set] y ∈ Y, if decide (P y) then Φ y else emp) ∗
+ (([∗ set] y ∈ Y, if decide (P y) then Φ y else emp) -∗ [∗ set] y ∈ X, Φ y).
Proof.
intros ?. destruct (proj1 (subseteq_disjoint_union_L (filter P Y) X))
as (Z&->&?); first set_solver.
- rewrite big_sepS_union // big_sepS_filter. by apply sep_mono_r, wand_intro_l.
+ rewrite big_sepS_union // big_sepS_filter'.
+ by apply sep_mono_r, wand_intro_l.
Qed.
+ Lemma big_sepS_filter `{AffineBI PROP}
+ (P : A → Prop) `{∀ x, Decision (P x)} Φ X :
+ ([∗ set] y ∈ filter P X, Φ y) ⊣⊢ ([∗ set] y ∈ X, ⌜P y⌠→ Φ y).
+ Proof. setoid_rewrite <-decide_emp. apply big_sepS_filter'. Qed.
+
+ Lemma big_sepS_filter_acc `{AffineBI PROP}
+ (P : A → Prop) `{∀ y, Decision (P y)} Φ X Y :
+ (∀ y, y ∈ Y → P y → y ∈ X) →
+ ([∗ set] y ∈ X, Φ y) -∗
+ ([∗ set] y ∈ Y, ⌜P y⌠→ Φ y) ∗
+ (([∗ set] y ∈ Y, ⌜P y⌠→ Φ y) -∗ [∗ set] y ∈ X, Φ y).
+ Proof. intros. setoid_rewrite <-decide_emp. by apply big_sepS_filter_acc'. Qed.
+
Lemma big_sepS_sepS Φ Ψ X :
([∗ set] y ∈ X, Φ y ∗ Ψ y) ⊣⊢ ([∗ set] y ∈ X, Φ y) ∗ ([∗ set] y ∈ X, Ψ y).
Proof. apply big_opS_opS. Qed.
Lemma big_sepS_and Φ Ψ X :
([∗ set] y ∈ X, Φ y ∧ Ψ y) ⊢ ([∗ set] y ∈ X, Φ y) ∧ ([∗ set] y ∈ X, Ψ y).
- Proof. auto using big_sepS_mono with I. Qed.
-
- Lemma big_sepS_later Φ X : ▷ ([∗ set] y ∈ X, Φ y) ⊣⊢ ([∗ set] y ∈ X, ▷ Φ y).
- Proof. apply (big_opS_commute _). Qed.
+ Proof. auto using and_intro, big_sepS_mono, and_elim_l, and_elim_r. Qed.
- Lemma big_sepS_laterN Φ n X :
- ▷^n ([∗ set] y ∈ X, Φ y) ⊣⊢ ([∗ set] y ∈ X, ▷^n Φ y).
+ Lemma big_sepS_persistently `{AffineBI PROP} Φ X :
+ □ ([∗ set] y ∈ X, Φ y) ⊣⊢ ([∗ set] y ∈ X, □ Φ y).
Proof. apply (big_opS_commute _). Qed.
- Lemma big_sepS_persistently Φ X : □ ([∗ set] y ∈ X, Φ y) ⊣⊢ ([∗ set] y ∈ X, □ Φ y).
- Proof. apply (big_opS_commute _). Qed.
-
- Lemma big_sepS_persistently_if q Φ X :
- □?q ([∗ set] y ∈ X, Φ y) ⊣⊢ ([∗ set] y ∈ X, □?q Φ y).
- Proof. apply (big_opS_commute _). Qed.
-
- Lemma big_sepS_forall Φ X :
+ Lemma big_sepS_forall `{AffineBI PROP} Φ X :
(∀ x, Persistent (Φ x)) → ([∗ set] x ∈ X, Φ x) ⊣⊢ (∀ x, ⌜x ∈ X⌠→ Φ x).
Proof.
intros. apply (anti_symm _).
{ apply forall_intro=> x.
- apply impl_intro_l, pure_elim_l=> ?; by apply big_sepS_elem_of. }
- induction X as [|x X ? IH] using collection_ind_L.
- { rewrite big_sepS_empty; auto. }
- rewrite big_sepS_insert // -and_sep_l. apply and_intro.
+ apply impl_intro_l, pure_elim_l=> ?; by apply: big_sepS_elem_of. }
+ induction X as [|x X ? IH] using collection_ind_L; auto using big_sepS_empty'.
+ rewrite big_sepS_insert // -persistent_and_sep_l. apply and_intro.
- by rewrite (forall_elim x) pure_True ?True_impl; last set_solver.
- rewrite -IH. apply forall_mono=> y. apply impl_intro_l, pure_elim_l=> ?.
by rewrite pure_True ?True_impl; last set_solver.
Qed.
Lemma big_sepS_impl Φ Ψ X :
- □ (∀ x, ⌜x ∈ X⌠→ Φ x → Ψ x) ∧ ([∗ set] x ∈ X, Φ x) ⊢ [∗ set] x ∈ X, Ψ x.
+ ([∗ set] x ∈ X, Φ x) -∗
+ ⬕ (∀ x, ⌜x ∈ X⌠→ Φ x -∗ Ψ x) -∗
+ [∗ set] x ∈ X, Ψ x.
Proof.
- rewrite persistently_and_sep_l persistently_forall.
- setoid_rewrite persistently_impl; setoid_rewrite persistently_pure.
- rewrite -big_sepS_forall -big_sepS_sepS. apply big_sepS_mono; auto=> x ?.
- by rewrite persistently_impl_wand persistently_elim wand_elim_l.
+ apply wand_intro_l. induction X as [|x X ? IH] using collection_ind_L.
+ { by rewrite sep_elim_r. }
+ rewrite !big_sepS_insert // bare_persistently_sep_dup.
+ rewrite -assoc [(⬕ _ ∗ _)%I]comm -!assoc assoc. apply sep_mono.
+ - rewrite (forall_elim x) pure_True; last set_solver.
+ by rewrite True_impl bare_persistently_elim wand_elim_l.
+ - rewrite comm -IH /=. apply sep_mono_l, bare_mono, persistently_mono.
+ apply forall_mono=> y. apply impl_intro_l, pure_elim_l=> ?.
+ by rewrite pure_True ?True_impl; last set_solver.
Qed.
- Global Instance big_sepS_empty_persistent Φ : Persistent ([∗ set] x ∈ ∅, Φ x).
+ Global Instance big_sepS_empty_persistent `{AffineBI PROP} Φ :
+ Persistent ([∗ set] x ∈ ∅, Φ x).
Proof. rewrite /big_opS elements_empty. apply _. Qed.
- Global Instance big_sepS_persistent Φ X :
+ Global Instance big_sepS_persistent `{AffineBI PROP} Φ X :
(∀ x, Persistent (Φ x)) → Persistent ([∗ set] x ∈ X, Φ x).
Proof. rewrite /big_opS. apply _. Qed.
- Global Instance big_sepS_nil_timeless Φ : Timeless ([∗ set] x ∈ ∅, Φ x).
- Proof. rewrite /big_opS elements_empty. apply _. Qed.
- Global Instance big_sepS_timeless Φ X :
- (∀ x, Timeless (Φ x)) → Timeless ([∗ set] x ∈ X, Φ x).
- Proof. rewrite /big_opS. apply _. Qed.
End gset.
-Lemma big_sepM_dom `{Countable K} {A} (Φ : K → uPred M) (m : gmap K A) :
+Lemma big_sepM_dom `{Countable K} {A} (Φ : K → PROP) (m : gmap K A) :
([∗ map] k↦_ ∈ m, Φ k) ⊣⊢ ([∗ set] k ∈ dom _ m, Φ k).
Proof. apply big_opM_dom. Qed.
@@ -511,29 +498,28 @@ Proof. apply big_opM_dom. Qed.
Section gmultiset.
Context `{Countable A}.
Implicit Types X : gmultiset A.
- Implicit Types Φ : A → uPred M.
+ Implicit Types Φ : A → PROP.
- Lemma big_sepMS_mono Φ Ψ X Y :
- Y ⊆ X → (∀ x, x ∈ Y → Φ x ⊢ Ψ x) →
- ([∗ mset] x ∈ X, Φ x) ⊢ [∗ mset] x ∈ Y, Ψ x.
- Proof.
- intros HX HΦ. trans ([∗ mset] x ∈ Y, Φ x)%I.
- - rewrite /big_opM. by apply big_sepL_submseteq, gmultiset_elements_submseteq.
- - apply big_opMS_forall; apply _ || auto.
- Qed.
+ Lemma big_sepMS_mono Φ Ψ X :
+ (∀ x, x ∈ X → Φ x ⊢ Ψ x) →
+ ([∗ mset] x ∈ X, Φ x) ⊢ [∗ mset] x ∈ X, Ψ x.
+ Proof. intros. apply big_opMS_forall; apply _ || auto. Qed.
Lemma big_sepMS_proper Φ Ψ X :
(∀ x, x ∈ X → Φ x ⊣⊢ Ψ x) →
([∗ mset] x ∈ X, Φ x) ⊣⊢ ([∗ mset] x ∈ X, Ψ x).
Proof. apply big_opMS_proper. Qed.
+ Lemma big_sepMS_subseteq `{AffineBI PROP} Φ X Y :
+ Y ⊆ X → ([∗ mset] x ∈ X, Φ x) ⊢ [∗ mset] x ∈ Y, Φ x.
+ Proof. intros. by apply big_sepL_submseteq, gmultiset_elements_submseteq. Qed.
Global Instance big_sepMS_mono' :
- Proper (pointwise_relation _ (⊢) ==> (=) ==> (⊢)) (big_opMS (@uPred_sep M) (A:=A)).
- Proof. intros f g Hf m ? <-. apply big_opMS_forall; apply _ || intros; apply Hf. Qed.
+ Proper (pointwise_relation _ (⊢) ==> (=) ==> (⊢)) (big_opMS (@bi_sep PROP) (A:=A)).
+ Proof. intros f g Hf m ? <-. by apply big_sepMS_mono. Qed.
- Lemma big_sepMS_empty Φ : ([∗ mset] x ∈ ∅, Φ x) ⊣⊢ True.
+ Lemma big_sepMS_empty Φ : ([∗ mset] x ∈ ∅, Φ x) ⊣⊢ emp.
Proof. by rewrite big_opMS_empty. Qed.
- Lemma big_sepMS_empty' P Φ : P ⊢ [∗ mset] x ∈ ∅, Φ x.
- Proof. rewrite big_sepMS_empty. apply True_intro. Qed.
+ Lemma big_sepMS_empty' `{!AffineBI PROP} P Φ : P ⊢ [∗ mset] x ∈ ∅, Φ x.
+ Proof. rewrite big_sepMS_empty. apply: affine. Qed.
Lemma big_sepMS_union Φ X Y :
([∗ mset] y ∈ X ∪ Y, Φ y) ⊣⊢ ([∗ mset] y ∈ X, Φ y) ∗ [∗ mset] y ∈ Y, Φ y.
@@ -543,7 +529,8 @@ Section gmultiset.
x ∈ X → ([∗ mset] y ∈ X, Φ y) ⊣⊢ Φ x ∗ [∗ mset] y ∈ X ∖ {[ x ]}, Φ y.
Proof. apply big_opMS_delete. Qed.
- Lemma big_sepMS_elem_of Φ X x : x ∈ X → ([∗ mset] y ∈ X, Φ y) ⊢ Φ x.
+ Lemma big_sepMS_elem_of Φ X x `{!Absorbing (Φ x)} :
+ x ∈ X → ([∗ mset] y ∈ X, Φ y) ⊢ Φ x.
Proof. intros. by rewrite big_sepMS_delete // sep_elim_l. Qed.
Lemma big_sepMS_elem_of_acc Φ X x :
@@ -562,33 +549,117 @@ Section gmultiset.
Lemma big_sepMS_and Φ Ψ X :
([∗ mset] y ∈ X, Φ y ∧ Ψ y) ⊢ ([∗ mset] y ∈ X, Φ y) ∧ ([∗ mset] y ∈ X, Ψ y).
- Proof. auto using big_sepMS_mono with I. Qed.
+ Proof. auto using and_intro, big_sepMS_mono, and_elim_l, and_elim_r. Qed.
- Lemma big_sepMS_later Φ X : ▷ ([∗ mset] y ∈ X, Φ y) ⊣⊢ ([∗ mset] y ∈ X, ▷ Φ y).
+ Lemma big_sepMS_persistently `{AffineBI PROP} Φ X :
+ □ ([∗ mset] y ∈ X, Φ y) ⊣⊢ ([∗ mset] y ∈ X, □ Φ y).
Proof. apply (big_opMS_commute _). Qed.
- Lemma big_sepMS_laterN Φ n X :
- ▷^n ([∗ mset] y ∈ X, Φ y) ⊣⊢ ([∗ mset] y ∈ X, ▷^n Φ y).
- Proof. apply (big_opMS_commute _). Qed.
+ Global Instance big_sepMS_empty_persistent `{AffineBI PROP} Φ :
+ Persistent ([∗ mset] x ∈ ∅, Φ x).
+ Proof. rewrite /big_opMS gmultiset_elements_empty. apply _. Qed.
+ Global Instance big_sepMS_persistent `{AffineBI PROP} Φ X :
+ (∀ x, Persistent (Φ x)) → Persistent ([∗ mset] x ∈ X, Φ x).
+ Proof. rewrite /big_opMS. apply _. Qed.
+End gmultiset.
+End bi_big_op.
+
+(** * Properties for step-indexed BIs*)
+Section sbi_big_op.
+Context {PROP : sbi}.
+Implicit Types Ps Qs : list PROP.
+Implicit Types A : Type.
+
+(** ** Big ops over lists *)
+Section list.
+ Context {A : Type}.
+ Implicit Types l : list A.
+ Implicit Types Φ Ψ : nat → A → PROP.
+
+ Lemma big_sepL_later `{AffineBI PROP} Φ l :
+ ▷ ([∗ list] k↦x ∈ l, Φ k x) ⊣⊢ ([∗ list] k↦x ∈ l, ▷ Φ k x).
+ Proof. apply (big_opL_commute _). Qed.
+
+ Lemma big_sepL_laterN `{AffineBI PROP} Φ n l :
+ ▷^n ([∗ list] k↦x ∈ l, Φ k x) ⊣⊢ ([∗ list] k↦x ∈ l, ▷^n Φ k x).
+ Proof. apply (big_opL_commute _). Qed.
+
+ Global Instance big_sepL_nil_timeless Φ :
+ Timeless ([∗ list] k↦x ∈ [], Φ k x).
+ Proof. simpl; apply _. Qed.
+ Global Instance big_sepL_timeless Φ l :
+ (∀ k x, Timeless (Φ k x)) → Timeless ([∗ list] k↦x ∈ l, Φ k x).
+ Proof. revert Φ. induction l as [|x l IH]=> Φ ? /=; apply _. Qed.
+ Global Instance big_sepL_timeless_id `{!Timeless (emp%I : PROP)} Ps :
+ TCForall Timeless Ps → Timeless ([∗] Ps).
+ Proof. induction 1; simpl; apply _. Qed.
+End list.
+
+(** ** Big ops over finite maps *)
+Section gmap.
+ Context `{Countable K} {A : Type}.
+ Implicit Types m : gmap K A.
+ Implicit Types Φ Ψ : K → A → PROP.
- Lemma big_sepMS_persistently Φ X : □ ([∗ mset] y ∈ X, Φ y) ⊣⊢ ([∗ mset] y ∈ X, □ Φ y).
+ Lemma big_sepM_later `{AffineBI PROP} Φ m :
+ ▷ ([∗ map] k↦x ∈ m, Φ k x) ⊣⊢ ([∗ map] k↦x ∈ m, ▷ Φ k x).
+ Proof. apply (big_opM_commute _). Qed.
+
+ Lemma big_sepM_laterN `{AffineBI PROP} Φ n m :
+ ▷^n ([∗ map] k↦x ∈ m, Φ k x) ⊣⊢ ([∗ map] k↦x ∈ m, ▷^n Φ k x).
+ Proof. apply (big_opM_commute _). Qed.
+
+ Global Instance big_sepM_nil_timeless Φ :
+ Timeless ([∗ map] k↦x ∈ ∅, Φ k x).
+ Proof. rewrite /big_opM map_to_list_empty. apply _. Qed.
+ Global Instance big_sepM_timeless Φ m :
+ (∀ k x, Timeless (Φ k x)) → Timeless ([∗ map] k↦x ∈ m, Φ k x).
+ Proof. intros. apply big_sepL_timeless=> _ [??]; apply _. Qed.
+End gmap.
+
+(** ** Big ops over finite sets *)
+Section gset.
+ Context `{Countable A}.
+ Implicit Types X : gset A.
+ Implicit Types Φ : A → PROP.
+
+ Lemma big_sepS_later `{AffineBI PROP} Φ X :
+ ▷ ([∗ set] y ∈ X, Φ y) ⊣⊢ ([∗ set] y ∈ X, ▷ Φ y).
+ Proof. apply (big_opS_commute _). Qed.
+
+ Lemma big_sepS_laterN `{AffineBI PROP} Φ n X :
+ ▷^n ([∗ set] y ∈ X, Φ y) ⊣⊢ ([∗ set] y ∈ X, ▷^n Φ y).
+ Proof. apply (big_opS_commute _). Qed.
+
+ Global Instance big_sepS_nil_timeless Φ : Timeless ([∗ set] x ∈ ∅, Φ x).
+ Proof. rewrite /big_opS elements_empty. apply _. Qed.
+ Global Instance big_sepS_timeless Φ X :
+ (∀ x, Timeless (Φ x)) → Timeless ([∗ set] x ∈ X, Φ x).
+ Proof. rewrite /big_opS. apply _. Qed.
+End gset.
+
+(** ** Big ops over finite multisets *)
+Section gmultiset.
+ Context `{Countable A}.
+ Implicit Types X : gmultiset A.
+ Implicit Types Φ : A → PROP.
+
+ Lemma big_sepMS_later `{AffineBI PROP} Φ X :
+ ▷ ([∗ mset] y ∈ X, Φ y) ⊣⊢ ([∗ mset] y ∈ X, ▷ Φ y).
Proof. apply (big_opMS_commute _). Qed.
- Lemma big_sepMS_persistently_if q Φ X :
- □?q ([∗ mset] y ∈ X, Φ y) ⊣⊢ ([∗ mset] y ∈ X, □?q Φ y).
+ Lemma big_sepMS_laterN `{AffineBI PROP} Φ n X :
+ ▷^n ([∗ mset] y ∈ X, Φ y) ⊣⊢ ([∗ mset] y ∈ X, ▷^n Φ y).
Proof. apply (big_opMS_commute _). Qed.
- Global Instance big_sepMS_empty_persistent Φ : Persistent ([∗ mset] x ∈ ∅, Φ x).
- Proof. rewrite /big_opMS gmultiset_elements_empty. apply _. Qed.
- Global Instance big_sepMS_persistent Φ X :
- (∀ x, Persistent (Φ x)) → Persistent ([∗ mset] x ∈ X, Φ x).
- Proof. rewrite /big_opMS. apply _. Qed.
Global Instance big_sepMS_nil_timeless Φ : Timeless ([∗ mset] x ∈ ∅, Φ x).
Proof. rewrite /big_opMS gmultiset_elements_empty. apply _. Qed.
Global Instance big_sepMS_timeless Φ X :
(∀ x, Timeless (Φ x)) → Timeless ([∗ mset] x ∈ X, Φ x).
Proof. rewrite /big_opMS. apply _. Qed.
End gmultiset.
-End big_op.
+End sbi_big_op.
+End bi.
-Hint Resolve big_sepL_nil' big_sepM_empty' big_sepS_empty' big_sepMS_empty' | 0.
+Hint Resolve bi.big_sepL_nil' bi.big_sepM_empty'
+ bi.big_sepS_empty' bi.big_sepMS_empty' | 0.
diff --git a/theories/bi/derived.v b/theories/bi/derived.v
new file mode 100644
index 000000000..75359fd75
--- /dev/null
+++ b/theories/bi/derived.v
@@ -0,0 +1,1673 @@
+From iris.bi Require Export interface.
+From iris.algebra Require Import monoid.
+From stdpp Require Import hlist.
+
+Definition bi_iff {PROP : bi} (P Q : PROP) : PROP := ((P → Q) ∧ (Q → P))%I.
+Arguments bi_iff {_} _%I _%I : simpl never.
+Instance: Params (@bi_iff) 1.
+Infix "↔" := bi_iff : bi_scope.
+
+Definition bi_wand_iff {PROP : bi} (P Q : PROP) : PROP :=
+ ((P -∗ Q) ∧ (Q -∗ P))%I.
+Arguments bi_wand_iff {_} _%I _%I : simpl never.
+Instance: Params (@bi_wand_iff) 1.
+Infix "∗-∗" := bi_wand_iff (at level 95, no associativity) : bi_scope.
+
+Class Persistent {PROP : bi} (P : PROP) := persistent : □ P ⊣⊢ P.
+Arguments Persistent {_} _%I : simpl never.
+Arguments persistent {_} _%I {_}.
+Hint Mode Persistent + ! : typeclass_instances.
+Instance: Params (@Persistent) 1.
+
+Definition bi_bare {PROP : bi} (P : PROP) : PROP := (emp ∧ P)%I.
+Arguments bi_bare {_} _%I : simpl never.
+Instance: Params (@bi_bare) 1.
+Typeclasses Opaque bi_bare.
+Notation "â– P" := (bi_bare P) (at level 20, right associativity) : bi_scope.
+Notation "⬕ P" := (■□ P)%I (at level 20, right associativity) : bi_scope.
+
+Class Affine {PROP : bi} (Q : PROP) := affine : Q ⊢ emp.
+Arguments Affine {_} _%I : simpl never.
+Arguments affine {_} _%I {_}.
+Hint Mode Affine + ! : typeclass_instances.
+
+Class AffineBI (PROP : bi) := absorbing_bi (Q : PROP) : Affine Q.
+Existing Instance absorbing_bi | 0.
+
+Class Absorbing {PROP : bi} (P : PROP) := absorbing Q : P ∗ Q ⊢ P.
+Arguments Absorbing {_} _%I : simpl never.
+Arguments absorbing {_} _%I _%I.
+
+Definition bi_persistently_if {PROP : bi} (p : bool) (P : PROP) : PROP :=
+ (if p then â–¡ P else P)%I.
+Arguments bi_persistently_if {_} !_ _%I /.
+Instance: Params (@bi_persistently_if) 2.
+Typeclasses Opaque bi_persistently_if.
+Notation "â–¡? p P" := (bi_persistently_if p P)
+ (at level 20, p at level 9, P at level 20,
+ right associativity, format "â–¡? p P") : bi_scope.
+
+Definition bi_bare_if {PROP : bi} (p : bool) (P : PROP) : PROP :=
+ (if p then â– P else P)%I.
+Arguments bi_bare_if {_} !_ _%I /.
+Instance: Params (@bi_bare_if) 2.
+Typeclasses Opaque bi_bare_if.
+Notation "â– ? p P" := (bi_bare_if p P)
+ (at level 20, p at level 9, P at level 20,
+ right associativity, format "â– ? p P") : bi_scope.
+Notation "⬕? p P" := (■?p □?p P)%I
+ (at level 20, p at level 9, P at level 20,
+ right associativity, format "⬕? p P") : bi_scope.
+
+Fixpoint bi_hexist {PROP : bi} {As} : himpl As PROP → PROP :=
+ match As return himpl As PROP → PROP with
+ | tnil => id
+ | tcons A As => λ Φ, ∃ x, bi_hexist (Φ x)
+ end%I.
+Fixpoint bi_hforall {PROP : bi} {As} : himpl As PROP → PROP :=
+ match As return himpl As PROP → PROP with
+ | tnil => id
+ | tcons A As => λ Φ, ∀ x, bi_hforall (Φ x)
+ end%I.
+
+Definition bi_laterN {PROP : sbi} (n : nat) (P : PROP) : PROP :=
+ Nat.iter n bi_later P.
+Arguments bi_laterN {_} !_%nat_scope _%I.
+Instance: Params (@bi_laterN) 2.
+Notation "â–·^ n P" := (bi_laterN n P)
+ (at level 20, n at level 9, P at level 20, format "â–·^ n P") : bi_scope.
+Notation "â–·? p P" := (bi_laterN (Nat.b2n p) P)
+ (at level 20, p at level 9, P at level 20, format "â–·? p P") : bi_scope.
+
+Definition bi_except_0 {PROP : sbi} (P : PROP) : PROP := (▷ False ∨ P)%I.
+Arguments bi_except_0 {_} _%I : simpl never.
+Notation "â—‡ P" := (bi_except_0 P) (at level 20, right associativity) : bi_scope.
+Instance: Params (@bi_except_0) 1.
+Typeclasses Opaque bi_except_0.
+
+Class Timeless {PROP : sbi} (P : PROP) := timeless : ▷ P ⊢ ◇ P.
+Arguments Timeless {_} _%I : simpl never.
+Arguments timeless {_} _%I {_}.
+Hint Mode Timeless + ! : typeclass_instances.
+Instance: Params (@Timeless) 1.
+
+Module bi.
+Import interface.bi.
+Section bi_derived.
+Context {PROP : bi}.
+Implicit Types φ : Prop.
+Implicit Types P Q R : PROP.
+Implicit Types Ps : list PROP.
+Implicit Types A : Type.
+
+Hint Extern 100 (NonExpansive _) => solve_proper.
+
+(* Force implicit argument PROP *)
+Notation "P ⊢ Q" := (@bi_entails PROP P%I Q%I).
+Notation "P ⊣⊢ Q" := (equiv (A:=bi_car PROP) P%I Q%I).
+
+(* Derived stuff about the entailment *)
+Global Instance entails_anti_sym : AntiSymm (⊣⊢) (@bi_entails PROP).
+Proof. intros P Q ??. by apply equiv_spec. Qed.
+Lemma equiv_entails P Q : (P ⊣⊢ Q) → (P ⊢ Q).
+Proof. apply equiv_spec. Qed.
+Lemma equiv_entails_sym P Q : (Q ⊣⊢ P) → (P ⊢ Q).
+Proof. apply equiv_spec. Qed.
+Global Instance entails_proper :
+ Proper ((⊣⊢) ==> (⊣⊢) ==> iff) ((⊢) : relation PROP).
+Proof.
+ move => P1 P2 /equiv_spec [HP1 HP2] Q1 Q2 /equiv_spec [HQ1 HQ2]; split=>?.
+ - by trans P1; [|trans Q1].
+ - by trans P2; [|trans Q2].
+Qed.
+Lemma entails_equiv_l P Q R : (P ⊣⊢ Q) → (Q ⊢ R) → (P ⊢ R).
+Proof. by intros ->. Qed.
+Lemma entails_equiv_r P Q R : (P ⊢ Q) → (Q ⊣⊢ R) → (P ⊢ R).
+Proof. by intros ? <-. Qed.
+ Global Instance bi_valid_proper : Proper ((⊣⊢) ==> iff) (@bi_valid PROP).
+Proof. solve_proper. Qed.
+Global Instance bi_valid_mono : Proper ((⊢) ==> impl) (@bi_valid PROP).
+Proof. solve_proper. Qed.
+Global Instance bi_valid_flip_mono :
+ Proper (flip (⊢) ==> flip impl) (@bi_valid PROP).
+Proof. solve_proper. Qed.
+
+(* Propers *)
+Global Instance pure_proper : Proper (iff ==> (⊣⊢)) (@bi_pure PROP) | 0.
+Proof. intros φ1 φ2 Hφ. apply equiv_dist=> n. by apply pure_ne. Qed.
+Global Instance and_proper :
+ Proper ((⊣⊢) ==> (⊣⊢) ==> (⊣⊢)) (@bi_and PROP) := ne_proper_2 _.
+Global Instance or_proper :
+ Proper ((⊣⊢) ==> (⊣⊢) ==> (⊣⊢)) (@bi_or PROP) := ne_proper_2 _.
+Global Instance impl_proper :
+ Proper ((⊣⊢) ==> (⊣⊢) ==> (⊣⊢)) (@bi_impl PROP) := ne_proper_2 _.
+Global Instance sep_proper :
+ Proper ((⊣⊢) ==> (⊣⊢) ==> (⊣⊢)) (@bi_sep PROP) := ne_proper_2 _.
+Global Instance wand_proper :
+ Proper ((⊣⊢) ==> (⊣⊢) ==> (⊣⊢)) (@bi_wand PROP) := ne_proper_2 _.
+Global Instance forall_proper A :
+ Proper (pointwise_relation _ (⊣⊢) ==> (⊣⊢)) (@bi_forall PROP A).
+Proof.
+ intros Φ1 Φ2 HΦ. apply equiv_dist=> n.
+ apply forall_ne=> x. apply equiv_dist, HΦ.
+Qed.
+Global Instance exist_proper A :
+ Proper (pointwise_relation _ (⊣⊢) ==> (⊣⊢)) (@bi_exist PROP A).
+Proof.
+ intros Φ1 Φ2 HΦ. apply equiv_dist=> n.
+ apply exist_ne=> x. apply equiv_dist, HΦ.
+Qed.
+Global Instance internal_eq_proper (A : ofeT) :
+ Proper ((≡) ==> (≡) ==> (⊣⊢)) (@bi_internal_eq PROP A) := ne_proper_2 _.
+Global Instance persistently_proper :
+ Proper ((⊣⊢) ==> (⊣⊢)) (@bi_persistently PROP) := ne_proper _.
+
+(* Derived logical stuff *)
+Lemma and_elim_l' P Q R : (P ⊢ R) → P ∧ Q ⊢ R.
+Proof. by rewrite and_elim_l. Qed.
+Lemma and_elim_r' P Q R : (Q ⊢ R) → P ∧ Q ⊢ R.
+Proof. by rewrite and_elim_r. Qed.
+Lemma or_intro_l' P Q R : (P ⊢ Q) → P ⊢ Q ∨ R.
+Proof. intros ->; apply or_intro_l. Qed.
+Lemma or_intro_r' P Q R : (P ⊢ R) → P ⊢ Q ∨ R.
+Proof. intros ->; apply or_intro_r. Qed.
+Lemma exist_intro' {A} P (Ψ : A → PROP) a : (P ⊢ Ψ a) → P ⊢ ∃ a, Ψ a.
+Proof. intros ->; apply exist_intro. Qed.
+Lemma forall_elim' {A} P (Ψ : A → PROP) : (P ⊢ ∀ a, Ψ a) → ∀ a, P ⊢ Ψ a.
+Proof. move=> HP a. by rewrite HP forall_elim. Qed.
+
+Hint Resolve pure_intro forall_intro.
+Hint Resolve or_elim or_intro_l' or_intro_r'.
+Hint Resolve and_intro and_elim_l' and_elim_r'.
+
+Lemma impl_intro_l P Q R : (Q ∧ P ⊢ R) → P ⊢ Q → R.
+Proof. intros HR; apply impl_intro_r; rewrite -HR; auto. Qed.
+Lemma impl_elim P Q R : (P ⊢ Q → R) → (P ⊢ Q) → P ⊢ R.
+Proof. intros. rewrite -(impl_elim_l' P Q R); auto. Qed.
+Lemma impl_elim_r' P Q R : (Q ⊢ P → R) → P ∧ Q ⊢ R.
+Proof. intros; apply impl_elim with P; auto. Qed.
+Lemma impl_elim_l P Q : (P → Q) ∧ P ⊢ Q.
+Proof. by apply impl_elim_l'. Qed.
+Lemma impl_elim_r P Q : P ∧ (P → Q) ⊢ Q.
+Proof. by apply impl_elim_r'. Qed.
+
+Lemma False_elim P : False ⊢ P.
+Proof. by apply (pure_elim' False). Qed.
+Lemma True_intro P : P ⊢ True.
+Proof. by apply pure_intro. Qed.
+Hint Immediate False_elim.
+
+Lemma and_mono P P' Q Q' : (P ⊢ Q) → (P' ⊢ Q') → P ∧ P' ⊢ Q ∧ Q'.
+Proof. auto. Qed.
+Lemma and_mono_l P P' Q : (P ⊢ Q) → P ∧ P' ⊢ Q ∧ P'.
+Proof. by intros; apply and_mono. Qed.
+Lemma and_mono_r P P' Q' : (P' ⊢ Q') → P ∧ P' ⊢ P ∧ Q'.
+Proof. by apply and_mono. Qed.
+
+Lemma or_mono P P' Q Q' : (P ⊢ Q) → (P' ⊢ Q') → P ∨ P' ⊢ Q ∨ Q'.
+Proof. auto. Qed.
+Lemma or_mono_l P P' Q : (P ⊢ Q) → P ∨ P' ⊢ Q ∨ P'.
+Proof. by intros; apply or_mono. Qed.
+Lemma or_mono_r P P' Q' : (P' ⊢ Q') → P ∨ P' ⊢ P ∨ Q'.
+Proof. by apply or_mono. Qed.
+
+Lemma impl_mono P P' Q Q' : (Q ⊢ P) → (P' ⊢ Q') → (P → P') ⊢ Q → Q'.
+Proof.
+ intros HP HQ'; apply impl_intro_l; rewrite -HQ'.
+ apply impl_elim with P; eauto.
+Qed.
+Lemma forall_mono {A} (Φ Ψ : A → PROP) :
+ (∀ a, Φ a ⊢ Ψ a) → (∀ a, Φ a) ⊢ ∀ a, Ψ a.
+Proof.
+ intros HP. apply forall_intro=> a; rewrite -(HP a); apply forall_elim.
+Qed.
+Lemma exist_mono {A} (Φ Ψ : A → PROP) :
+ (∀ a, Φ a ⊢ Ψ a) → (∃ a, Φ a) ⊢ ∃ a, Ψ a.
+Proof. intros HΦ. apply exist_elim=> a; rewrite (HΦ a); apply exist_intro. Qed.
+
+Global Instance and_mono' : Proper ((⊢) ==> (⊢) ==> (⊢)) (@bi_and PROP).
+Proof. by intros P P' HP Q Q' HQ; apply and_mono. Qed.
+Global Instance and_flip_mono' :
+ Proper (flip (⊢) ==> flip (⊢) ==> flip (⊢)) (@bi_and PROP).
+Proof. by intros P P' HP Q Q' HQ; apply and_mono. Qed.
+Global Instance or_mono' : Proper ((⊢) ==> (⊢) ==> (⊢)) (@bi_or PROP).
+Proof. by intros P P' HP Q Q' HQ; apply or_mono. Qed.
+Global Instance or_flip_mono' :
+ Proper (flip (⊢) ==> flip (⊢) ==> flip (⊢)) (@bi_or PROP).
+Proof. by intros P P' HP Q Q' HQ; apply or_mono. Qed.
+Global Instance impl_mono' :
+ Proper (flip (⊢) ==> (⊢) ==> (⊢)) (@bi_impl PROP).
+Proof. by intros P P' HP Q Q' HQ; apply impl_mono. Qed.
+Global Instance impl_flip_mono' :
+ Proper ((⊢) ==> flip (⊢) ==> flip (⊢)) (@bi_impl PROP).
+Proof. by intros P P' HP Q Q' HQ; apply impl_mono. Qed.
+Global Instance forall_mono' A :
+ Proper (pointwise_relation _ (⊢) ==> (⊢)) (@bi_forall PROP A).
+Proof. intros P1 P2; apply forall_mono. Qed.
+Global Instance forall_flip_mono' A :
+ Proper (pointwise_relation _ (flip (⊢)) ==> flip (⊢)) (@bi_forall PROP A).
+Proof. intros P1 P2; apply forall_mono. Qed.
+Global Instance exist_mono' A :
+ Proper (pointwise_relation _ ((⊢)) ==> (⊢)) (@bi_exist PROP A).
+Proof. intros P1 P2; apply exist_mono. Qed.
+Global Instance exist_flip_mono' A :
+ Proper (pointwise_relation _ (flip (⊢)) ==> flip (⊢)) (@bi_exist PROP A).
+Proof. intros P1 P2; apply exist_mono. Qed.
+
+Global Instance and_idem : IdemP (⊣⊢) (@bi_and PROP).
+Proof. intros P; apply (anti_symm (⊢)); auto. Qed.
+Global Instance or_idem : IdemP (⊣⊢) (@bi_or PROP).
+Proof. intros P; apply (anti_symm (⊢)); auto. Qed.
+Global Instance and_comm : Comm (⊣⊢) (@bi_and PROP).
+Proof. intros P Q; apply (anti_symm (⊢)); auto. Qed.
+Global Instance True_and : LeftId (⊣⊢) True%I (@bi_and PROP).
+Proof. intros P; apply (anti_symm (⊢)); auto. Qed.
+Global Instance and_True : RightId (⊣⊢) True%I (@bi_and PROP).
+Proof. intros P; apply (anti_symm (⊢)); auto. Qed.
+Global Instance False_and : LeftAbsorb (⊣⊢) False%I (@bi_and PROP).
+Proof. intros P; apply (anti_symm (⊢)); auto. Qed.
+Global Instance and_False : RightAbsorb (⊣⊢) False%I (@bi_and PROP).
+Proof. intros P; apply (anti_symm (⊢)); auto. Qed.
+Global Instance True_or : LeftAbsorb (⊣⊢) True%I (@bi_or PROP).
+Proof. intros P; apply (anti_symm (⊢)); auto. Qed.
+Global Instance or_True : RightAbsorb (⊣⊢) True%I (@bi_or PROP).
+Proof. intros P; apply (anti_symm (⊢)); auto. Qed.
+Global Instance False_or : LeftId (⊣⊢) False%I (@bi_or PROP).
+Proof. intros P; apply (anti_symm (⊢)); auto. Qed.
+Global Instance or_False : RightId (⊣⊢) False%I (@bi_or PROP).
+Proof. intros P; apply (anti_symm (⊢)); auto. Qed.
+Global Instance and_assoc : Assoc (⊣⊢) (@bi_and PROP).
+Proof. intros P Q R; apply (anti_symm (⊢)); auto. Qed.
+Global Instance or_comm : Comm (⊣⊢) (@bi_or PROP).
+Proof. intros P Q; apply (anti_symm (⊢)); auto. Qed.
+Global Instance or_assoc : Assoc (⊣⊢) (@bi_or PROP).
+Proof. intros P Q R; apply (anti_symm (⊢)); auto. Qed.
+Global Instance True_impl : LeftId (⊣⊢) True%I (@bi_impl PROP).
+Proof.
+ intros P; apply (anti_symm (⊢)).
+ - by rewrite -(left_id True%I (∧)%I (_ → _)%I) impl_elim_r.
+ - by apply impl_intro_l; rewrite left_id.
+Qed.
+
+Lemma False_impl P : (False → P) ⊣⊢ True.
+Proof.
+ apply (anti_symm (⊢)); [by auto|].
+ apply impl_intro_l. rewrite left_absorb. auto.
+Qed.
+
+Lemma exists_impl_forall {A} P (Ψ : A → PROP) :
+ ((∃ x : A, Ψ x) → P) ⊣⊢ ∀ x : A, Ψ x → P.
+Proof.
+ apply equiv_spec; split.
+ - apply forall_intro=>x. by rewrite -exist_intro.
+ - apply impl_intro_r, impl_elim_r', exist_elim=>x.
+ apply impl_intro_r. by rewrite (forall_elim x) impl_elim_r.
+Qed.
+
+Lemma or_and_l P Q R : P ∨ Q ∧ R ⊣⊢ (P ∨ Q) ∧ (P ∨ R).
+Proof.
+ apply (anti_symm (⊢)); first auto.
+ do 2 (apply impl_elim_l', or_elim; apply impl_intro_l); auto.
+Qed.
+Lemma or_and_r P Q R : P ∧ Q ∨ R ⊣⊢ (P ∨ R) ∧ (Q ∨ R).
+Proof. by rewrite -!(comm _ R) or_and_l. Qed.
+Lemma and_or_l P Q R : P ∧ (Q ∨ R) ⊣⊢ P ∧ Q ∨ P ∧ R.
+Proof.
+ apply (anti_symm (⊢)); last auto.
+ apply impl_elim_r', or_elim; apply impl_intro_l; auto.
+Qed.
+Lemma and_or_r P Q R : (P ∨ Q) ∧ R ⊣⊢ P ∧ R ∨ Q ∧ R.
+Proof. by rewrite -!(comm _ R) and_or_l. Qed.
+Lemma and_exist_l {A} P (Ψ : A → PROP) : P ∧ (∃ a, Ψ a) ⊣⊢ ∃ a, P ∧ Ψ a.
+Proof.
+ apply (anti_symm (⊢)).
+ - apply impl_elim_r'. apply exist_elim=>a. apply impl_intro_l.
+ by rewrite -(exist_intro a).
+ - apply exist_elim=>a. apply and_intro; first by rewrite and_elim_l.
+ by rewrite -(exist_intro a) and_elim_r.
+Qed.
+Lemma and_exist_r {A} P (Φ: A → PROP) : (∃ a, Φ a) ∧ P ⊣⊢ ∃ a, Φ a ∧ P.
+Proof.
+ rewrite -(comm _ P) and_exist_l. apply exist_proper=>a. by rewrite comm.
+Qed.
+Lemma or_exist {A} (Φ Ψ : A → PROP) :
+ (∃ a, Φ a ∨ Ψ a) ⊣⊢ (∃ a, Φ a) ∨ (∃ a, Ψ a).
+Proof.
+ apply (anti_symm (⊢)).
+ - apply exist_elim=> a. by rewrite -!(exist_intro a).
+ - apply or_elim; apply exist_elim=> a; rewrite -(exist_intro a); auto.
+Qed.
+
+Lemma and_alt P Q : P ∧ Q ⊣⊢ ∀ b : bool, if b then P else Q.
+Proof.
+ apply (anti_symm _); first apply forall_intro=> -[]; auto.
+ by apply and_intro; [rewrite (forall_elim true)|rewrite (forall_elim false)].
+Qed.
+Lemma or_alt P Q : P ∨ Q ⊣⊢ ∃ b : bool, if b then P else Q.
+Proof.
+ apply (anti_symm _); last apply exist_elim=> -[]; auto.
+ by apply or_elim; [rewrite -(exist_intro true)|rewrite -(exist_intro false)].
+Qed.
+
+Lemma entails_equiv_and P Q : (P ⊣⊢ Q ∧ P) ↔ (P ⊢ Q).
+Proof. split. by intros ->; auto. intros; apply (anti_symm _); auto. Qed.
+
+Global Instance iff_ne : NonExpansive2 (@bi_iff PROP).
+Proof. unfold bi_iff; solve_proper. Qed.
+Global Instance iff_proper :
+ Proper ((⊣⊢) ==> (⊣⊢) ==> (⊣⊢)) (@bi_iff PROP) := ne_proper_2 _.
+
+Lemma iff_refl Q P : Q ⊢ P ↔ P.
+Proof. rewrite /bi_iff; apply and_intro; apply impl_intro_l; auto. Qed.
+
+(* Equality stuff *)
+Hint Resolve internal_eq_refl.
+Lemma equiv_internal_eq {A : ofeT} P (a b : A) : a ≡ b → P ⊢ a ≡ b.
+Proof. intros ->. auto. Qed.
+Lemma internal_eq_rewrite' {A : ofeT} a b (Ψ : A → PROP) P
+ {HΨ : NonExpansive Ψ} : (P ⊢ a ≡ b) → (P ⊢ Ψ a) → P ⊢ Ψ b.
+Proof.
+ intros Heq HΨa. rewrite -(idemp bi_and P) {1}Heq HΨa.
+ apply impl_elim_l'. by apply internal_eq_rewrite.
+Qed.
+
+Lemma internal_eq_sym {A : ofeT} (a b : A) : a ≡ b ⊢ b ≡ a.
+Proof. apply (internal_eq_rewrite' a b (λ b, b ≡ a)%I); auto. Qed.
+Lemma internal_eq_iff P Q : P ≡ Q ⊢ P ↔ Q.
+Proof. apply (internal_eq_rewrite' P Q (λ Q, P ↔ Q))%I; auto using iff_refl. Qed.
+
+Lemma f_equiv {A B : ofeT} (f : A → B) `{!NonExpansive f} x y :
+ x ≡ y ⊢ f x ≡ f y.
+Proof. apply (internal_eq_rewrite' x y (λ y, f x ≡ f y)%I); auto. Qed.
+
+Lemma prod_equivI {A B : ofeT} (x y : A * B) : x ≡ y ⊣⊢ x.1 ≡ y.1 ∧ x.2 ≡ y.2.
+Proof.
+ apply (anti_symm _).
+ - apply and_intro; apply f_equiv; apply _.
+ - rewrite {3}(surjective_pairing x) {3}(surjective_pairing y).
+ apply (internal_eq_rewrite' (x.1) (y.1) (λ a, (x.1,x.2) ≡ (a,y.2))%I); auto.
+ apply (internal_eq_rewrite' (x.2) (y.2) (λ b, (x.1,x.2) ≡ (x.1,b))%I); auto.
+Qed.
+Lemma sum_equivI {A B : ofeT} (x y : A + B) :
+ x ≡ y ⊣⊢
+ match x, y with
+ | inl a, inl a' => a ≡ a' | inr b, inr b' => b ≡ b' | _, _ => False
+ end.
+Proof.
+ apply (anti_symm _).
+ - apply (internal_eq_rewrite' x y (λ y,
+ match x, y with
+ | inl a, inl a' => a ≡ a' | inr b, inr b' => b ≡ b' | _, _ => False
+ end)%I); auto.
+ destruct x; auto.
+ - destruct x as [a|b], y as [a'|b']; auto; apply f_equiv, _.
+Qed.
+Lemma option_equivI {A : ofeT} (x y : option A) :
+ x ≡ y ⊣⊢ match x, y with
+ | Some a, Some a' => a ≡ a' | None, None => True | _, _ => False
+ end.
+Proof.
+ apply (anti_symm _).
+ - apply (internal_eq_rewrite' x y (λ y,
+ match x, y with
+ | Some a, Some a' => a ≡ a' | None, None => True | _, _ => False
+ end)%I); auto.
+ destruct x; auto.
+ - destruct x as [a|], y as [a'|]; auto. apply f_equiv, _.
+Qed.
+
+Lemma sig_equivI {A : ofeT} (P : A → Prop) (x y : sig P) : `x ≡ `y ⊣⊢ x ≡ y.
+Proof. apply (anti_symm _). apply sig_eq. apply f_equiv, _. Qed.
+
+Lemma ofe_funC_equivI {A B} (f g : A -c> B) : f ≡ g ⊣⊢ ∀ x, f x ≡ g x.
+Proof.
+ apply (anti_symm _); auto using fun_ext.
+ apply (internal_eq_rewrite' f g (λ g, ∀ x : A, f x ≡ g x)%I); auto.
+ intros n h h' Hh; apply forall_ne=> x; apply internal_eq_ne; auto.
+Qed.
+Lemma ofe_morC_equivI {A B : ofeT} (f g : A -n> B) : f ≡ g ⊣⊢ ∀ x, f x ≡ g x.
+Proof.
+ apply (anti_symm _).
+ - apply (internal_eq_rewrite' f g (λ g, ∀ x : A, f x ≡ g x)%I); auto.
+ - rewrite -(ofe_funC_equivI (ofe_mor_car _ _ f) (ofe_mor_car _ _ g)).
+ set (h1 (f : A -n> B) :=
+ exist (λ f : A -c> B, NonExpansive f) f (ofe_mor_ne A B f)).
+ set (h2 (f : sigC (λ f : A -c> B, NonExpansive f)) :=
+ @CofeMor A B (`f) (proj2_sig f)).
+ assert (∀ f, h2 (h1 f) = f) as Hh by (by intros []).
+ assert (NonExpansive h2) by (intros ??? EQ; apply EQ).
+ by rewrite -{2}[f]Hh -{2}[g]Hh -f_equiv -sig_equivI.
+Qed.
+
+(* BI Stuff *)
+Hint Resolve sep_mono.
+Lemma sep_mono_l P P' Q : (P ⊢ Q) → P ∗ P' ⊢ Q ∗ P'.
+Proof. by intros; apply sep_mono. Qed.
+Lemma sep_mono_r P P' Q' : (P' ⊢ Q') → P ∗ P' ⊢ P ∗ Q'.
+Proof. by apply sep_mono. Qed.
+Global Instance sep_mono' : Proper ((⊢) ==> (⊢) ==> (⊢)) (@bi_sep PROP).
+Proof. by intros P P' HP Q Q' HQ; apply sep_mono. Qed.
+Global Instance sep_flip_mono' :
+ Proper (flip (⊢) ==> flip (⊢) ==> flip (⊢)) (@bi_sep PROP).
+Proof. by intros P P' HP Q Q' HQ; apply sep_mono. Qed.
+Lemma wand_mono P P' Q Q' : (Q ⊢ P) → (P' ⊢ Q') → (P -∗ P') ⊢ Q -∗ Q'.
+Proof.
+ intros HP HQ; apply wand_intro_r. rewrite HP -HQ. by apply wand_elim_l'.
+Qed.
+Global Instance wand_mono' : Proper (flip (⊢) ==> (⊢) ==> (⊢)) (@bi_wand PROP).
+Proof. by intros P P' HP Q Q' HQ; apply wand_mono. Qed.
+Global Instance wand_flip_mono' :
+ Proper ((⊢) ==> flip (⊢) ==> flip (⊢)) (@bi_wand PROP).
+Proof. by intros P P' HP Q Q' HQ; apply wand_mono. Qed.
+
+Global Instance sep_comm : Comm (⊣⊢) (@bi_sep PROP).
+Proof. intros P Q; apply (anti_symm _); auto using sep_comm'. Qed.
+Global Instance sep_assoc : Assoc (⊣⊢) (@bi_sep PROP).
+Proof.
+ intros P Q R; apply (anti_symm _); auto using sep_assoc'.
+ by rewrite !(comm _ P) !(comm _ _ R) sep_assoc'.
+Qed.
+Global Instance emp_sep : LeftId (⊣⊢) emp%I (@bi_sep PROP).
+Proof. intros P; apply (anti_symm _); auto using emp_sep_1, emp_sep_2. Qed.
+Global Instance sep_emp : RightId (⊣⊢) emp%I (@bi_sep PROP).
+Proof. by intros P; rewrite comm left_id. Qed.
+
+Global Instance sep_False : LeftAbsorb (⊣⊢) False%I (@bi_sep PROP).
+Proof. intros P; apply (anti_symm _); auto using wand_elim_l'. Qed.
+Global Instance False_sep : RightAbsorb (⊣⊢) False%I (@bi_sep PROP).
+Proof. intros P. by rewrite comm left_absorb. Qed.
+
+Lemma True_sep_2 P : P ⊢ True ∗ P.
+Proof. rewrite -{1}[P](left_id emp%I bi_sep). auto using sep_mono. Qed.
+Lemma sep_True_2 P : P ⊢ P ∗ True.
+Proof. by rewrite comm -True_sep_2. Qed.
+
+Lemma sep_intro_valid_l P Q R : P → (R ⊢ Q) → R ⊢ P ∗ Q.
+Proof. intros ? ->. rewrite -{1}(left_id emp%I _ Q). by apply sep_mono. Qed.
+Lemma sep_intro_valid_r P Q R : (R ⊢ P) → Q → R ⊢ P ∗ Q.
+Proof. intros -> ?. rewrite comm. by apply sep_intro_valid_l. Qed.
+Lemma sep_elim_valid_l P Q R : P → (P ∗ R ⊢ Q) → R ⊢ Q.
+Proof. intros <- <-. by rewrite left_id. Qed.
+Lemma sep_elim_valid_r P Q R : P → (R ∗ P ⊢ Q) → R ⊢ Q.
+Proof. intros <- <-. by rewrite right_id. Qed.
+
+Lemma wand_intro_l P Q R : (Q ∗ P ⊢ R) → P ⊢ Q -∗ R.
+Proof. rewrite comm; apply wand_intro_r. Qed.
+Lemma wand_elim_l P Q : (P -∗ Q) ∗ P ⊢ Q.
+Proof. by apply wand_elim_l'. Qed.
+Lemma wand_elim_r P Q : P ∗ (P -∗ Q) ⊢ Q.
+Proof. rewrite (comm _ P); apply wand_elim_l. Qed.
+Lemma wand_elim_r' P Q R : (Q ⊢ P -∗ R) → P ∗ Q ⊢ R.
+Proof. intros ->; apply wand_elim_r. Qed.
+Lemma wand_apply P Q R S : (P ⊢ Q -∗ R) → (S ⊢ P ∗ Q) → S ⊢ R.
+Proof. intros HR%wand_elim_l' HQ. by rewrite HQ. Qed.
+Lemma wand_frame_l P Q R : (Q -∗ R) ⊢ P ∗ Q -∗ P ∗ R.
+Proof. apply wand_intro_l. rewrite -assoc. apply sep_mono_r, wand_elim_r. Qed.
+Lemma wand_frame_r P Q R : (Q -∗ R) ⊢ Q ∗ P -∗ R ∗ P.
+Proof.
+ apply wand_intro_l. rewrite ![(_ ∗ P)%I]comm -assoc.
+ apply sep_mono_r, wand_elim_r.
+Qed.
+
+Lemma emp_wand P : (emp -∗ P) ⊣⊢ P.
+Proof.
+ apply (anti_symm _).
+ - by rewrite -[(emp -∗ P)%I]left_id wand_elim_r.
+ - apply wand_intro_l. by rewrite left_id.
+Qed.
+Lemma False_wand P : (False -∗ P) ⊣⊢ True.
+Proof.
+ apply (anti_symm (⊢)); [by auto|].
+ apply wand_intro_l. rewrite left_absorb. auto.
+Qed.
+
+Lemma wand_curry P Q R : (P -∗ Q -∗ R) ⊣⊢ (P ∗ Q -∗ R).
+Proof.
+ apply (anti_symm _).
+ - apply wand_intro_l. by rewrite (comm _ P) -assoc !wand_elim_r.
+ - do 2 apply wand_intro_l. by rewrite assoc (comm _ Q) wand_elim_r.
+Qed.
+
+Lemma sep_and_l P Q R : P ∗ (Q ∧ R) ⊢ (P ∗ Q) ∧ (P ∗ R).
+Proof. auto. Qed.
+Lemma sep_and_r P Q R : (P ∧ Q) ∗ R ⊢ (P ∗ R) ∧ (Q ∗ R).
+Proof. auto. Qed.
+Lemma sep_or_l P Q R : P ∗ (Q ∨ R) ⊣⊢ (P ∗ Q) ∨ (P ∗ R).
+Proof.
+ apply (anti_symm (⊢)); last by eauto 8.
+ apply wand_elim_r', or_elim; apply wand_intro_l; auto.
+Qed.
+Lemma sep_or_r P Q R : (P ∨ Q) ∗ R ⊣⊢ (P ∗ R) ∨ (Q ∗ R).
+Proof. by rewrite -!(comm _ R) sep_or_l. Qed.
+Lemma sep_exist_l {A} P (Ψ : A → PROP) : P ∗ (∃ a, Ψ a) ⊣⊢ ∃ a, P ∗ Ψ a.
+Proof.
+ intros; apply (anti_symm (⊢)).
+ - apply wand_elim_r', exist_elim=>a. apply wand_intro_l.
+ by rewrite -(exist_intro a).
+ - apply exist_elim=> a; apply sep_mono; auto using exist_intro.
+Qed.
+Lemma sep_exist_r {A} (Φ: A → PROP) Q: (∃ a, Φ a) ∗ Q ⊣⊢ ∃ a, Φ a ∗ Q.
+Proof. setoid_rewrite (comm _ _ Q); apply sep_exist_l. Qed.
+Lemma sep_forall_l {A} P (Ψ : A → PROP) : P ∗ (∀ a, Ψ a) ⊢ ∀ a, P ∗ Ψ a.
+Proof. by apply forall_intro=> a; rewrite forall_elim. Qed.
+Lemma sep_forall_r {A} (Φ : A → PROP) Q : (∀ a, Φ a) ∗ Q ⊢ ∀ a, Φ a ∗ Q.
+Proof. by apply forall_intro=> a; rewrite forall_elim. Qed.
+
+Global Instance wand_iff_ne : NonExpansive2 (@bi_wand_iff PROP).
+Proof. solve_proper. Qed.
+Global Instance wand_iff_proper :
+ Proper ((⊣⊢) ==> (⊣⊢) ==> (⊣⊢)) (@bi_wand_iff PROP) := ne_proper_2 _.
+
+Lemma wand_iff_refl P : emp ⊢ P ∗-∗ P.
+Proof. apply and_intro; apply wand_intro_l; by rewrite right_id. Qed.
+
+Lemma wand_entails P Q : (P -∗ Q)%I → P ⊢ Q.
+Proof. intros. rewrite -[P]left_id. by apply wand_elim_l'. Qed.
+Lemma entails_wand P Q : (P ⊢ Q) → (P -∗ Q)%I.
+Proof. intros ->. apply wand_intro_r. by rewrite left_id. Qed.
+
+Lemma equiv_wand_iff P Q : (P ⊣⊢ Q) → (P ∗-∗ Q)%I.
+Proof. intros ->; apply wand_iff_refl. Qed.
+Lemma wand_iff_equiv P Q : (P ∗-∗ Q)%I → (P ⊣⊢ Q).
+Proof.
+ intros HPQ; apply (anti_symm (⊢));
+ apply wand_entails; rewrite /bi_valid HPQ /bi_wand_iff; auto.
+Qed.
+
+Lemma entails_impl P Q : (P ⊢ Q) → (P → Q)%I.
+Proof. intros ->. apply impl_intro_l. auto. Qed.
+Lemma impl_entails P Q `{!Affine P} : (P → Q)%I → P ⊢ Q.
+Proof. intros HPQ. apply impl_elim with P=>//. by rewrite {1}(affine P). Qed.
+
+Lemma equiv_iff P Q : (P ⊣⊢ Q) → (P ↔ Q)%I.
+Proof. intros ->; apply iff_refl. Qed.
+Lemma iff_equiv P Q `{!Affine P, !Affine Q} : (P ↔ Q)%I → (P ⊣⊢ Q).
+Proof.
+ intros HPQ; apply (anti_symm (⊢));
+ apply: impl_entails; rewrite /bi_valid HPQ /bi_iff; auto.
+Qed.
+
+(* Pure stuff *)
+Lemma pure_elim φ Q R : (Q ⊢ ⌜φâŒ) → (φ → Q ⊢ R) → Q ⊢ R.
+Proof.
+ intros HQ HQR. rewrite -(idemp (∧)%I Q) {1}HQ.
+ apply impl_elim_l', pure_elim'=> ?. apply impl_intro_l.
+ rewrite and_elim_l; auto.
+Qed.
+Lemma pure_mono φ1 φ2 : (φ1 → φ2) → ⌜φ1⌠⊢ ⌜φ2âŒ.
+Proof. auto using pure_elim', pure_intro. Qed.
+Global Instance pure_mono' : Proper (impl ==> (⊢)) (@bi_pure PROP).
+Proof. intros φ1 φ2; apply pure_mono. Qed.
+Global Instance pure_flip_mono : Proper (flip impl ==> flip (⊢)) (@bi_pure PROP).
+Proof. intros φ1 φ2; apply pure_mono. Qed.
+Lemma pure_iff φ1 φ2 : (φ1 ↔ φ2) → ⌜φ1⌠⊣⊢ ⌜φ2âŒ.
+Proof. intros [??]; apply (anti_symm _); auto using pure_mono. Qed.
+Lemma pure_elim_l φ Q R : (φ → Q ⊢ R) → ⌜φ⌠∧ Q ⊢ R.
+Proof. intros; apply pure_elim with φ; eauto. Qed.
+Lemma pure_elim_r φ Q R : (φ → Q ⊢ R) → Q ∧ ⌜φ⌠⊢ R.
+Proof. intros; apply pure_elim with φ; eauto. Qed.
+
+Lemma pure_True (φ : Prop) : φ → ⌜φ⌠⊣⊢ True.
+Proof. intros; apply (anti_symm _); auto. Qed.
+Lemma pure_False (φ : Prop) : ¬φ → ⌜φ⌠⊣⊢ False.
+Proof. intros; apply (anti_symm _); eauto using pure_mono. Qed.
+
+Lemma pure_and φ1 φ2 : ⌜φ1 ∧ φ2⌠⊣⊢ ⌜φ1⌠∧ ⌜φ2âŒ.
+Proof.
+ apply (anti_symm _).
+ - apply and_intro; apply pure_mono; tauto.
+ - eapply (pure_elim φ1); [auto|]=> ?. rewrite and_elim_r. auto using pure_mono.
+Qed.
+Lemma pure_or φ1 φ2 : ⌜φ1 ∨ φ2⌠⊣⊢ ⌜φ1⌠∨ ⌜φ2âŒ.
+Proof.
+ apply (anti_symm _).
+ - eapply pure_elim=> // -[?|?]; auto using pure_mono.
+ - apply or_elim; eauto using pure_mono.
+Qed.
+Lemma pure_impl φ1 φ2 : ⌜φ1 → φ2⌠⊣⊢ (⌜φ1⌠→ ⌜φ2âŒ).
+Proof.
+ apply (anti_symm _).
+ - apply impl_intro_l. rewrite -pure_and. apply pure_mono. naive_solver.
+ - rewrite -pure_forall_2. apply forall_intro=> ?.
+ by rewrite -(left_id True bi_and (_→_))%I (pure_True φ1) // impl_elim_r.
+Qed.
+Lemma pure_forall {A} (φ : A → Prop) : ⌜∀ x, φ x⌠⊣⊢ ∀ x, ⌜φ xâŒ.
+Proof.
+ apply (anti_symm _); auto using pure_forall_2.
+ apply forall_intro=> x. eauto using pure_mono.
+Qed.
+Lemma pure_exist {A} (φ : A → Prop) : ⌜∃ x, φ x⌠⊣⊢ ∃ x, ⌜φ xâŒ.
+Proof.
+ apply (anti_symm _).
+ - eapply pure_elim=> // -[x ?]. rewrite -(exist_intro x); auto using pure_mono.
+ - apply exist_elim=> x. eauto using pure_mono.
+Qed.
+
+Lemma pure_impl_forall φ P : (⌜φ⌠→ P) ⊣⊢ (∀ _ : φ, P).
+Proof.
+ apply (anti_symm _).
+ - apply forall_intro=> ?. by rewrite pure_True // left_id.
+ - apply impl_intro_l, pure_elim_l=> Hφ. by rewrite (forall_elim Hφ).
+Qed.
+Lemma pure_alt φ : ⌜φ⌠⊣⊢ ∃ _ : φ, True.
+Proof.
+ apply (anti_symm _).
+ - eapply pure_elim; eauto=> H. rewrite -(exist_intro H); auto.
+ - by apply exist_elim, pure_intro.
+Qed.
+Lemma pure_wand_forall φ P `{!Absorbing P} : (⌜φ⌠-∗ P) ⊣⊢ (∀ _ : φ, P).
+Proof.
+ apply (anti_symm _).
+ - apply forall_intro=> Hφ.
+ by rewrite -(left_id emp%I _ (_ -∗ _)%I) (pure_intro emp%I φ) // wand_elim_r.
+ - apply wand_intro_l, wand_elim_l', pure_elim'=> Hφ.
+ apply wand_intro_l. by rewrite (forall_elim Hφ) absorbing.
+Qed.
+
+Lemma pure_internal_eq {A : ofeT} (x y : A) : ⌜x ≡ y⌠⊢ x ≡ y.
+Proof. apply pure_elim'=> ->. apply internal_eq_refl. Qed.
+Lemma discrete_eq {A : ofeT} (a b : A) : Discrete a → a ≡ b ⊣⊢ ⌜a ≡ bâŒ.
+Proof.
+ intros. apply (anti_symm _); auto using discrete_eq_1, pure_internal_eq.
+Qed.
+
+(* Properties of the bare modality *)
+Global Instance bare_ne : NonExpansive (@bi_bare PROP).
+Proof. solve_proper. Qed.
+Global Instance bare_proper : Proper ((⊣⊢) ==> (⊣⊢)) (@bi_bare PROP).
+Proof. solve_proper. Qed.
+Global Instance bare_mono' : Proper ((⊢) ==> (⊢)) (@bi_bare PROP).
+Proof. solve_proper. Qed.
+Global Instance bare_flip_mono' :
+ Proper (flip (⊢) ==> flip (⊢)) (@bi_bare PROP).
+Proof. solve_proper. Qed.
+
+Lemma bare_elim_emp P : ■P ⊢ emp.
+Proof. rewrite /bi_bare; auto. Qed.
+Lemma bare_elim P : ■P ⊢ P.
+Proof. rewrite /bi_bare; auto. Qed.
+Lemma bare_mono P Q : (P ⊢ Q) → ■P ⊢ ■Q.
+Proof. by intros ->. Qed.
+Lemma bare_idemp P : ■■P ⊣⊢ ■P.
+Proof. by rewrite /bi_bare assoc idemp. Qed.
+
+Lemma bare_intro' P Q : (■P ⊢ Q) → ■P ⊢ ■Q.
+Proof. intros <-. by rewrite bare_idemp. Qed.
+
+Lemma bare_False : ■False ⊣⊢ False.
+Proof. by rewrite /bi_bare right_absorb. Qed.
+Lemma bare_emp : ■emp ⊣⊢ emp.
+Proof. by rewrite /bi_bare (idemp bi_and). Qed.
+Lemma bare_or P Q : ■(P ∨ Q) ⊣⊢ ■P ∨ ■Q.
+Proof. by rewrite /bi_bare and_or_l. Qed.
+Lemma bare_and P Q : ■(P ∧ Q) ⊣⊢ ■P ∧ ■Q.
+Proof.
+ rewrite /bi_bare -(comm _ P) (assoc _ (_ ∧ _)%I) -!(assoc _ P).
+ by rewrite idemp !assoc (comm _ P).
+Qed.
+Lemma bare_sep P Q : ■(P ∗ Q) ⊣⊢ ■P ∗ ■Q.
+Proof.
+ rewrite /bi_bare. apply (anti_symm _).
+ - rewrite -{1}(idemp bi_and emp%I) -assoc emp_and_sep_assoc_1.
+ by rewrite (comm bi_sep) emp_and_sep_assoc_1 comm.
+ - apply and_intro.
+ + by rewrite !and_elim_l right_id.
+ + by rewrite !and_elim_r.
+Qed.
+Lemma bare_forall {A} (Φ : A → PROP) : ■(∀ a, Φ a) ⊢ ∀ a, ■Φ a.
+Proof. apply forall_intro=> a. by rewrite (forall_elim a). Qed.
+Lemma bare_exist {A} (Φ : A → PROP) : ■(∃ a, Φ a) ⊣⊢ ∃ a, ■Φ a.
+Proof. by rewrite /bi_bare and_exist_l. Qed.
+
+Lemma bare_sep_l P Q : ■(P ∗ Q) ⊢ ■P.
+Proof.
+ rewrite /bi_bare. apply and_intro; auto.
+ by rewrite (comm _ P) emp_and_sep_assoc_1 {1}and_elim_l left_id.
+Qed.
+Lemma bare_sep_r P Q : ■(P ∗ Q) ⊢ ■Q.
+Proof. by rewrite (comm _ P) bare_sep_l. Qed.
+
+Lemma bare_True_emp : ■True ⊣⊢ ■emp.
+Proof. apply (anti_symm _); rewrite /bi_bare; auto. Qed.
+
+Lemma bare_and_l P Q : P ∧ ■Q ⊣⊢ ■(P ∧ Q).
+Proof. by rewrite /bi_bare !assoc (comm _ P). Qed.
+Lemma bare_and_r P Q : ■P ∧ Q ⊣⊢ ■(P ∧ Q).
+Proof. by rewrite /bi_bare assoc. Qed.
+
+(* Affine propositions *)
+Global Instance Affine_proper : Proper ((≡) ==> iff) (@Affine PROP).
+Proof. solve_proper. Qed.
+
+Global Instance emp_affine_l : Affine (emp%I : PROP).
+Proof. by rewrite /Affine. Qed.
+Global Instance and_affine_l P Q : Affine P → Affine (P ∧ Q).
+Proof. rewrite /Affine=> ->; auto. Qed.
+Global Instance and_affine_r P Q : Affine Q → Affine (P ∧ Q).
+Proof. rewrite /Affine=> ->; auto. Qed.
+Global Instance or_affine P Q : Affine P → Affine Q → Affine (P ∨ Q).
+Proof. rewrite /Affine=> -> ->; auto. Qed.
+Global Instance forall_affine `{Inhabited A} (Φ : A → PROP) :
+ (∀ x, Affine (Φ x)) → Affine (∀ x, Φ x).
+Proof. intros. rewrite /Affine (forall_elim inhabitant). apply: affine. Qed.
+Global Instance exist_affine {A} (Φ : A → PROP) :
+ (∀ x, Affine (Φ x)) → Affine (∃ x, Φ x).
+Proof. rewrite /Affine=> H. apply exist_elim=> a. by rewrite H. Qed.
+Global Instance sep_affine P Q : Affine P → Affine Q → Affine (P ∗ Q).
+Proof. rewrite /Affine=>-> ->. by rewrite left_id. Qed.
+
+Global Instance bare_affine P : Affine (â– P).
+Proof. rewrite /bi_bare. apply _. Qed.
+
+(* Absorbing propositions *)
+Global Instance Absorbing_proper : Proper ((≡) ==> iff) (@Absorbing PROP).
+Proof. intros P P' HP. apply base.forall_proper=> Q. by rewrite HP. Qed.
+
+Global Instance pure_absorbing φ : Absorbing (⌜φâŒ%I : PROP).
+Proof.
+ intros R. apply wand_elim_l', pure_elim'=> Hφ.
+ by apply wand_intro_l, pure_intro.
+Qed.
+Global Instance and_absorbing P Q : Absorbing P → Absorbing Q → Absorbing (P ∧ Q).
+Proof.
+ rewrite /Absorbing=> HP HQ R.
+ apply and_intro; [rewrite and_elim_l|rewrite and_elim_r]; auto.
+Qed.
+Global Instance or_absorbing P Q : Absorbing P → Absorbing Q → Absorbing (P ∨ Q).
+Proof. rewrite /Absorbing=> HP HQ R. by rewrite sep_or_r HP HQ. Qed.
+Global Instance forall_absorbing {A} (Φ : A → PROP) :
+ (∀ x, Absorbing (Φ x)) → Absorbing (∀ x, Φ x).
+Proof. rewrite /Absorbing=> ? R. rewrite sep_forall_r. auto using forall_mono. Qed.
+Global Instance exist_absorbing {A} (Φ : A → PROP) :
+ (∀ x, Absorbing (Φ x)) → Absorbing (∃ x, Φ x).
+Proof. rewrite /Absorbing=> ? R. rewrite sep_exist_r. auto using exist_mono. Qed.
+
+Global Instance internal_eq_absorbing {A : ofeT} (a b : A) :
+ Absorbing (a ≡ b : PROP)%I.
+Proof.
+ intros Q.
+ apply wand_elim_l', (internal_eq_rewrite' a b (λ b, Q -∗ a ≡ b)%I); auto.
+ by apply wand_intro_l, internal_eq_refl.
+Qed.
+
+Global Instance sep_absorbing P Q : Absorbing P → Absorbing (P ∗ Q).
+Proof. rewrite /Absorbing=> HP R. by rewrite -assoc -(comm _ R) assoc HP. Qed.
+Global Instance wand_absorbing P Q : Absorbing Q → Absorbing (P -∗ Q).
+Proof.
+ rewrite /Absorbing=> HP R. apply wand_intro_l. by rewrite assoc wand_elim_r.
+Qed.
+
+(* Properties of affine and absorbing propositions *)
+Lemma True_affine_all_affine P : Affine (True%I : PROP) → Affine P.
+Proof. rewrite /Affine=> <-; auto. Qed.
+Lemma emp_absorbing_all_absorbing P : Absorbing (emp%I : PROP) → Absorbing P.
+Proof. intros HQ R. by rewrite -(left_id emp%I _ R) HQ right_id. Qed.
+
+Lemma sep_elim_l P Q `{H : TCOr (Affine Q) (Absorbing P)} : P ∗ Q ⊢ P.
+Proof. destruct H. by rewrite (affine Q) right_id. by rewrite absorbing. Qed.
+Lemma sep_elim_r P Q `{H : TCOr (Affine P) (Absorbing Q)} : P ∗ Q ⊢ Q.
+Proof. by rewrite comm sep_elim_l. Qed.
+
+Lemma sep_and P Q `{TCOr (Affine P) (Absorbing Q), TCOr (Affine Q) (Absorbing P)} :
+ P ∗ Q ⊢ P ∧ Q.
+Proof. auto using and_intro, sep_elim_l, sep_elim_r. Qed.
+
+Lemma affine_bare P `{!Affine P} : ■P ⊣⊢ P.
+Proof. rewrite /bi_bare. apply (anti_symm _); auto. Qed.
+Lemma bare_intro P Q `{!Affine P} : (P ⊢ Q) → P ⊢ ■Q.
+Proof. intros <-. by rewrite affine_bare. Qed.
+
+Lemma emp_and P `{!Affine P} : emp ∧ P ⊣⊢ P.
+Proof. apply (anti_symm _); auto. Qed.
+Lemma and_emp P `{!Affine P} : P ∧ emp ⊣⊢ P.
+Proof. apply (anti_symm _); auto. Qed.
+Lemma emp_or P `{!Affine P} : emp ∨ P ⊣⊢ emp.
+Proof. apply (anti_symm _); auto. Qed.
+Lemma or_emp P `{!Affine P} : P ∨ emp ⊣⊢ emp.
+Proof. apply (anti_symm _); auto. Qed.
+
+Lemma True_sep P `{!Absorbing P} : True ∗ P ⊣⊢ P.
+Proof. apply (anti_symm _); auto using True_sep_2. by rewrite sep_elim_r. Qed.
+Lemma sep_True P `{!Absorbing P} : P ∗ True ⊣⊢ P.
+Proof. apply (anti_symm _); auto using sep_True_2. Qed.
+
+Section affine_bi.
+ Context `{AffineBI PROP}.
+
+ Global Instance affine_bi P : Absorbing P | 0.
+ Proof. intros Q. by rewrite (affine Q) right_id. Qed.
+
+ Lemma True_emp : True ⊣⊢ emp.
+ Proof. apply (anti_symm _); auto using affine. Qed.
+
+ Global Instance emp_and' : LeftId (⊣⊢) emp%I (@bi_and PROP).
+ Proof. intros P. by rewrite -True_emp left_id. Qed.
+ Global Instance and_emp' : RightId (⊣⊢) emp%I (@bi_and PROP).
+ Proof. intros P. by rewrite -True_emp right_id. Qed.
+
+ Global Instance True_sep' : LeftId (⊣⊢) True%I (@bi_sep PROP).
+ Proof. intros P. by rewrite True_emp left_id. Qed.
+ Global Instance sep_True' : RightId (⊣⊢) True%I (@bi_sep PROP).
+ Proof. intros P. by rewrite True_emp right_id. Qed.
+
+ Lemma impl_wand_1 P Q : (P → Q) ⊢ P -∗ Q.
+ Proof. apply wand_intro_l. by rewrite sep_and impl_elim_r. Qed.
+
+ Lemma decide_emp φ `{!Decision φ} (P : PROP) :
+ (if decide φ then P else emp) ⊣⊢ (⌜φ⌠→ P).
+ Proof.
+ destruct (decide _).
+ - by rewrite pure_True // True_impl.
+ - by rewrite pure_False // False_impl True_emp.
+ Qed.
+End affine_bi.
+
+(* Properties of the persistently modality *)
+Hint Resolve persistently_mono.
+Global Instance persistently_mono' : Proper ((⊢) ==> (⊢)) (@bi_persistently PROP).
+Proof. intros P Q; apply persistently_mono. Qed.
+Global Instance persistently_flip_mono' :
+ Proper (flip (⊢) ==> flip (⊢)) (@bi_persistently PROP).
+Proof. intros P Q; apply persistently_mono. Qed.
+Global Instance persistently_absorbing P : Absorbing (â–¡ P).
+Proof. rewrite /Absorbing=> R. apply persistently_absorbing. Qed.
+
+Lemma persistently_elim P : □ P ⊢ P ∗ True.
+Proof.
+ rewrite -(right_id True%I _ (â–¡ _)%I) -{1}(left_id emp%I _ True%I).
+ by rewrite persistently_and_sep_assoc_1 (comm bi_and) persistently_and_emp_elim.
+Qed.
+Lemma persistently_elim_absorbing P `{!Absorbing P} : □ P ⊢ P.
+Proof. by rewrite persistently_elim sep_elim_l. Qed.
+
+Lemma persistently_idemp_1 P : □ □ P ⊢ □ P.
+Proof. by rewrite persistently_elim persistently_absorbing. Qed.
+Lemma persistently_idemp P : □ □ P ⊣⊢ □ P.
+Proof.
+ apply (anti_symm _); auto using persistently_idemp_1, persistently_idemp_2.
+Qed.
+
+Lemma persistently_intro' P Q : (□ P ⊢ Q) → □ P ⊢ □ Q.
+Proof. intros <-. apply persistently_idemp_2. Qed.
+
+Lemma persistently_pure φ : â–¡ ⌜φ⌠⊣⊢ ⌜φâŒ.
+Proof.
+ apply (anti_symm _).
+ - by rewrite persistently_elim sep_elim_l.
+ - apply pure_elim'=> Hφ.
+ trans (∀ x : False, □ True : PROP)%I; [by apply forall_intro|].
+ rewrite persistently_forall_2. auto using persistently_mono, pure_intro.
+Qed.
+Lemma persistently_forall {A} (Ψ : A → PROP) : (□ ∀ a, Ψ a) ⊣⊢ (∀ a, □ Ψ a).
+Proof.
+ apply (anti_symm _); auto using persistently_forall_2.
+ apply forall_intro=> x. by rewrite (forall_elim x).
+Qed.
+Lemma persistently_exist {A} (Ψ : A → PROP) : (□ ∃ a, Ψ a) ⊣⊢ (∃ a, □ Ψ a).
+Proof.
+ apply (anti_symm _); auto using persistently_exist_1.
+ apply exist_elim=> x. by rewrite (exist_intro x).
+Qed.
+Lemma persistently_and P Q : □ (P ∧ Q) ⊣⊢ □ P ∧ □ Q.
+Proof. rewrite !and_alt persistently_forall. by apply forall_proper=> -[]. Qed.
+Lemma persistently_or P Q : □ (P ∨ Q) ⊣⊢ □ P ∨ □ Q.
+Proof. rewrite !or_alt persistently_exist. by apply exist_proper=> -[]. Qed.
+Lemma persistently_impl P Q : □ (P → Q) ⊢ □ P → □ Q.
+Proof.
+ apply impl_intro_l; rewrite -persistently_and.
+ apply persistently_mono, impl_elim with P; auto.
+Qed.
+
+Lemma persistently_internal_eq {A : ofeT} (a b : A) : □ (a ≡ b) ⊣⊢ a ≡ b.
+Proof.
+ apply (anti_symm (⊢)); auto using persistently_elim.
+ - rewrite persistently_elim. apply wand_elim_l'.
+ apply (internal_eq_rewrite' a b (λ b, True -∗ a ≡ b)%I); auto using wand_intro_l.
+ - apply (internal_eq_rewrite' a b (λ b, □ (a ≡ b))%I); auto.
+ rewrite -(internal_eq_refl emp%I a). apply persistently_emp_intro.
+Qed.
+
+Lemma persistently_sep_dup P : □ P ⊣⊢ □ P ∗ □ P.
+Proof.
+ apply (anti_symm _); last by eauto using sep_elim_l with typeclass_instances.
+ rewrite -{1}(idemp bi_and (â–¡ _)%I) -{2}(left_id emp%I _ (â–¡ _)%I).
+ by rewrite persistently_and_sep_assoc_1 and_elim_l.
+Qed.
+
+Lemma persistently_and_sep_assoc P Q R : □ P ∧ (Q ∗ R) ⊣⊢ (□ P ∧ Q) ∗ R.
+Proof.
+ apply (anti_symm (⊢)); auto using persistently_and_sep_assoc_1.
+ apply and_intro.
+ - by rewrite and_elim_l sep_elim_l.
+ - by rewrite and_elim_r.
+Qed.
+Lemma persistently_sep_elim_l P Q : □ (P ∗ Q) ⊢ □ P.
+Proof.
+ rewrite -(left_id True%I bi_and (â–¡ _)%I) (persistently_emp_intro True%I).
+ by rewrite -persistently_and (comm bi_sep) emp_and_sep_assoc_1 and_elim_l left_id.
+Qed.
+Lemma persistently_sep_elim_r P Q : □ (P ∗ Q) ⊢ □ Q.
+Proof. by rewrite comm persistently_sep_elim_l. Qed.
+
+Lemma persistently_and_sep_l_1 P Q : □ P ∧ Q ⊢ □ P ∗ Q.
+Proof.
+ by rewrite -{1}(left_id emp%I _ Q%I) persistently_and_sep_assoc and_elim_l.
+Qed.
+Lemma persistently_and_sep_r_1 P Q : P ∧ □ Q ⊢ P ∗ □ Q.
+Proof. by rewrite !(comm _ P) persistently_and_sep_l_1. Qed.
+
+Lemma persistently_True_emp : □ True ⊣⊢ □ emp.
+Proof. apply (anti_symm _); auto using persistently_emp_intro. Qed.
+Lemma persistently_and_sep P Q : □ (P ∧ Q) ⊣⊢ □ (P ∗ Q).
+Proof.
+ rewrite persistently_and. apply (anti_symm (⊢)).
+ - rewrite -{1}persistently_idemp -persistently_and -{1}(left_id emp%I _ Q%I).
+ by rewrite persistently_and_sep_assoc (comm bi_and) persistently_and_emp_elim.
+ - auto using persistently_sep_elim_l, persistently_sep_elim_r.
+Qed.
+
+Lemma and_sep_persistently P Q : □ P ∧ □ Q ⊣⊢ □ P ∗ □ Q.
+Proof.
+ apply (anti_symm _).
+ - auto using persistently_and_sep_l_1.
+ - eauto 10 using sep_elim_l, sep_elim_r with typeclass_instances.
+Qed.
+Lemma persistently_sep P Q : □ (P ∗ Q) ⊣⊢ □ P ∗ □ Q.
+Proof. by rewrite -persistently_and_sep persistently_and -and_sep_persistently. Qed.
+
+Lemma persistently_wand P Q : □ (P -∗ Q) ⊢ □ P -∗ □ Q.
+Proof. by apply wand_intro_r; rewrite -persistently_sep wand_elim_l. Qed.
+
+Lemma persistently_entails_l P Q : (P ⊢ □ Q) → P ⊢ □ Q ∗ P.
+Proof. intros; rewrite -persistently_and_sep_l_1; auto. Qed.
+Lemma persistently_entails_r P Q : (P ⊢ □ Q) → P ⊢ P ∗ □ Q.
+Proof. intros; rewrite -persistently_and_sep_r_1; auto. Qed.
+
+Lemma persistently_impl_wand_2 P Q : □ (P -∗ Q) ⊢ □ (P → Q).
+Proof.
+ apply persistently_intro', impl_intro_r.
+ rewrite -{2}(left_id emp%I _ P%I) persistently_and_sep_assoc.
+ by rewrite (comm bi_and) persistently_and_emp_elim wand_elim_l.
+Qed.
+
+Section persistently_bare_bi.
+ Context `{AffineBI PROP}.
+
+ Lemma persistently_emp : □ emp ⊣⊢ emp.
+ Proof. by rewrite -!True_emp persistently_pure. Qed.
+
+ Lemma persistently_and_sep_l P Q : □ P ∧ Q ⊣⊢ □ P ∗ Q.
+ Proof.
+ apply (anti_symm (⊢));
+ eauto using persistently_and_sep_l_1, sep_and with typeclass_instances.
+ Qed.
+ Lemma persistently_and_sep_r P Q : P ∧ □ Q ⊣⊢ P ∗ □ Q.
+ Proof. by rewrite !(comm _ P) persistently_and_sep_l. Qed.
+
+ Lemma persistently_impl_wand P Q : □ (P → Q) ⊣⊢ □ (P -∗ Q).
+ Proof.
+ apply (anti_symm (⊢)); auto using persistently_impl_wand_2.
+ apply persistently_intro', wand_intro_l.
+ by rewrite -persistently_and_sep_r persistently_elim_absorbing impl_elim_r.
+ Qed.
+
+ Lemma wand_alt P Q : (P -∗ Q) ⊣⊢ ∃ R, R ∗ □ (P ∗ R → Q).
+ Proof.
+ apply (anti_symm (⊢)).
+ - rewrite -(right_id True%I bi_sep (P -∗ Q)%I) -(exist_intro (P -∗ Q)%I).
+ apply sep_mono_r. rewrite -persistently_pure.
+ apply persistently_intro', impl_intro_l.
+ by rewrite wand_elim_r persistently_pure right_id.
+ - apply exist_elim=> R. apply wand_intro_l.
+ rewrite assoc -persistently_and_sep_r.
+ by rewrite persistently_elim_absorbing impl_elim_r.
+ Qed.
+ Lemma impl_alt P Q : (P → Q) ⊣⊢ ∃ R, R ∧ □ (P ∧ R -∗ Q).
+ Proof.
+ apply (anti_symm (⊢)).
+ - rewrite -(right_id True%I bi_and (P → Q)%I) -(exist_intro (P → Q)%I).
+ apply and_mono_r. rewrite -persistently_pure.
+ apply persistently_intro', wand_intro_l.
+ by rewrite impl_elim_r persistently_pure right_id.
+ - apply exist_elim=> R. apply impl_intro_l.
+ rewrite assoc persistently_and_sep_r.
+ by rewrite persistently_elim_absorbing wand_elim_r.
+ Qed.
+End persistently_bare_bi.
+
+(* The combined bare persistently modality *)
+Lemma persistently_bare P : □ ■P ⊣⊢ □ P.
+Proof.
+ by rewrite /bi_bare persistently_and -persistently_True_emp
+ persistently_pure left_id.
+Qed.
+
+Lemma bare_persistently_elim P : ⬕ P ⊢ P.
+Proof. apply persistently_and_emp_elim. Qed.
+Lemma bare_persistently_intro' P Q : (⬕ P ⊢ Q) → ⬕ P ⊢ ⬕ Q.
+Proof. intros <-. by rewrite persistently_bare persistently_idemp. Qed.
+
+Lemma bare_persistently_emp : ⬕ emp ⊣⊢ emp.
+Proof.
+ by rewrite -persistently_True_emp persistently_pure bare_True_emp bare_emp.
+Qed.
+Lemma bare_persistently_and P Q : ⬕ (P ∧ Q) ⊣⊢ ⬕ P ∧ ⬕ Q.
+Proof. by rewrite persistently_and bare_and. Qed.
+Lemma bare_persistently_or P Q : ⬕ (P ∨ Q) ⊣⊢ ⬕ P ∨ ⬕ Q.
+Proof. by rewrite persistently_or bare_or. Qed.
+Lemma bare_persistently_exist {A} (Φ : A → PROP) : ⬕ (∃ x, Φ x) ⊣⊢ ∃ x, ⬕ Φ x.
+Proof. by rewrite persistently_exist bare_exist. Qed.
+Lemma bare_persistently_sep P Q : ⬕ (P ∗ Q) ⊣⊢ ⬕ P ∗ ⬕ Q.
+Proof. by rewrite persistently_sep bare_sep. Qed.
+
+Lemma bare_persistently_idemp P : ⬕ ⬕ P ⊣⊢ ⬕ P.
+Proof. by rewrite persistently_bare persistently_idemp. Qed.
+
+Lemma bare_persistently_sep_dup P : ⬕ P ⊣⊢ ⬕ P ∗ ⬕ P.
+Proof. by rewrite {1}persistently_sep_dup bare_sep. Qed.
+
+Lemma persistently_and_bare_sep_l P Q : □ P ∧ Q ⊣⊢ ⬕ P ∗ Q.
+Proof.
+ apply (anti_symm _).
+ - by rewrite /bi_bare -(comm bi_and (â–¡ P)%I) -persistently_and_sep_assoc left_id.
+ - apply and_intro. by rewrite bare_elim sep_elim_l. by rewrite sep_elim_r.
+Qed.
+Lemma persistently_and_bare_sep_r P Q : P ∧ □ Q ⊣⊢ P ∗ ⬕ Q.
+Proof. by rewrite !(comm _ P) persistently_and_bare_sep_l. Qed.
+
+(* Conditional bare modality *)
+Global Instance bare_if_ne p : NonExpansive (@bi_bare_if PROP p).
+Proof. solve_proper. Qed.
+Global Instance bare_if_proper p : Proper ((⊣⊢) ==> (⊣⊢)) (@bi_bare_if PROP p).
+Proof. solve_proper. Qed.
+Global Instance bare_if_mono' p : Proper ((⊢) ==> (⊢)) (@bi_bare_if PROP p).
+Proof. solve_proper. Qed.
+Global Instance bare_if_flip_mono' p :
+ Proper (flip (⊢) ==> flip (⊢)) (@bi_bare_if PROP p).
+Proof. solve_proper. Qed.
+
+Lemma bare_if_mono p P Q : (P ⊢ Q) → ■?p P ⊢ ■?p Q.
+Proof. by intros ->. Qed.
+
+Lemma bare_if_elim p P : ■?p P ⊢ P.
+Proof. destruct p; simpl; auto using bare_elim. Qed.
+Lemma bare_bare_if p P : ■P ⊢ ■?p P.
+Proof. destruct p; simpl; auto using bare_elim. Qed.
+Lemma bare_if_intro' p P Q : (■?p P ⊢ Q) → ■?p P ⊢ ■?p Q.
+Proof. destruct p; simpl; auto using bare_intro'. Qed.
+
+Lemma bare_if_emp p : ■?p emp ⊣⊢ emp.
+Proof. destruct p; simpl; auto using bare_emp. Qed.
+Lemma bare_if_and p P Q : ■?p (P ∧ Q) ⊣⊢ ■?p P ∧ ■?p Q.
+Proof. destruct p; simpl; auto using bare_and. Qed.
+Lemma bare_if_or p P Q : ■?p (P ∨ Q) ⊣⊢ ■?p P ∨ ■?p Q.
+Proof. destruct p; simpl; auto using bare_or. Qed.
+Lemma bare_if_exist {A} p (Ψ : A → PROP) : (■?p ∃ a, Ψ a) ⊣⊢ ∃ a, ■?p Ψ a.
+Proof. destruct p; simpl; auto using bare_exist. Qed.
+Lemma bare_if_sep p P Q : ■?p (P ∗ Q) ⊣⊢ ■?p P ∗ ■?p Q.
+Proof. destruct p; simpl; auto using bare_sep. Qed.
+
+Lemma bare_if_idemp p P : ■?p ■?p P ⊣⊢ ■?p P.
+Proof. destruct p; simpl; auto using bare_idemp. Qed.
+
+(* Conditional persistently *)
+Global Instance persistently_if_ne p : NonExpansive (@bi_persistently_if PROP p).
+Proof. solve_proper. Qed.
+Global Instance persistently_if_proper p :
+ Proper ((⊣⊢) ==> (⊣⊢)) (@bi_persistently_if PROP p).
+Proof. solve_proper. Qed.
+Global Instance persistently_if_mono' p :
+ Proper ((⊢) ==> (⊢)) (@bi_persistently_if PROP p).
+Proof. solve_proper. Qed.
+Global Instance persistently_if_flip_mono' p :
+ Proper (flip (⊢) ==> flip (⊢)) (@bi_persistently_if PROP p).
+Proof. solve_proper. Qed.
+
+Lemma persistently_if_mono p P Q : (P ⊢ Q) → ⬕?p P ⊢ ⬕?p Q.
+Proof. by intros ->. Qed.
+
+Lemma persistently_if_pure p φ : â–¡?p ⌜φ⌠⊣⊢ ⌜φâŒ.
+Proof. destruct p; simpl; auto using persistently_pure. Qed.
+Lemma persistently_if_and p P Q : □?p (P ∧ Q) ⊣⊢ □?p P ∧ □?p Q.
+Proof. destruct p; simpl; auto using persistently_and. Qed.
+Lemma persistently_if_or p P Q : □?p (P ∨ Q) ⊣⊢ □?p P ∨ □?p Q.
+Proof. destruct p; simpl; auto using persistently_or. Qed.
+Lemma persistently_if_exist {A} p (Ψ : A → PROP) : (□?p ∃ a, Ψ a) ⊣⊢ ∃ a, □?p Ψ a.
+Proof. destruct p; simpl; auto using persistently_exist. Qed.
+Lemma persistently_if_sep p P Q : □?p (P ∗ Q) ⊣⊢ □?p P ∗ □?p Q.
+Proof. destruct p; simpl; auto using persistently_sep. Qed.
+
+Lemma persistently_if_idemp p P : □?p □?p P ⊣⊢ □?p P.
+Proof. destruct p; simpl; auto using persistently_idemp. Qed.
+
+(* Conditional bare persistently *)
+Lemma bare_persistently_if_mono p P Q : (P ⊢ Q) → ⬕?p P ⊢ ⬕?p Q.
+Proof. by intros ->. Qed.
+
+Lemma bare_persistently_if_elim p P : ⬕?p P ⊢ P.
+Proof. destruct p; simpl; auto using bare_persistently_elim. Qed.
+Lemma bare_persistently_bare_persistently_if p P : ⬕ P ⊢ ⬕?p P.
+Proof. destruct p; simpl; auto using bare_persistently_elim. Qed.
+Lemma bare_persistently_if_intro' p P Q : (⬕?p P ⊢ Q) → ⬕?p P ⊢ ⬕?p Q.
+Proof. destruct p; simpl; auto using bare_persistently_intro'. Qed.
+
+Lemma bare_persistently_if_emp p : ⬕?p emp ⊣⊢ emp.
+Proof. destruct p; simpl; auto using bare_persistently_emp. Qed.
+Lemma bare_persistently_if_and p P Q : ⬕?p (P ∧ Q) ⊣⊢ ⬕?p P ∧ ⬕?p Q.
+Proof. destruct p; simpl; auto using bare_persistently_and. Qed.
+Lemma bare_persistently_if_or p P Q : ⬕?p (P ∨ Q) ⊣⊢ ⬕?p P ∨ ⬕?p Q.
+Proof. destruct p; simpl; auto using bare_persistently_or. Qed.
+Lemma bare_persistently_if_exist {A} p (Ψ : A → PROP) :
+ (⬕?p ∃ a, Ψ a) ⊣⊢ ∃ a, ⬕?p Ψ a.
+Proof. destruct p; simpl; auto using bare_persistently_exist. Qed.
+Lemma bare_persistently_if_sep p P Q : ⬕?p (P ∗ Q) ⊣⊢ ⬕?p P ∗ ⬕?p Q.
+Proof. destruct p; simpl; auto using bare_persistently_sep. Qed.
+
+Lemma bare_persistently_if_idemp p P : ⬕?p ⬕?p P ⊣⊢ ⬕?p P.
+Proof. destruct p; simpl; auto using bare_persistently_idemp. Qed.
+
+(* Persistence *)
+Global Instance Persistent_proper : Proper ((≡) ==> iff) (@Persistent PROP).
+Proof. solve_proper. Qed.
+Lemma persistent_absorbing P : Persistent P → Absorbing P.
+Proof. rewrite /Persistent=> <-. apply _. Qed.
+Hint Immediate persistent_absorbing : typeclass_instances.
+
+Global Instance pure_persistent φ : Persistent (⌜φâŒ%I : PROP).
+Proof. by rewrite /Persistent persistently_pure. Qed.
+Global Instance emp_persistent `{AffineBI PROP} : Persistent (emp%I : PROP).
+Proof. rewrite -True_emp. apply _. Qed.
+Global Instance persistently_persistent P : Persistent (â–¡ P).
+Proof. apply persistently_idemp. Qed.
+Global Instance and_persistent P Q :
+ Persistent P → Persistent Q → Persistent (P ∧ Q).
+Proof. intros. by rewrite /Persistent persistently_and !persistent. Qed.
+Global Instance or_persistent P Q :
+ Persistent P → Persistent Q → Persistent (P ∨ Q).
+Proof. intros. by rewrite /Persistent persistently_or !persistent. Qed.
+Global Instance forall_persistent {A} (Ψ : A → PROP) :
+ (∀ x, Persistent (Ψ x)) → Persistent (∀ x, Ψ x).
+Proof.
+ intros. rewrite /Persistent persistently_forall.
+ apply forall_proper=> x. by rewrite !persistent.
+Qed.
+Global Instance exist_persistent {A} (Ψ : A → PROP) :
+ (∀ x, Persistent (Ψ x)) → Persistent (∃ x, Ψ x).
+Proof.
+ intros. rewrite /Persistent persistently_exist.
+ apply exist_proper=> x. by rewrite !persistent.
+Qed.
+
+Global Instance internal_eq_persistent {A : ofeT} (a b : A) :
+ Persistent (a ≡ b : PROP)%I.
+Proof. by intros; rewrite /Persistent persistently_internal_eq. Qed.
+
+Global Instance pure_impl_persistent φ Q : Persistent Q → Persistent (⌜φ⌠→ Q).
+Proof. rewrite pure_impl_forall. apply _. Qed.
+Global Instance pure_wand_persistent φ Q : Persistent Q → Persistent (⌜φ⌠-∗ Q).
+Proof. intros. rewrite pure_wand_forall. apply _. Qed.
+
+Global Instance sep_persistent P Q :
+ Persistent P → Persistent Q → Persistent (P ∗ Q).
+Proof. intros. by rewrite /Persistent persistently_sep !persistent. Qed.
+
+Global Instance from_option_persistent {A} P (Ψ : A → PROP) (mx : option A) :
+ (∀ x, Persistent (Ψ x)) → Persistent P → Persistent (from_option Ψ P mx).
+Proof. destruct mx; apply _. Qed.
+
+(* Properties of persistent propositions *)
+Lemma persistent_persistently P `{!Persistent P} : □ P ⊣⊢ P.
+Proof. by rewrite persistent. Qed.
+
+Lemma persistently_intro P Q `{!Persistent P} : (P ⊢ Q) → P ⊢ □ Q.
+Proof. rewrite -(persistent_persistently P); apply persistently_intro'. Qed.
+
+Lemma persistent_and_sep_l_1 P Q `{!Persistent P} : P ∧ Q ⊢ P ∗ Q.
+Proof. by rewrite -(persistent_persistently P) persistently_and_sep_l_1. Qed.
+Lemma persistent_and_sep_r_1 P Q `{!Persistent Q} : P ∧ Q ⊢ P ∗ Q.
+Proof. by rewrite -(persistent_persistently Q) persistently_and_sep_r_1. Qed.
+Lemma persistent_sep_and P Q `{!Persistent P, !Persistent Q} : P ∗ Q ⊣⊢ P ∧ Q.
+Proof.
+ by rewrite -(persistent_persistently P) -(persistent_persistently Q)
+ -and_sep_persistently.
+Qed.
+
+Lemma persistent_sep_dup P `{!Persistent P} : P ⊣⊢ P ∗ P.
+Proof. by rewrite -(persistent_persistently P) -persistently_sep_dup. Qed.
+
+Lemma persistent_entails_l P Q `{!Persistent Q} : (P ⊢ Q) → P ⊢ Q ∗ P.
+Proof. by rewrite -(persistent_persistently Q); apply persistently_entails_l. Qed.
+Lemma persistent_entails_r P Q `{!Persistent Q} : (P ⊢ Q) → P ⊢ P ∗ Q.
+Proof. by rewrite -(persistent_persistently Q); apply persistently_entails_r. Qed.
+
+Lemma persistent_and_sep_assoc P `{!Persistent P} Q R :
+ P ∧ (Q ∗ R) ⊣⊢ (P ∧ Q) ∗ R.
+Proof. by rewrite -(persistent P) persistently_and_sep_assoc. Qed.
+
+Lemma impl_wand_2 P `{!Persistent P} Q : (P -∗ Q) ⊢ P → Q.
+Proof. apply impl_intro_l. by rewrite persistent_and_sep_l_1 wand_elim_r. Qed.
+
+Lemma persistent_and_bare_sep_l P Q `{!Persistent P} : P ∧ Q ⊣⊢ ■P ∗ Q.
+Proof. by rewrite -(persistent_persistently P) persistently_and_bare_sep_l. Qed.
+Lemma persistent_and_bare_sep_r P Q `{!Persistent Q} : P ∧ Q ⊣⊢ P ∗ ■Q.
+Proof. by rewrite -(persistent_persistently Q) persistently_and_bare_sep_r. Qed.
+
+Section persistent_bi_absorbing.
+ Context `{AffineBI PROP}.
+
+ Lemma persistent_and_sep_l P Q `{!Persistent P} : P ∧ Q ⊣⊢ P ∗ Q.
+ Proof. by rewrite -(persistent_persistently P) persistently_and_sep_l. Qed.
+ Lemma persistent_and_sep_r P Q `{!Persistent Q} : P ∧ Q ⊣⊢ P ∗ Q.
+ Proof. by rewrite -(persistent_persistently Q) persistently_and_sep_r. Qed.
+
+ Lemma impl_wand P `{!Persistent P} Q : (P → Q) ⊣⊢ (P -∗ Q).
+ Proof. apply (anti_symm _); auto using impl_wand_1, impl_wand_2. Qed.
+End persistent_bi_absorbing.
+
+(* For big ops *)
+Global Instance bi_and_monoid : Monoid (@bi_and PROP) :=
+ {| monoid_unit := True%I |}.
+Global Instance bi_or_monoid : Monoid (@bi_or PROP) :=
+ {| monoid_unit := False%I |}.
+Global Instance bi_sep_monoid : Monoid (@bi_sep PROP) :=
+ {| monoid_unit := emp%I |}.
+
+Global Instance bi_persistently_and_homomorphism :
+ WeakMonoidHomomorphism bi_and bi_and (≡) (@bi_persistently PROP).
+Proof. split; try apply _. apply persistently_and. Qed.
+
+Global Instance bi_persistently_or_homomorphism :
+ MonoidHomomorphism bi_or bi_or (≡) (@bi_persistently PROP).
+Proof. split; [split|]; try apply _. apply persistently_or. apply persistently_pure. Qed.
+
+Global Instance bi_persistently_sep_weak_homomorphism :
+ WeakMonoidHomomorphism bi_sep bi_sep (≡) (@bi_persistently PROP).
+Proof. split; try apply _. apply persistently_sep. Qed.
+
+Global Instance bi_persistently_sep_homomorphism `{AffineBI PROP} :
+ MonoidHomomorphism bi_sep bi_sep (≡) (@bi_persistently PROP).
+Proof. split. apply _. apply persistently_emp. Qed.
+
+Global Instance bi_persistently_sep_entails_weak_homomorphism :
+ WeakMonoidHomomorphism bi_sep bi_sep (flip (⊢)) (@bi_persistently PROP).
+Proof. split; try apply _. intros P Q; by rewrite persistently_sep. Qed.
+
+Global Instance bi_persistently_sep_entails_homomorphism :
+ MonoidHomomorphism bi_sep bi_sep (flip (⊢)) (@bi_persistently PROP).
+Proof. split. apply _. simpl. apply persistently_emp_intro. Qed.
+
+(* Heterogeneous lists *)
+Lemma hexist_exist {As B} (f : himpl As B) (Φ : B → PROP) :
+ bi_hexist (hcompose Φ f) ⊣⊢ ∃ xs : hlist As, Φ (f xs).
+Proof.
+ apply (anti_symm _).
+ - induction As as [|A As IH]; simpl.
+ + by rewrite -(exist_intro hnil) .
+ + apply exist_elim=> x; rewrite IH; apply exist_elim=> xs.
+ by rewrite -(exist_intro (hcons x xs)).
+ - apply exist_elim=> xs; induction xs as [|A As x xs IH]; simpl; auto.
+ by rewrite -(exist_intro x) IH.
+Qed.
+
+Lemma hforall_forall {As B} (f : himpl As B) (Φ : B → PROP) :
+ bi_hforall (hcompose Φ f) ⊣⊢ ∀ xs : hlist As, Φ (f xs).
+Proof.
+ apply (anti_symm _).
+ - apply forall_intro=> xs; induction xs as [|A As x xs IH]; simpl; auto.
+ by rewrite (forall_elim x) IH.
+ - induction As as [|A As IH]; simpl.
+ + by rewrite (forall_elim hnil) .
+ + apply forall_intro=> x; rewrite -IH; apply forall_intro=> xs.
+ by rewrite (forall_elim (hcons x xs)).
+Qed.
+End bi_derived.
+
+Hint Immediate persistent_absorbing : typeclass_instances.
+
+Section sbi_derived.
+Context {PROP : sbi}.
+Implicit Types φ : Prop.
+Implicit Types P Q R : PROP.
+Implicit Types Ps : list PROP.
+Implicit Types A : Type.
+
+(* Force implicit argument PROP *)
+Notation "P ⊢ Q" := (@bi_entails PROP P%I Q%I).
+Notation "P ⊣⊢ Q" := (equiv (A:=bi_car PROP) P%I Q%I).
+
+Hint Resolve or_elim or_intro_l' or_intro_r' True_intro False_elim.
+Hint Resolve and_elim_l' and_elim_r' and_intro forall_intro.
+
+Global Instance later_proper' :
+ Proper ((⊣⊢) ==> (⊣⊢)) (@bi_later PROP) := ne_proper _.
+
+(* Equality *)
+Lemma internal_eq_rewrite_contractive' {A : ofeT} a b (Ψ : A → PROP) P
+ {HΨ : Contractive Ψ} : (P ⊢ ▷ (a ≡ b)) → (P ⊢ Ψ a) → P ⊢ Ψ b.
+Proof.
+ rewrite later_eq_2. move: HΨ=>/contractive_alt [g [? HΨ]]. rewrite !HΨ.
+ by apply internal_eq_rewrite'.
+Qed.
+
+Lemma later_equivI {A : ofeT} (x y : A) : Next x ≡ Next y ⊣⊢ ▷ (x ≡ y).
+Proof. apply (anti_symm _); auto using later_eq_1, later_eq_2. Qed.
+
+(* Later derived *)
+Lemma later_proper P Q : (P ⊣⊢ Q) → ▷ P ⊣⊢ ▷ Q.
+Proof. by intros ->. Qed.
+Hint Resolve later_mono later_proper.
+Global Instance later_mono' : Proper ((⊢) ==> (⊢)) (@bi_later PROP).
+Proof. intros P Q; apply later_mono. Qed.
+Global Instance later_flip_mono' :
+ Proper (flip (⊢) ==> flip (⊢)) (@bi_later PROP).
+Proof. intros P Q; apply later_mono. Qed.
+
+Lemma later_intro P : P ⊢ ▷ P.
+Proof.
+ rewrite -(and_elim_l (▷ P)%I P) -(löb (▷ P ∧ P)%I).
+ apply impl_intro_l. by rewrite {1}(and_elim_r (â–· P)%I).
+Qed.
+
+Lemma later_True : ▷ True ⊣⊢ True.
+Proof. apply (anti_symm (⊢)); auto using later_intro. Qed.
+Lemma later_emp `{!AffineBI PROP} : ▷ emp ⊣⊢ emp.
+Proof. by rewrite -True_emp later_True. Qed.
+Lemma later_forall {A} (Φ : A → PROP) : (▷ ∀ a, Φ a) ⊣⊢ (∀ a, ▷ Φ a).
+Proof.
+ apply (anti_symm _); auto using later_forall_2.
+ apply forall_intro=> x. by rewrite (forall_elim x).
+Qed.
+Lemma later_exist_2 {A} (Φ : A → PROP) : (∃ a, ▷ Φ a) ⊢ ▷ (∃ a, Φ a).
+Proof. apply exist_elim; eauto using exist_intro. Qed.
+Lemma later_exist `{Inhabited A} (Φ : A → PROP) : ▷ (∃ a, Φ a) ⊣⊢ (∃ a, ▷ Φ a).
+Proof.
+ apply: anti_symm; [|apply later_exist_2].
+ rewrite later_exist_false. apply or_elim; last done.
+ rewrite -(exist_intro inhabitant); auto.
+Qed.
+Lemma later_and P Q : ▷ (P ∧ Q) ⊣⊢ ▷ P ∧ ▷ Q.
+Proof. rewrite !and_alt later_forall. by apply forall_proper=> -[]. Qed.
+Lemma later_or P Q : ▷ (P ∨ Q) ⊣⊢ ▷ P ∨ ▷ Q.
+Proof. rewrite !or_alt later_exist. by apply exist_proper=> -[]. Qed.
+Lemma later_impl P Q : ▷ (P → Q) ⊢ ▷ P → ▷ Q.
+Proof. apply impl_intro_l. by rewrite -later_and impl_elim_r. Qed.
+Lemma later_sep P Q : ▷ (P ∗ Q) ⊣⊢ ▷ P ∗ ▷ Q.
+Proof. apply (anti_symm _); auto using later_sep_1, later_sep_2. Qed.
+Lemma later_wand P Q : ▷ (P -∗ Q) ⊢ ▷ P -∗ ▷ Q.
+Proof. apply wand_intro_l. by rewrite -later_sep wand_elim_r. Qed.
+Lemma later_iff P Q : ▷ (P ↔ Q) ⊢ ▷ P ↔ ▷ Q.
+Proof. by rewrite /bi_iff later_and !later_impl. Qed.
+Lemma later_persistently P : ▷ □ P ⊣⊢ □ ▷ P.
+Proof.
+ apply (anti_symm _); auto using later_persistently_1, later_persistently_2.
+Qed.
+Lemma bare_later P : ■▷ P ⊢ ▷ ■P.
+Proof. rewrite /bi_bare later_and. auto using later_intro. Qed.
+Lemma bare_persistently_later P : ⬕ ▷ P ⊢ ▷ ⬕ P.
+Proof. by rewrite -later_persistently bare_later. Qed.
+Lemma bare_persistently_if_later p P : ⬕?p ▷ P ⊢ ▷ ⬕?p P.
+Proof. destruct p; simpl; auto using bare_persistently_later. Qed.
+
+Global Instance later_persistent P : Persistent P → Persistent (▷ P).
+Proof. intros. by rewrite /Persistent -later_persistently persistent. Qed.
+Global Instance later_absorbing P : Absorbing P → Absorbing (▷ P).
+Proof. intros ? Q. by rewrite {1}(later_intro Q) -later_sep absorbing. Qed.
+
+(* Iterated later modality *)
+Global Instance laterN_ne m : NonExpansive (@bi_laterN PROP m).
+Proof. induction m; simpl. by intros ???. solve_proper. Qed.
+Global Instance laterN_proper m :
+ Proper ((⊣⊢) ==> (⊣⊢)) (@bi_laterN PROP m) := ne_proper _.
+
+Lemma laterN_0 P : ▷^0 P ⊣⊢ P.
+Proof. done. Qed.
+Lemma later_laterN n P : ▷^(S n) P ⊣⊢ ▷ ▷^n P.
+Proof. done. Qed.
+Lemma laterN_later n P : ▷^(S n) P ⊣⊢ ▷^n ▷ P.
+Proof. induction n; simpl; auto. Qed.
+Lemma laterN_plus n1 n2 P : ▷^(n1 + n2) P ⊣⊢ ▷^n1 ▷^n2 P.
+Proof. induction n1; simpl; auto. Qed.
+Lemma laterN_le n1 n2 P : n1 ≤ n2 → ▷^n1 P ⊢ ▷^n2 P.
+Proof. induction 1; simpl; by rewrite -?later_intro. Qed.
+
+Lemma laterN_mono n P Q : (P ⊢ Q) → ▷^n P ⊢ ▷^n Q.
+Proof. induction n; simpl; auto. Qed.
+Global Instance laterN_mono' n : Proper ((⊢) ==> (⊢)) (@bi_laterN PROP n).
+Proof. intros P Q; apply laterN_mono. Qed.
+Global Instance laterN_flip_mono' n :
+ Proper (flip (⊢) ==> flip (⊢)) (@bi_laterN PROP n).
+Proof. intros P Q; apply laterN_mono. Qed.
+
+Lemma laterN_intro n P : P ⊢ ▷^n P.
+Proof. induction n as [|n IH]; simpl; by rewrite -?later_intro. Qed.
+
+Lemma laterN_True n : ▷^n True ⊣⊢ True.
+Proof. apply (anti_symm (⊢)); auto using laterN_intro, True_intro. Qed.
+Lemma laterN_emp `{!AffineBI PROP} n : ▷^n emp ⊣⊢ emp.
+Proof. by rewrite -True_emp laterN_True. Qed.
+Lemma laterN_forall {A} n (Φ : A → PROP) : (▷^n ∀ a, Φ a) ⊣⊢ (∀ a, ▷^n Φ a).
+Proof. induction n as [|n IH]; simpl; rewrite -?later_forall; auto. Qed.
+Lemma laterN_exist_2 {A} n (Φ : A → PROP) : (∃ a, ▷^n Φ a) ⊢ ▷^n (∃ a, Φ a).
+Proof. apply exist_elim; eauto using exist_intro, laterN_mono. Qed.
+Lemma laterN_exist `{Inhabited A} n (Φ : A → PROP) :
+ (▷^n ∃ a, Φ a) ⊣⊢ ∃ a, ▷^n Φ a.
+Proof. induction n as [|n IH]; simpl; rewrite -?later_exist; auto. Qed.
+Lemma laterN_and n P Q : ▷^n (P ∧ Q) ⊣⊢ ▷^n P ∧ ▷^n Q.
+Proof. induction n as [|n IH]; simpl; rewrite -?later_and; auto. Qed.
+Lemma laterN_or n P Q : ▷^n (P ∨ Q) ⊣⊢ ▷^n P ∨ ▷^n Q.
+Proof. induction n as [|n IH]; simpl; rewrite -?later_or; auto. Qed.
+Lemma laterN_impl n P Q : ▷^n (P → Q) ⊢ ▷^n P → ▷^n Q.
+Proof. apply impl_intro_l. by rewrite -laterN_and impl_elim_r. Qed.
+Lemma laterN_sep n P Q : ▷^n (P ∗ Q) ⊣⊢ ▷^n P ∗ ▷^n Q.
+Proof. induction n as [|n IH]; simpl; rewrite -?later_sep; auto. Qed.
+Lemma laterN_wand n P Q : ▷^n (P -∗ Q) ⊢ ▷^n P -∗ ▷^n Q.
+Proof. apply wand_intro_l. by rewrite -laterN_sep wand_elim_r. Qed.
+Lemma laterN_iff n P Q : ▷^n (P ↔ Q) ⊢ ▷^n P ↔ ▷^n Q.
+Proof. by rewrite /bi_iff laterN_and !laterN_impl. Qed.
+Lemma laterN_persistently n P : ▷^n □ P ⊣⊢ □ ▷^n P.
+Proof. induction n as [|n IH]; simpl; auto. by rewrite IH later_persistently. Qed.
+Lemma bare_laterN n P : ■▷^n P ⊢ ▷^n ■P.
+Proof. rewrite /bi_bare laterN_and. auto using laterN_intro. Qed.
+Lemma bare_persistently_laterN n P : ⬕ ▷^n P ⊢ ▷^n ⬕ P.
+Proof. by rewrite -laterN_persistently bare_laterN. Qed.
+Lemma bare_persistently_if_laterN n p P : ⬕?p ▷^n P ⊢ ▷^n ⬕?p P.
+Proof. destruct p; simpl; auto using bare_persistently_laterN. Qed.
+
+Global Instance laterN_persistent n P : Persistent P → Persistent (▷^n P).
+Proof. induction n; apply _. Qed.
+Global Instance laterN_absorbing n P : Absorbing P → Absorbing (▷^n P).
+Proof. induction n; apply _. Qed.
+
+(* Except-0 *)
+Global Instance except_0_ne : NonExpansive (@bi_except_0 PROP).
+Proof. solve_proper. Qed.
+Global Instance except_0_proper : Proper ((⊣⊢) ==> (⊣⊢)) (@bi_except_0 PROP).
+Proof. solve_proper. Qed.
+Global Instance except_0_mono' : Proper ((⊢) ==> (⊢)) (@bi_except_0 PROP).
+Proof. solve_proper. Qed.
+Global Instance except_0_flip_mono' :
+ Proper (flip (⊢) ==> flip (⊢)) (@bi_except_0 PROP).
+Proof. solve_proper. Qed.
+
+Lemma except_0_intro P : P ⊢ ◇ P.
+Proof. rewrite /bi_except_0; auto. Qed.
+Lemma except_0_mono P Q : (P ⊢ Q) → ◇ P ⊢ ◇ Q.
+Proof. by intros ->. Qed.
+Lemma except_0_idemp P : ◇ ◇ P ⊣⊢ ◇ P.
+Proof. apply (anti_symm _); rewrite /bi_except_0; auto. Qed.
+
+Lemma except_0_True : ◇ True ⊣⊢ True.
+Proof. rewrite /bi_except_0. apply (anti_symm _); auto. Qed.
+Lemma except_0_emp `{!AffineBI PROP} : ◇ emp ⊣⊢ emp.
+Proof. by rewrite -True_emp except_0_True. Qed.
+Lemma except_0_or P Q : ◇ (P ∨ Q) ⊣⊢ ◇ P ∨ ◇ Q.
+Proof. rewrite /bi_except_0. apply (anti_symm _); auto. Qed.
+Lemma except_0_and P Q : ◇ (P ∧ Q) ⊣⊢ ◇ P ∧ ◇ Q.
+Proof. by rewrite /bi_except_0 or_and_l. Qed.
+Lemma except_0_sep P Q : ◇ (P ∗ Q) ⊣⊢ ◇ P ∗ ◇ Q.
+Proof.
+ rewrite /bi_except_0. apply (anti_symm _).
+ - apply or_elim; last by auto using sep_mono.
+ by rewrite -!or_intro_l -persistently_pure -later_sep -persistently_sep_dup.
+ - rewrite sep_or_r !sep_or_l {1}(later_intro P) {1}(later_intro Q).
+ rewrite -!later_sep !left_absorb right_absorb. auto.
+Qed.
+Lemma except_0_forall_1 {A} (Φ : A → PROP) : ◇ (∀ a, Φ a) ⊢ ∀ a, ◇ Φ a.
+Proof. apply forall_intro=> a. by rewrite (forall_elim a). Qed.
+Lemma except_0_exist_2 {A} (Φ : A → PROP) : (∃ a, ◇ Φ a) ⊢ ◇ ∃ a, Φ a.
+Proof. apply exist_elim=> a. by rewrite (exist_intro a). Qed.
+Lemma except_0_exist `{Inhabited A} (Φ : A → PROP) :
+ ◇ (∃ a, Φ a) ⊣⊢ (∃ a, ◇ Φ a).
+Proof.
+ apply (anti_symm _); [|by apply except_0_exist_2]. apply or_elim.
+ - rewrite -(exist_intro inhabitant). by apply or_intro_l.
+ - apply exist_mono=> a. apply except_0_intro.
+Qed.
+Lemma except_0_later P : ◇ ▷ P ⊢ ▷ P.
+Proof. by rewrite /bi_except_0 -later_or False_or. Qed.
+Lemma except_0_persistently P : ◇ □ P ⊣⊢ □ ◇ P.
+Proof.
+ by rewrite /bi_except_0 persistently_or -later_persistently persistently_pure.
+Qed.
+Lemma bare_except_0 P : ■◇ P ⊢ ◇ ■P.
+Proof. rewrite /bi_bare except_0_and. auto using except_0_intro. Qed.
+Lemma bare_persistently_except_0 P : ⬕ ◇ P ⊢ ◇ ⬕ P.
+Proof. by rewrite -except_0_persistently bare_except_0. Qed.
+Lemma bare_persistently_if_except_0 p P : ⬕?p ◇ P ⊢ ◇ ⬕?p P.
+Proof. destruct p; simpl; auto using bare_persistently_except_0. Qed.
+
+Lemma except_0_frame_l P Q : P ∗ ◇ Q ⊢ ◇ (P ∗ Q).
+Proof. by rewrite {1}(except_0_intro P) except_0_sep. Qed.
+Lemma except_0_frame_r P Q : ◇ P ∗ Q ⊢ ◇ (P ∗ Q).
+Proof. by rewrite {1}(except_0_intro Q) except_0_sep. Qed.
+
+(* Discrete instances *)
+Global Instance Timeless_proper : Proper ((≡) ==> iff) (@Timeless PROP).
+Proof. solve_proper. Qed.
+
+Global Instance emp_timeless : Timeless (emp : PROP)%I.
+Proof. apply later_emp_false. Qed.
+Global Instance pure_timeless φ : Timeless (⌜φ⌠: PROP)%I.
+Proof.
+ rewrite /Timeless /bi_except_0 pure_alt later_exist_false.
+ apply or_elim, exist_elim; [auto|]=> Hφ. rewrite -(exist_intro Hφ). auto.
+Qed.
+Global Instance and_timeless P Q : Timeless P → Timeless Q → Timeless (P ∧ Q).
+Proof. intros; rewrite /Timeless except_0_and later_and; auto. Qed.
+Global Instance or_timeless P Q : Timeless P → Timeless Q → Timeless (P ∨ Q).
+Proof. intros; rewrite /Timeless except_0_or later_or; auto. Qed.
+
+Global Instance impl_timeless P Q : Timeless Q → Timeless (P → Q).
+Proof.
+ rewrite /Timeless=> HQ. rewrite later_false_em.
+ apply or_mono, impl_intro_l; first done.
+ rewrite -{2}(löb Q); apply impl_intro_l.
+ rewrite HQ /bi_except_0 !and_or_r. apply or_elim; last auto.
+ by rewrite assoc (comm _ _ P) -assoc !impl_elim_r.
+Qed.
+Global Instance sep_timeless P Q: Timeless P → Timeless Q → Timeless (P ∗ Q).
+Proof.
+ intros; rewrite /Timeless except_0_sep later_sep; auto using sep_mono.
+Qed.
+
+Global Instance wand_timeless P Q : Timeless Q → Timeless (P -∗ Q).
+Proof.
+ rewrite /Timeless=> HQ. rewrite later_false_em.
+ apply or_mono, wand_intro_l; first done.
+ rewrite -{2}(löb Q); apply impl_intro_l.
+ rewrite HQ /bi_except_0 !and_or_r. apply or_elim; last auto.
+ by rewrite (comm _ P) persistent_and_sep_assoc impl_elim_r wand_elim_l.
+Qed.
+Global Instance forall_timeless {A} (Ψ : A → PROP) :
+ (∀ x, Timeless (Ψ x)) → Timeless (∀ x, Ψ x).
+Proof.
+ rewrite /Timeless=> HQ. rewrite later_false_em.
+ apply or_mono; first done. apply forall_intro=> x.
+ rewrite -(löb (Ψ x)); apply impl_intro_l.
+ rewrite HQ /bi_except_0 !and_or_r. apply or_elim; last auto.
+ by rewrite impl_elim_r (forall_elim x).
+Qed.
+Global Instance exist_timeless {A} (Ψ : A → PROP) :
+ (∀ x, Timeless (Ψ x)) → Timeless (∃ x, Ψ x).
+Proof.
+ rewrite /Timeless=> ?. rewrite later_exist_false. apply or_elim.
+ - rewrite /bi_except_0; auto.
+ - apply exist_elim=> x. rewrite -(exist_intro x); auto.
+Qed.
+Global Instance persistently_timeless P : Timeless P → Timeless (□ P).
+Proof.
+ intros; rewrite /Timeless.
+ rewrite /bi_except_0 later_persistently_1.
+ rewrite (timeless P) /bi_except_0 persistently_or {1}persistently_elim.
+ apply or_mono; last done. by rewrite sep_elim_l.
+Qed.
+
+Global Instance eq_timeless {A : ofeT} (a b : A) :
+ Discrete a → Timeless (a ≡ b : PROP)%I.
+Proof. intros. rewrite /Discrete !discrete_eq. apply (timeless _). Qed.
+Global Instance from_option_timeless {A} P (Ψ : A → PROP) (mx : option A) :
+ (∀ x, Timeless (Ψ x)) → Timeless P → Timeless (from_option Ψ P mx).
+Proof. destruct mx; apply _. Qed.
+
+(* Big op stuff *)
+Global Instance bi_later_monoid_and_homomorphism :
+ MonoidHomomorphism bi_and bi_and (≡) (@bi_later PROP).
+Proof. split; [split|]; try apply _. apply later_and. apply later_True. Qed.
+Global Instance bi_laterN_and_homomorphism n :
+ MonoidHomomorphism bi_and bi_and (≡) (@bi_laterN PROP n).
+Proof. split; [split|]; try apply _. apply laterN_and. apply laterN_True. Qed.
+Global Instance bi_except_0_and_homomorphism :
+ MonoidHomomorphism bi_and bi_and (≡) (@bi_except_0 PROP).
+Proof. split; [split|]; try apply _. apply except_0_and. apply except_0_True. Qed.
+
+Global Instance bi_later_monoid_or_homomorphism :
+ WeakMonoidHomomorphism bi_or bi_or (≡) (@bi_later PROP).
+Proof. split; try apply _. apply later_or. Qed.
+Global Instance bi_laterN_or_homomorphism n :
+ WeakMonoidHomomorphism bi_or bi_or (≡) (@bi_laterN PROP n).
+Proof. split; try apply _. apply laterN_or. Qed.
+Global Instance bi_except_0_or_homomorphism :
+ WeakMonoidHomomorphism bi_or bi_or (≡) (@bi_except_0 PROP).
+Proof. split; try apply _. apply except_0_or. Qed.
+
+Global Instance bi_later_monoid_sep_weak_homomorphism :
+ WeakMonoidHomomorphism bi_sep bi_sep (≡) (@bi_later PROP).
+Proof. split; try apply _. apply later_sep. Qed.
+Global Instance bi_laterN_sep_weak_homomorphism n :
+ WeakMonoidHomomorphism bi_sep bi_sep (≡) (@bi_laterN PROP n).
+Proof. split; try apply _. apply laterN_sep. Qed.
+Global Instance bi_except_0_sep_weak_homomorphism :
+ WeakMonoidHomomorphism bi_sep bi_sep (≡) (@bi_except_0 PROP).
+Proof. split; try apply _. apply except_0_sep. Qed.
+
+Global Instance bi_later_monoid_sep_homomorphism `{!AffineBI PROP} :
+ MonoidHomomorphism bi_sep bi_sep (≡) (@bi_later PROP).
+Proof. split; try apply _. apply later_emp. Qed.
+Global Instance bi_laterN_sep_homomorphism `{!AffineBI PROP} n :
+ MonoidHomomorphism bi_sep bi_sep (≡) (@bi_laterN PROP n).
+Proof. split; try apply _. apply laterN_emp. Qed.
+Global Instance bi_except_0_sep_homomorphism `{!AffineBI PROP} :
+ MonoidHomomorphism bi_sep bi_sep (≡) (@bi_except_0 PROP).
+Proof. split; try apply _. apply except_0_emp. Qed.
+
+Global Instance bi_later_monoid_sep_entails_weak_homomorphism :
+ WeakMonoidHomomorphism bi_sep bi_sep (flip (⊢)) (@bi_later PROP).
+Proof. split; try apply _. intros P Q. by rewrite later_sep. Qed.
+Global Instance bi_laterN_sep_entails_weak_homomorphism n :
+ WeakMonoidHomomorphism bi_sep bi_sep (flip (⊢)) (@bi_laterN PROP n).
+Proof. split; try apply _. intros P Q. by rewrite laterN_sep. Qed.
+Global Instance bi_except_0_sep_entails_weak_homomorphism :
+ WeakMonoidHomomorphism bi_sep bi_sep (flip (⊢)) (@bi_except_0 PROP).
+Proof. split; try apply _. intros P Q. by rewrite except_0_sep. Qed.
+
+Global Instance bi_later_monoid_sep_entails_homomorphism :
+ MonoidHomomorphism bi_sep bi_sep (flip (⊢)) (@bi_later PROP).
+Proof. split; try apply _. apply later_intro. Qed.
+Global Instance bi_laterN_sep_entails_homomorphism n :
+ MonoidHomomorphism bi_sep bi_sep (flip (⊢)) (@bi_laterN PROP n).
+Proof. split; try apply _. apply laterN_intro. Qed.
+Global Instance bi_except_0_sep_entails_homomorphism :
+ MonoidHomomorphism bi_sep bi_sep (flip (⊢)) (@bi_except_0 PROP).
+Proof. split; try apply _. apply except_0_intro. Qed.
+End sbi_derived.
+End bi.
diff --git a/theories/base_logic/lib/fractional.v b/theories/bi/fractional.v
similarity index 71%
rename from theories/base_logic/lib/fractional.v
rename to theories/bi/fractional.v
index 179eac0fc..4f21613ce 100644
--- a/theories/base_logic/lib/fractional.v
+++ b/theories/bi/fractional.v
@@ -1,15 +1,16 @@
-From stdpp Require Import gmap gmultiset.
-From iris.base_logic Require Export derived.
-From iris.base_logic Require Import big_op.
+From iris.bi Require Export bi.
From iris.proofmode Require Import classes class_instances.
Set Default Proof Using "Type".
-Class Fractional {M} (Φ : Qp → uPred M) :=
+Class Fractional {PROP : bi} (Φ : Qp → PROP) :=
fractional p q : Φ (p + q)%Qp ⊣⊢ Φ p ∗ Φ q.
-Class AsFractional {M} (P : uPred M) (Φ : Qp → uPred M) (q : Qp) := {
+Arguments Fractional {_} _%I : simpl never.
+
+Class AsFractional {PROP : bi} (P : PROP) (Φ : Qp → PROP) (q : Qp) := {
as_fractional : P ⊣⊢ Φ q;
as_fractional_fractional :> Fractional Φ
}.
+Arguments AsFractional {_} _%I _%I _%Qp.
Arguments fractional {_ _ _} _ _.
@@ -17,9 +18,9 @@ Hint Mode AsFractional - + - - : typeclass_instances.
Hint Mode AsFractional - - + + : typeclass_instances.
Section fractional.
- Context {M : ucmraT}.
- Implicit Types P Q : uPred M.
- Implicit Types Φ : Qp → uPred M.
+ Context {PROP : bi}.
+ Implicit Types P Q : PROP.
+ Implicit Types Φ : Qp → PROP.
Implicit Types q : Qp.
Lemma fractional_split P P1 P2 Φ q1 q2 :
@@ -33,7 +34,7 @@ Section fractional.
Lemma fractional_split_2 P P1 P2 Φ q1 q2 :
AsFractional P Φ (q1 + q2) → AsFractional P1 Φ q1 → AsFractional P2 Φ q2 →
P1 -∗ P2 -∗ P.
- Proof. intros. apply uPred.wand_intro_r. by rewrite -fractional_split. Qed.
+ Proof. intros. apply bi.wand_intro_r. by rewrite -fractional_split. Qed.
Lemma fractional_half P P12 Φ q :
AsFractional P Φ q → AsFractional P12 Φ (q/2) →
@@ -46,12 +47,12 @@ Section fractional.
Lemma fractional_half_2 P P12 Φ q :
AsFractional P Φ q → AsFractional P12 Φ (q/2) →
P12 -∗ P12 -∗ P.
- Proof. intros. apply uPred.wand_intro_r. by rewrite -fractional_half. Qed.
+ Proof. intros. apply bi.wand_intro_r. by rewrite -fractional_half. Qed.
(** Fractional and logical connectives *)
Global Instance persistent_fractional P :
Persistent P → Fractional (λ _, P).
- Proof. intros HP q q'. by apply uPred.sep_dup. Qed.
+ Proof. intros HP q q'. by apply bi.persistent_sep_dup. Qed.
Global Instance fractional_sep Φ Ψ :
Fractional Φ → Fractional Ψ → Fractional (λ q, Φ q ∗ Ψ q)%I.
@@ -62,22 +63,22 @@ Section fractional.
Global Instance fractional_big_sepL {A} l Ψ :
(∀ k (x : A), Fractional (Ψ k x)) →
- Fractional (M:=M) (λ q, [∗ list] k↦x ∈ l, Ψ k x q)%I.
+ Fractional (PROP:=PROP) (λ q, [∗ list] k↦x ∈ l, Ψ k x q)%I.
Proof. intros ? q q'. rewrite -big_opL_opL. by setoid_rewrite fractional. Qed.
Global Instance fractional_big_sepM `{Countable K} {A} (m : gmap K A) Ψ :
(∀ k (x : A), Fractional (Ψ k x)) →
- Fractional (M:=M) (λ q, [∗ map] k↦x ∈ m, Ψ k x q)%I.
+ Fractional (PROP:=PROP) (λ q, [∗ map] k↦x ∈ m, Ψ k x q)%I.
Proof. intros ? q q'. rewrite -big_opM_opM. by setoid_rewrite fractional. Qed.
Global Instance fractional_big_sepS `{Countable A} (X : gset A) Ψ :
(∀ x, Fractional (Ψ x)) →
- Fractional (M:=M) (λ q, [∗ set] x ∈ X, Ψ x q)%I.
+ Fractional (PROP:=PROP) (λ q, [∗ set] x ∈ X, Ψ x q)%I.
Proof. intros ? q q'. rewrite -big_opS_opS. by setoid_rewrite fractional. Qed.
Global Instance fractional_big_sepMS `{Countable A} (X : gmultiset A) Ψ :
(∀ x, Fractional (Ψ x)) →
- Fractional (M:=M) (λ q, [∗ mset] x ∈ X, Ψ x q)%I.
+ Fractional (PROP:=PROP) (λ q, [∗ mset] x ∈ X, Ψ x q)%I.
Proof. intros ? q q'. rewrite -big_opMS_opMS. by setoid_rewrite fractional. Qed.
(** Mult instances *)
@@ -114,38 +115,31 @@ Section fractional.
(** Proof mode instances *)
Global Instance from_and_fractional_fwd P P1 P2 Φ q1 q2 :
AsFractional P Φ (q1 + q2) → AsFractional P1 Φ q1 → AsFractional P2 Φ q2 →
- FromAnd false P P1 P2.
- Proof. by rewrite /FromAnd=>-[-> ->] [-> _] [-> _]. Qed.
+ FromSep P P1 P2.
+ Proof. by rewrite /FromSep=>-[-> ->] [-> _] [-> _]. Qed.
Global Instance from_sep_fractional_bwd P P1 P2 Φ q1 q2 :
AsFractional P1 Φ q1 → AsFractional P2 Φ q2 → AsFractional P Φ (q1 + q2) →
- FromAnd false P P1 P2 | 10.
- Proof. by rewrite /FromAnd=>-[-> _] [-> <-] [-> _]. Qed.
+ FromSep P P1 P2 | 10.
+ Proof. by rewrite /FromSep=>-[-> _] [-> <-] [-> _]. Qed.
- Global Instance from_and_fractional_half_fwd P Q Φ q :
+ Global Instance from_sep_fractional_half_fwd P Q Φ q :
AsFractional P Φ q → AsFractional Q Φ (q/2) →
- FromAnd false P Q Q | 10.
- Proof. by rewrite /FromAnd -{1}(Qp_div_2 q)=>-[-> ->] [-> _]. Qed.
- Global Instance from_and_fractional_half_bwd P Q Φ q :
+ FromSep P Q Q | 10.
+ Proof. by rewrite /FromSep -{1}(Qp_div_2 q)=>-[-> ->] [-> _]. Qed.
+ Global Instance from_sep_fractional_half_bwd P Q Φ q :
AsFractional P Φ (q/2) → AsFractional Q Φ q →
- FromAnd false Q P P.
- Proof. rewrite /FromAnd=>-[-> <-] [-> _]. by rewrite Qp_div_2. Qed.
+ FromSep Q P P.
+ Proof. rewrite /FromSep=>-[-> <-] [-> _]. by rewrite Qp_div_2. Qed.
- Global Instance into_and_fractional p P P1 P2 Φ q1 q2 :
+ Global Instance into_sep_fractional p P P1 P2 Φ q1 q2 :
AsFractional P Φ (q1 + q2) → AsFractional P1 Φ q1 → AsFractional P2 Φ q2 →
- IntoAnd p P P1 P2.
- Proof.
- (* TODO: We need a better way to handle this boolean here; persistently
- applying mk_into_and_sep (which only works after introducing all
- assumptions) is rather annoying.
- Ideally, it'd not even be possible to make the mistake that
- was originally made here, which is to give this instance for
- "false" only, thus breaking some intro patterns. *)
- intros. apply mk_into_and_sep. rewrite [P]fractional_split //.
- Qed.
- Global Instance into_and_fractional_half p P Q Φ q :
+ IntoSep p P P1 P2.
+ Proof. intros. rewrite /IntoSep [P]fractional_split //. Qed.
+
+ Global Instance into_sep_fractional_half p P Q Φ q :
AsFractional P Φ q → AsFractional Q Φ (q/2) →
- IntoAnd p P Q Q | 100.
- Proof. intros. apply mk_into_and_sep. rewrite [P]fractional_half //. Qed.
+ IntoSep p P Q Q | 100.
+ Proof. intros. rewrite /IntoSep [P]fractional_half //. Qed.
(* The instance [frame_fractional] can be tried at all the nodes of
the proof search. The proof search then fails almost persistently on
@@ -153,7 +147,7 @@ Section fractional.
that reason, we factorize the three instances that could have been
defined for that purpose into one. *)
Inductive FrameFractionalHyps
- (p : bool) (R : uPred M) (Φ : Qp → uPred M) (RES : uPred M) : Qp → Qp → Prop :=
+ (p : bool) (R : PROP) (Φ : Qp → PROP) (RES : PROP) : Qp → Qp → Prop :=
| frame_fractional_hyps_l Q q q' r:
Frame p R (Φ q) Q →
MakeSep Q (Φ q') RES →
@@ -176,9 +170,9 @@ Section fractional.
Proof.
rewrite /Frame=>-[HR _][->?]H.
revert H HR=>-[Q q0 q0' r0|Q q0 q0' r0|q0].
- - rewrite fractional=><-<-. by rewrite assoc.
- - rewrite fractional=><-<-=>_.
+ - rewrite fractional /Frame /MakeSep=><-<-. by rewrite assoc.
+ - rewrite fractional /Frame /MakeSep=><-<-=>_.
by rewrite (comm _ Q (Φ q0)) !assoc (comm _ (Φ _)).
- - move=>-[-> _]->. by rewrite uPred.persistently_if_elim -fractional Qp_div_2.
+ - move=>-[-> _]->. by rewrite bi.bare_persistently_if_elim -fractional Qp_div_2.
Qed.
End fractional.
diff --git a/theories/bi/interface.v b/theories/bi/interface.v
new file mode 100644
index 000000000..17ebac6b6
--- /dev/null
+++ b/theories/bi/interface.v
@@ -0,0 +1,468 @@
+From iris.algebra Require Export ofe.
+
+Reserved Notation "P ⊢ Q" (at level 99, Q at level 200, right associativity).
+Reserved Notation "'emp'".
+Reserved Notation "'⌜' φ 'âŒ'" (at level 1, φ at level 200, format "⌜ φ âŒ").
+Reserved Notation "P ∗ Q" (at level 80, right associativity).
+Reserved Notation "P -∗ Q" (at level 99, Q at level 200, right associativity).
+Reserved Notation "â–¡ P" (at level 20, right associativity).
+Reserved Notation "â–· P" (at level 20, right associativity).
+
+Section bi_mixin.
+ Context {PROP : Type} `{Dist PROP, Equiv PROP}.
+ Context (bi_entails : PROP → PROP → Prop).
+ Context (bi_emp : PROP).
+ Context (bi_pure : Prop → PROP).
+ Context (bi_and : PROP → PROP → PROP).
+ Context (bi_or : PROP → PROP → PROP).
+ Context (bi_impl : PROP → PROP → PROP).
+ Context (bi_forall : ∀ A, (A → PROP) → PROP).
+ Context (bi_exist : ∀ A, (A → PROP) → PROP).
+ Context (bi_internal_eq : ∀ A : ofeT, A → A → PROP).
+ Context (bi_sep : PROP → PROP → PROP).
+ Context (bi_wand : PROP → PROP → PROP).
+ Context (bi_persistently : PROP → PROP).
+ Context (bi_later : PROP → PROP).
+
+ Local Infix "⊢" := bi_entails.
+ Local Notation "'emp'" := bi_emp.
+ Local Notation "'True'" := (bi_pure True).
+ Local Notation "'False'" := (bi_pure False).
+ Local Notation "'⌜' φ 'âŒ'" := (bi_pure φ%type%C).
+ Local Infix "∧" := bi_and.
+ Local Infix "∨" := bi_or.
+ Local Infix "→" := bi_impl.
+ Local Notation "∀ x .. y , P" :=
+ (bi_forall _ (λ x, .. (bi_forall _ (λ y, P)) ..)).
+ Local Notation "∃ x .. y , P" :=
+ (bi_exist _ (λ x, .. (bi_exist _ (λ y, P)) ..)).
+ Local Notation "x ≡ y" := (bi_internal_eq _ x y).
+ Local Infix "∗" := bi_sep.
+ Local Infix "-∗" := bi_wand.
+ Local Notation "â–¡ P" := (bi_persistently P).
+ Local Notation "â–· P" := (bi_later P).
+
+ Record BIMixin := {
+ bi_mixin_entails_po : PreOrder bi_entails;
+ bi_mixin_equiv_spec P Q : equiv P Q ↔ (P ⊢ Q) ∧ (Q ⊢ P);
+
+ (* Non-expansiveness *)
+ bi_mixin_pure_ne n : Proper (iff ==> dist n) bi_pure;
+ bi_mixin_and_ne : NonExpansive2 bi_and;
+ bi_mixin_or_ne : NonExpansive2 bi_or;
+ bi_mixin_impl_ne : NonExpansive2 bi_impl;
+ bi_mixin_forall_ne A n :
+ Proper (pointwise_relation _ (dist n) ==> dist n) (bi_forall A);
+ bi_mixin_exist_ne A n :
+ Proper (pointwise_relation _ (dist n) ==> dist n) (bi_exist A);
+ bi_mixin_sep_ne : NonExpansive2 bi_sep;
+ bi_mixin_wand_ne : NonExpansive2 bi_wand;
+ bi_mixin_persistently_ne : NonExpansive bi_persistently;
+ sbi_mixin_internal_eq_ne (A : ofeT) : NonExpansive2 (bi_internal_eq A);
+
+ (* Higher-order logic *)
+ bi_mixin_pure_intro P (φ : Prop) : φ → P ⊢ ⌜ φ âŒ;
+ bi_mixin_pure_elim' (φ : Prop) P : (φ → True ⊢ P) → ⌜ φ ⌠⊢ P;
+ bi_mixin_pure_forall_2 {A} (φ : A → Prop) : (∀ a, ⌜ φ a âŒ) ⊢ ⌜ ∀ a, φ a âŒ;
+
+ bi_mixin_and_elim_l P Q : P ∧ Q ⊢ P;
+ bi_mixin_and_elim_r P Q : P ∧ Q ⊢ Q;
+ bi_mixin_and_intro P Q R : (P ⊢ Q) → (P ⊢ R) → P ⊢ Q ∧ R;
+
+ bi_mixin_or_intro_l P Q : P ⊢ P ∨ Q;
+ bi_mixin_or_intro_r P Q : Q ⊢ P ∨ Q;
+ bi_mixin_or_elim P Q R : (P ⊢ R) → (Q ⊢ R) → P ∨ Q ⊢ R;
+
+ bi_mixin_impl_intro_r P Q R : (P ∧ Q ⊢ R) → P ⊢ Q → R;
+ bi_mixin_impl_elim_l' P Q R : (P ⊢ Q → R) → P ∧ Q ⊢ R;
+
+ bi_mixin_forall_intro {A} P (Ψ : A → PROP) : (∀ a, P ⊢ Ψ a) → P ⊢ ∀ a, Ψ a;
+ bi_mixin_forall_elim {A} {Ψ : A → PROP} a : (∀ a, Ψ a) ⊢ Ψ a;
+
+ bi_mixin_exist_intro {A} {Ψ : A → PROP} a : Ψ a ⊢ ∃ a, Ψ a;
+ bi_mixin_exist_elim {A} (Φ : A → PROP) Q : (∀ a, Φ a ⊢ Q) → (∃ a, Φ a) ⊢ Q;
+
+ (* Equality *)
+ bi_mixin_internal_eq_refl {A : ofeT} P (a : A) : P ⊢ a ≡ a;
+ bi_mixin_internal_eq_rewrite {A : ofeT} a b (Ψ : A → PROP) :
+ NonExpansive Ψ → a ≡ b ⊢ Ψ a → Ψ b;
+ bi_mixin_fun_ext {A B} (f g : A -c> B) : (∀ x, f x ≡ g x) ⊢ f ≡ g;
+ bi_mixin_sig_eq {A : ofeT} (P : A → Prop) (x y : sig P) : `x ≡ `y ⊢ x ≡ y;
+ bi_mixin_discrete_eq_1 {A : ofeT} (a b : A) : Discrete a → a ≡ b ⊢ ⌜a ≡ bâŒ;
+
+ (* BI connectives *)
+ bi_mixin_sep_mono P P' Q Q' : (P ⊢ Q) → (P' ⊢ Q') → P ∗ P' ⊢ Q ∗ Q';
+ bi_mixin_emp_sep_1 P : P ⊢ emp ∗ P;
+ bi_mixin_emp_sep_2 P : emp ∗ P ⊢ P;
+ bi_mixin_sep_comm' P Q : P ∗ Q ⊢ Q ∗ P;
+ bi_mixin_sep_assoc' P Q R : (P ∗ Q) ∗ R ⊢ P ∗ (Q ∗ R);
+ bi_mixin_wand_intro_r P Q R : (P ∗ Q ⊢ R) → P ⊢ Q -∗ R;
+ bi_mixin_wand_elim_l' P Q R : (P ⊢ Q -∗ R) → P ∗ Q ⊢ R;
+
+ bi_mixin_emp_and_sep_assoc_1 Q R : emp ∧ (Q ∗ R) ⊢ (emp ∧ Q) ∗ R;
+
+ (* Persistently *)
+ bi_mixin_persistently_mono P Q : (P ⊢ Q) → □ P ⊢ □ Q;
+ bi_mixin_persistently_idemp_2 P : □ P ⊢ □ □ P;
+
+ bi_mixin_persistently_forall_2 {A} (Ψ : A → PROP) :
+ (∀ a, □ Ψ a) ⊢ □ ∀ a, Ψ a;
+ bi_mixin_persistently_exist_1 {A} (Ψ : A → PROP) :
+ □ (∃ a, Ψ a) ⊢ ∃ a, □ Ψ a;
+
+ bi_mixin_persistently_emp_intro P : P ⊢ □ emp;
+ bi_mixin_persistently_and_emp_elim P : emp ∧ □ P ⊢ P;
+
+ bi_mixin_persistently_absorbing P Q : □ P ∗ Q ⊢ □ P;
+ bi_mixin_persistently_and_sep_assoc_1 P Q R : □ P ∧ (Q ∗ R) ⊢ (□ P ∧ Q) ∗ R;
+ }.
+
+ Record SBIMixin := {
+ sbi_mixin_later_contractive : Contractive bi_later;
+
+ sbi_mixin_later_eq_1 {A : ofeT} (x y : A) : Next x ≡ Next y ⊢ ▷ (x ≡ y);
+ sbi_mixin_later_eq_2 {A : ofeT} (x y : A) : ▷ (x ≡ y) ⊢ Next x ≡ Next y;
+
+ sbi_mixin_later_mono P Q : (P ⊢ Q) → ▷ P ⊢ ▷ Q;
+ sbi_mixin_löb P : (▷ P → P) ⊢ P;
+
+ sbi_mixin_later_forall_2 {A} (Φ : A → PROP) : (∀ a, ▷ Φ a) ⊢ ▷ ∀ a, Φ a;
+ sbi_mixin_later_exist_false {A} (Φ : A → PROP) :
+ (▷ ∃ a, Φ a) ⊢ ▷ False ∨ (∃ a, ▷ Φ a);
+ sbi_mixin_later_emp_false : ▷ emp ⊢ ▷ False ∨ emp;
+ sbi_mixin_later_sep_1 P Q : ▷ (P ∗ Q) ⊢ ▷ P ∗ ▷ Q;
+ sbi_mixin_later_sep_2 P Q : ▷ P ∗ ▷ Q ⊢ ▷ (P ∗ Q);
+ sbi_mixin_later_persistently_1 P : ▷ □ P ⊢ □ ▷ P;
+ sbi_mixin_later_persistently_2 P : □ ▷ P ⊢ ▷ □ P;
+
+ sbi_mixin_later_false_em P : ▷ P ⊢ ▷ False ∨ (▷ False → P);
+ }.
+End bi_mixin.
+
+Structure bi := BI {
+ bi_car :> Type;
+ bi_dist : Dist bi_car;
+ bi_equiv : Equiv bi_car;
+ bi_entails : bi_car → bi_car → Prop;
+ bi_emp : bi_car;
+ bi_pure : Prop → bi_car;
+ bi_and : bi_car → bi_car → bi_car;
+ bi_or : bi_car → bi_car → bi_car;
+ bi_impl : bi_car → bi_car → bi_car;
+ bi_forall : ∀ A, (A → bi_car) → bi_car;
+ bi_exist : ∀ A, (A → bi_car) → bi_car;
+ bi_internal_eq : ∀ A : ofeT, A → A → bi_car;
+ bi_sep : bi_car → bi_car → bi_car;
+ bi_wand : bi_car → bi_car → bi_car;
+ bi_persistently : bi_car → bi_car;
+ bi_ofe_mixin : OfeMixin bi_car;
+ bi_bi_mixin : BIMixin bi_entails bi_emp bi_pure bi_and bi_or bi_impl
+ bi_forall bi_exist bi_internal_eq
+ bi_sep bi_wand bi_persistently;
+}.
+
+Coercion bi_ofeC (PROP : bi) : ofeT := OfeT PROP (bi_ofe_mixin PROP).
+Canonical Structure bi_ofeC.
+
+Instance: Params (@bi_entails) 1.
+Instance: Params (@bi_emp) 1.
+Instance: Params (@bi_pure) 1.
+Instance: Params (@bi_and) 1.
+Instance: Params (@bi_or) 1.
+Instance: Params (@bi_impl) 1.
+Instance: Params (@bi_forall) 2.
+Instance: Params (@bi_exist) 2.
+Instance: Params (@bi_internal_eq) 2.
+Instance: Params (@bi_sep) 1.
+Instance: Params (@bi_wand) 1.
+Instance: Params (@bi_persistently) 1.
+
+Delimit Scope bi_scope with I.
+Arguments bi_car : simpl never.
+Arguments bi_dist : simpl never.
+Arguments bi_equiv : simpl never.
+Arguments bi_entails {PROP} _%I _%I : simpl never, rename.
+Arguments bi_emp {PROP} : simpl never, rename.
+Arguments bi_pure {PROP} _%C : simpl never, rename.
+Arguments bi_and {PROP} _%I _%I : simpl never, rename.
+Arguments bi_or {PROP} _%I _%I : simpl never, rename.
+Arguments bi_impl {PROP} _%I _%I : simpl never, rename.
+Arguments bi_forall {PROP _} _%I : simpl never, rename.
+Arguments bi_exist {PROP _} _%I : simpl never, rename.
+Arguments bi_internal_eq {PROP _} _ _ : simpl never, rename.
+Arguments bi_sep {PROP} _%I _%I : simpl never, rename.
+Arguments bi_wand {PROP} _%I _%I : simpl never, rename.
+Arguments bi_persistently {PROP} _%I : simpl never, rename.
+
+Structure sbi := SBI {
+ sbi_car :> Type;
+ sbi_dist : Dist sbi_car;
+ sbi_equiv : Equiv sbi_car;
+ sbi_entails : sbi_car → sbi_car → Prop;
+ sbi_emp : sbi_car;
+ sbi_pure : Prop → sbi_car;
+ sbi_and : sbi_car → sbi_car → sbi_car;
+ sbi_or : sbi_car → sbi_car → sbi_car;
+ sbi_impl : sbi_car → sbi_car → sbi_car;
+ sbi_forall : ∀ A, (A → sbi_car) → sbi_car;
+ sbi_exist : ∀ A, (A → sbi_car) → sbi_car;
+ sbi_internal_eq : ∀ A : ofeT, A → A → sbi_car;
+ sbi_sep : sbi_car → sbi_car → sbi_car;
+ sbi_wand : sbi_car → sbi_car → sbi_car;
+ sbi_persistently : sbi_car → sbi_car;
+ bi_later : sbi_car → sbi_car;
+ sbi_ofe_mixin : OfeMixin sbi_car;
+ sbi_bi_mixin : BIMixin sbi_entails sbi_emp sbi_pure sbi_and sbi_or sbi_impl
+ sbi_forall sbi_exist sbi_internal_eq
+ sbi_sep sbi_wand sbi_persistently;
+ sbi_sbi_mixin : SBIMixin sbi_entails sbi_emp sbi_pure sbi_or sbi_impl
+ sbi_forall sbi_exist sbi_internal_eq
+ sbi_sep sbi_persistently bi_later;
+}.
+
+Arguments sbi_car : simpl never.
+Arguments sbi_entails {PROP} _%I _%I : simpl never, rename.
+Arguments bi_emp {PROP} : simpl never, rename.
+Arguments bi_pure {PROP} _%C : simpl never, rename.
+Arguments bi_and {PROP} _%I _%I : simpl never, rename.
+Arguments bi_or {PROP} _%I _%I : simpl never, rename.
+Arguments bi_impl {PROP} _%I _%I : simpl never, rename.
+Arguments bi_forall {PROP _} _%I : simpl never, rename.
+Arguments bi_exist {PROP _} _%I : simpl never, rename.
+Arguments bi_internal_eq {PROP _} _ _ : simpl never, rename.
+Arguments bi_sep {PROP} _%I _%I : simpl never, rename.
+Arguments bi_wand {PROP} _%I _%I : simpl never, rename.
+Arguments bi_persistently {PROP} _%I : simpl never, rename.
+
+Coercion sbi_ofeC (PROP : sbi) : ofeT := OfeT PROP (sbi_ofe_mixin PROP).
+Canonical Structure sbi_ofeC.
+Coercion sbi_bi (PROP : sbi) : bi :=
+ {| bi_ofe_mixin := sbi_ofe_mixin PROP; bi_bi_mixin := sbi_bi_mixin PROP |}.
+Canonical Structure sbi_bi.
+
+Arguments sbi_car : simpl never.
+Arguments sbi_dist : simpl never.
+Arguments sbi_equiv : simpl never.
+Arguments sbi_entails {PROP} _%I _%I : simpl never, rename.
+Arguments sbi_emp {PROP} : simpl never, rename.
+Arguments sbi_pure {PROP} _%C : simpl never, rename.
+Arguments sbi_and {PROP} _%I _%I : simpl never, rename.
+Arguments sbi_or {PROP} _%I _%I : simpl never, rename.
+Arguments sbi_impl {PROP} _%I _%I : simpl never, rename.
+Arguments sbi_forall {PROP _} _%I : simpl never, rename.
+Arguments sbi_exist {PROP _} _%I : simpl never, rename.
+Arguments sbi_internal_eq {PROP _} _ _ : simpl never, rename.
+Arguments sbi_sep {PROP} _%I _%I : simpl never, rename.
+Arguments sbi_wand {PROP} _%I _%I : simpl never, rename.
+Arguments sbi_persistently {PROP} _%I : simpl never, rename.
+Arguments bi_later {PROP} _%I : simpl never, rename.
+
+Hint Extern 0 (bi_entails _ _) => reflexivity.
+Instance bi_rewrite_relation (PROP : bi) : RewriteRelation (@bi_entails PROP).
+Instance bi_inhabited {PROP : bi} : Inhabited PROP := populate (bi_pure True).
+
+Notation "P ⊢ Q" := (bi_entails P%I Q%I) : C_scope.
+Notation "(⊢)" := bi_entails (only parsing) : C_scope.
+
+Notation "P ⊣⊢ Q" := (equiv (A:=bi_car _) P%I Q%I)
+ (at level 95, no associativity) : C_scope.
+Notation "(⊣⊢)" := (equiv (A:=bi_car _)) (only parsing) : C_scope.
+
+Notation "P -∗ Q" := (P ⊢ Q) : C_scope.
+
+Notation "'emp'" := (bi_emp) : bi_scope.
+Notation "'⌜' φ 'âŒ'" := (bi_pure φ%type%C) : bi_scope.
+Notation "'True'" := (bi_pure True) : bi_scope.
+Notation "'False'" := (bi_pure False) : bi_scope.
+Infix "∧" := bi_and : bi_scope.
+Notation "(∧)" := bi_and (only parsing) : bi_scope.
+Infix "∨" := bi_or : bi_scope.
+Notation "(∨)" := bi_or (only parsing) : bi_scope.
+Infix "→" := bi_impl : bi_scope.
+Infix "∗" := bi_sep : bi_scope.
+Notation "(∗)" := bi_sep (only parsing) : bi_scope.
+Notation "P -∗ Q" := (bi_wand P Q) : bi_scope.
+Notation "∀ x .. y , P" :=
+ (bi_forall (λ x, .. (bi_forall (λ y, P)) ..)%I) : bi_scope.
+Notation "∃ x .. y , P" :=
+ (bi_exist (λ x, .. (bi_exist (λ y, P)) ..)%I) : bi_scope.
+Notation "â–¡ P" := (bi_persistently P) : bi_scope.
+
+Infix "≡" := bi_internal_eq : bi_scope.
+Notation "â–· P" := (bi_later P) : bi_scope.
+
+Coercion bi_valid {PROP : bi} (P : PROP) : Prop := emp ⊢ P.
+Coercion sbi_valid {PROP : sbi} : PROP → Prop := bi_valid.
+
+Arguments bi_valid {_} _%I : simpl never.
+Typeclasses Opaque bi_valid.
+
+Module bi.
+Section bi_laws.
+Context {PROP : bi}.
+Implicit Types φ : Prop.
+Implicit Types P Q R : PROP.
+Implicit Types A : Type.
+
+(* About the entailment *)
+Global Instance entails_po : PreOrder (@bi_entails PROP).
+Proof. eapply bi_mixin_entails_po, bi_bi_mixin. Qed.
+Lemma equiv_spec P Q : P ≡ Q ↔ (P ⊢ Q) ∧ (Q ⊢ P).
+Proof. eapply bi_mixin_equiv_spec, bi_bi_mixin. Qed.
+
+(* Non-expansiveness *)
+Global Instance pure_ne n : Proper (iff ==> dist n) (@bi_pure PROP).
+Proof. eapply bi_mixin_pure_ne, bi_bi_mixin. Qed.
+Global Instance and_ne : NonExpansive2 (@bi_and PROP).
+Proof. eapply bi_mixin_and_ne, bi_bi_mixin. Qed.
+Global Instance or_ne : NonExpansive2 (@bi_or PROP).
+Proof. eapply bi_mixin_or_ne, bi_bi_mixin. Qed.
+Global Instance impl_ne : NonExpansive2 (@bi_impl PROP).
+Proof. eapply bi_mixin_impl_ne, bi_bi_mixin. Qed.
+Global Instance forall_ne A n :
+ Proper (pointwise_relation _ (dist n) ==> dist n) (@bi_forall PROP A).
+Proof. eapply bi_mixin_forall_ne, bi_bi_mixin. Qed.
+Global Instance exist_ne A n :
+ Proper (pointwise_relation _ (dist n) ==> dist n) (@bi_exist PROP A).
+Proof. eapply bi_mixin_exist_ne, bi_bi_mixin. Qed.
+Global Instance sep_ne : NonExpansive2 (@bi_sep PROP).
+Proof. eapply bi_mixin_sep_ne, bi_bi_mixin. Qed.
+Global Instance wand_ne : NonExpansive2 (@bi_wand PROP).
+Proof. eapply bi_mixin_wand_ne, bi_bi_mixin. Qed.
+Global Instance persistently_ne : NonExpansive (@bi_persistently PROP).
+Proof. eapply bi_mixin_persistently_ne, bi_bi_mixin. Qed.
+
+(* Higher-order logic *)
+Lemma pure_intro P (φ : Prop) : φ → P ⊢ ⌜ φ âŒ.
+Proof. eapply bi_mixin_pure_intro, bi_bi_mixin. Qed.
+Lemma pure_elim' (φ : Prop) P : (φ → True ⊢ P) → ⌜ φ ⌠⊢ P.
+Proof. eapply bi_mixin_pure_elim', bi_bi_mixin. Qed.
+Lemma pure_forall_2 {A} (φ : A → Prop) : (∀ a, ⌜ φ a ⌠: PROP) ⊢ ⌜ ∀ a, φ a âŒ.
+Proof. eapply bi_mixin_pure_forall_2, bi_bi_mixin. Qed.
+
+Lemma and_elim_l P Q : P ∧ Q ⊢ P.
+Proof. eapply bi_mixin_and_elim_l, bi_bi_mixin. Qed.
+Lemma and_elim_r P Q : P ∧ Q ⊢ Q.
+Proof. eapply bi_mixin_and_elim_r, bi_bi_mixin. Qed.
+Lemma and_intro P Q R : (P ⊢ Q) → (P ⊢ R) → P ⊢ Q ∧ R.
+Proof. eapply bi_mixin_and_intro, bi_bi_mixin. Qed.
+
+Lemma or_intro_l P Q : P ⊢ P ∨ Q.
+Proof. eapply bi_mixin_or_intro_l, bi_bi_mixin. Qed.
+Lemma or_intro_r P Q : Q ⊢ P ∨ Q.
+Proof. eapply bi_mixin_or_intro_r, bi_bi_mixin. Qed.
+Lemma or_elim P Q R : (P ⊢ R) → (Q ⊢ R) → P ∨ Q ⊢ R.
+Proof. eapply bi_mixin_or_elim, bi_bi_mixin. Qed.
+
+Lemma impl_intro_r P Q R : (P ∧ Q ⊢ R) → P ⊢ Q → R.
+Proof. eapply bi_mixin_impl_intro_r, bi_bi_mixin. Qed.
+Lemma impl_elim_l' P Q R : (P ⊢ Q → R) → P ∧ Q ⊢ R.
+Proof. eapply bi_mixin_impl_elim_l', bi_bi_mixin. Qed.
+
+Lemma forall_intro {A} P (Ψ : A → PROP) : (∀ a, P ⊢ Ψ a) → P ⊢ ∀ a, Ψ a.
+Proof. eapply bi_mixin_forall_intro, bi_bi_mixin. Qed.
+Lemma forall_elim {A} {Ψ : A → PROP} a : (∀ a, Ψ a) ⊢ Ψ a.
+Proof. eapply (bi_mixin_forall_elim bi_entails), bi_bi_mixin. Qed.
+
+Lemma exist_intro {A} {Ψ : A → PROP} a : Ψ a ⊢ ∃ a, Ψ a.
+Proof. eapply bi_mixin_exist_intro, bi_bi_mixin. Qed.
+Lemma exist_elim {A} (Φ : A → PROP) Q : (∀ a, Φ a ⊢ Q) → (∃ a, Φ a) ⊢ Q.
+Proof. eapply bi_mixin_exist_elim, bi_bi_mixin. Qed.
+
+(* Equality *)
+Global Instance internal_eq_ne (A : ofeT) :
+ NonExpansive2 (@bi_internal_eq PROP A).
+Proof. eapply sbi_mixin_internal_eq_ne, bi_bi_mixin. Qed.
+
+Lemma internal_eq_refl {A : ofeT} P (a : A) : P ⊢ a ≡ a.
+Proof. eapply bi_mixin_internal_eq_refl, bi_bi_mixin. Qed.
+Lemma internal_eq_rewrite {A : ofeT} a b (Ψ : A → PROP) :
+ NonExpansive Ψ → a ≡ b ⊢ Ψ a → Ψ b.
+Proof. eapply bi_mixin_internal_eq_rewrite, bi_bi_mixin. Qed.
+
+Lemma fun_ext {A B} (f g : A -c> B) : (∀ x, f x ≡ g x) ⊢ (f ≡ g : PROP).
+Proof. eapply bi_mixin_fun_ext, bi_bi_mixin. Qed.
+Lemma sig_eq {A : ofeT} (P : A → Prop) (x y : sig P) : `x ≡ `y ⊢ (x ≡ y : PROP).
+Proof. eapply bi_mixin_sig_eq, bi_bi_mixin. Qed.
+Lemma discrete_eq_1 {A : ofeT} (a b : A) :
+ Discrete a → a ≡ b ⊢ (⌜a ≡ b⌠: PROP).
+Proof. eapply bi_mixin_discrete_eq_1, bi_bi_mixin. Qed.
+
+(* BI connectives *)
+Lemma sep_mono P P' Q Q' : (P ⊢ Q) → (P' ⊢ Q') → P ∗ P' ⊢ Q ∗ Q'.
+Proof. eapply bi_mixin_sep_mono, bi_bi_mixin. Qed.
+Lemma emp_sep_1 P : P ⊢ emp ∗ P.
+Proof. eapply bi_mixin_emp_sep_1, bi_bi_mixin. Qed.
+Lemma emp_sep_2 P : emp ∗ P ⊢ P.
+Proof. eapply bi_mixin_emp_sep_2, bi_bi_mixin. Qed.
+Lemma sep_comm' P Q : P ∗ Q ⊢ Q ∗ P.
+Proof. eapply (bi_mixin_sep_comm' bi_entails), bi_bi_mixin. Qed.
+Lemma sep_assoc' P Q R : (P ∗ Q) ∗ R ⊢ P ∗ (Q ∗ R).
+Proof. eapply bi_mixin_sep_assoc', bi_bi_mixin. Qed.
+Lemma wand_intro_r P Q R : (P ∗ Q ⊢ R) → P ⊢ Q -∗ R.
+Proof. eapply bi_mixin_wand_intro_r, bi_bi_mixin. Qed.
+Lemma wand_elim_l' P Q R : (P ⊢ Q -∗ R) → P ∗ Q ⊢ R.
+Proof. eapply bi_mixin_wand_elim_l', bi_bi_mixin. Qed.
+
+Lemma emp_and_sep_assoc_1 Q R : emp ∧ (Q ∗ R) ⊢ (emp ∧ Q) ∗ R.
+Proof. eapply bi_mixin_emp_and_sep_assoc_1, bi_bi_mixin. Qed.
+
+(* Persistently *)
+Lemma persistently_mono P Q : (P ⊢ Q) → □ P ⊢ □ Q.
+Proof. eapply bi_mixin_persistently_mono, bi_bi_mixin. Qed.
+Lemma persistently_idemp_2 P : □ P ⊢ □ □ P.
+Proof. eapply bi_mixin_persistently_idemp_2, bi_bi_mixin. Qed.
+
+Lemma persistently_forall_2 {A} (Ψ : A → PROP) : (∀ a, □ Ψ a) ⊢ □ ∀ a, Ψ a.
+Proof. eapply bi_mixin_persistently_forall_2, bi_bi_mixin. Qed.
+Lemma persistently_exist_1 {A} (Ψ : A → PROP) : □ (∃ a, Ψ a) ⊢ ∃ a, □ Ψ a.
+Proof. eapply bi_mixin_persistently_exist_1, bi_bi_mixin. Qed.
+
+Lemma persistently_emp_intro P : P ⊢ □ emp.
+Proof. eapply bi_mixin_persistently_emp_intro, bi_bi_mixin. Qed.
+Lemma persistently_and_emp_elim P : emp ∧ □ P ⊢ P.
+Proof. eapply bi_mixin_persistently_and_emp_elim, bi_bi_mixin. Qed.
+Lemma persistently_absorbing P Q : □ P ∗ Q ⊢ □ P.
+Proof. eapply (bi_mixin_persistently_absorbing bi_entails), bi_bi_mixin. Qed.
+Lemma persistently_and_sep_assoc_1 P Q R : □ P ∧ (Q ∗ R) ⊢ (□ P ∧ Q) ∗ R.
+Proof. eapply bi_mixin_persistently_and_sep_assoc_1, bi_bi_mixin. Qed.
+End bi_laws.
+
+Section sbi_laws.
+Context {PROP : sbi}.
+Implicit Types φ : Prop.
+Implicit Types P Q R : PROP.
+
+Global Instance later_contractive : Contractive (@bi_later PROP).
+Proof. eapply sbi_mixin_later_contractive, sbi_sbi_mixin. Qed.
+
+Lemma later_eq_1 {A : ofeT} (x y : A) : Next x ≡ Next y ⊢ ▷ (x ≡ y : PROP).
+Proof. eapply sbi_mixin_later_eq_1, sbi_sbi_mixin. Qed.
+Lemma later_eq_2 {A : ofeT} (x y : A) : ▷ (x ≡ y) ⊢ (Next x ≡ Next y : PROP).
+Proof. eapply sbi_mixin_later_eq_2, sbi_sbi_mixin. Qed.
+
+Lemma later_mono P Q : (P ⊢ Q) → ▷ P ⊢ ▷ Q.
+Proof. eapply sbi_mixin_later_mono, sbi_sbi_mixin. Qed.
+Lemma löb P : (▷ P → P) ⊢ P.
+Proof. eapply sbi_mixin_löb, sbi_sbi_mixin. Qed.
+
+Lemma later_forall_2 {A} (Φ : A → PROP) : (∀ a, ▷ Φ a) ⊢ ▷ ∀ a, Φ a.
+Proof. eapply sbi_mixin_later_forall_2, sbi_sbi_mixin. Qed.
+Lemma later_exist_false {A} (Φ : A → PROP) :
+ (▷ ∃ a, Φ a) ⊢ ▷ False ∨ (∃ a, ▷ Φ a).
+Proof. eapply sbi_mixin_later_exist_false, sbi_sbi_mixin. Qed.
+Lemma later_emp_false : ▷ (emp : PROP) ⊢ ▷ False ∨ emp.
+Proof. eapply sbi_mixin_later_emp_false, sbi_sbi_mixin. Qed.
+Lemma later_sep_1 P Q : ▷ (P ∗ Q) ⊢ ▷ P ∗ ▷ Q.
+Proof. eapply sbi_mixin_later_sep_1, sbi_sbi_mixin. Qed.
+Lemma later_sep_2 P Q : ▷ P ∗ ▷ Q ⊢ ▷ (P ∗ Q).
+Proof. eapply sbi_mixin_later_sep_2, sbi_sbi_mixin. Qed.
+Lemma later_persistently_1 P : ▷ □ P ⊢ □ ▷ P.
+Proof. eapply (sbi_mixin_later_persistently_1 bi_entails), sbi_sbi_mixin. Qed.
+Lemma later_persistently_2 P : □ ▷ P ⊢ ▷ □ P.
+Proof. eapply (sbi_mixin_later_persistently_2 bi_entails), sbi_sbi_mixin. Qed.
+
+Lemma later_false_em P : ▷ P ⊢ ▷ False ∨ (▷ False → P).
+Proof. eapply sbi_mixin_later_false_em, sbi_sbi_mixin. Qed.
+End sbi_laws.
+End bi.
diff --git a/theories/base_logic/tactics.v b/theories/bi/tactics.v
similarity index 72%
rename from theories/base_logic/tactics.v
rename to theories/bi/tactics.v
index 717bcec14..9fdb1345a 100644
--- a/theories/base_logic/tactics.v
+++ b/theories/bi/tactics.v
@@ -1,36 +1,38 @@
From stdpp Require Import gmap.
-From iris.base_logic Require Export base_logic big_op.
+From iris.bi Require Export bi.
Set Default Proof Using "Type".
-Import uPred.
+Import bi.
-Module uPred_reflection. Section uPred_reflection.
- Context {M : ucmraT}.
+Module bi_reflection. Section bi_reflection.
+ Context {PROP : bi}.
Inductive expr :=
- | ETrue : expr
+ | EEmp : expr
| EVar : nat → expr
| ESep : expr → expr → expr.
- Fixpoint eval (Σ : list (uPred M)) (e : expr) : uPred M :=
+ Fixpoint eval (Σ : list PROP) (e : expr) : PROP :=
match e with
- | ETrue => True
- | EVar n => from_option id True%I (Σ !! n)
+ | EEmp => emp
+ | EVar n => from_option id emp (Σ !! n)
| ESep e1 e2 => eval Σ e1 ∗ eval Σ e2
- end.
+ end%I.
Fixpoint flatten (e : expr) : list nat :=
match e with
- | ETrue => []
+ | EEmp => []
| EVar n => [n]
| ESep e1 e2 => flatten e1 ++ flatten e2
end.
- Notation eval_list Σ l := ([∗ list] n ∈ l, from_option id True (Σ !! n))%I.
+ Notation eval_list Σ l := ([∗ list] n ∈ l, from_option id emp (Σ !! n))%I.
Lemma eval_flatten Σ e : eval Σ e ⊣⊢ eval_list Σ (flatten e).
Proof.
induction e as [| |e1 IH1 e2 IH2];
rewrite /= ?right_id ?big_opL_app ?IH1 ?IH2 //.
Qed.
- Lemma flatten_entails Σ e1 e2 :
+
+ (* Can be related to the RHS being affine *)
+ Lemma flatten_entails `{AffineBI PROP} Σ e1 e2 :
flatten e2 ⊆+ flatten e1 → eval Σ e1 ⊢ eval Σ e2.
Proof. intros. rewrite !eval_flatten. by apply big_sepL_submseteq. Qed.
Lemma flatten_equiv Σ e1 e2 :
@@ -39,12 +41,12 @@ Module uPred_reflection. Section uPred_reflection.
Fixpoint prune (e : expr) : expr :=
match e with
- | ETrue => ETrue
+ | EEmp => EEmp
| EVar n => EVar n
| ESep e1 e2 =>
match prune e1, prune e2 with
- | ETrue, e2' => e2'
- | e1', ETrue => e1'
+ | EEmp, e2' => e2'
+ | e1', EEmp => e1'
| e1', e2' => ESep e1' e2'
end
end.
@@ -58,8 +60,8 @@ Module uPred_reflection. Section uPred_reflection.
Fixpoint cancel_go (n : nat) (e : expr) : option expr :=
match e with
- | ETrue => None
- | EVar n' => if decide (n = n') then Some ETrue else None
+ | EEmp => None
+ | EVar n' => if decide (n = n') then Some EEmp else None
| ESep e1 e2 =>
match cancel_go n e1 with
| Some e1' => Some (ESep e1' e2)
@@ -94,7 +96,7 @@ Module uPred_reflection. Section uPred_reflection.
Fixpoint to_expr (l : list nat) : expr :=
match l with
- | [] => ETrue
+ | [] => EEmp
| [n] => EVar n
| n :: l => ESep (EVar n) (to_expr l)
end.
@@ -115,19 +117,19 @@ Module uPred_reflection. Section uPred_reflection.
cancel ns e = Some e' → eval Σ e ⊣⊢ (eval Σ e' ∗ eval Σ (to_expr ns)).
Proof. intros. rewrite /= comm. by apply split_l. Qed.
- Class Quote (Σ1 Σ2 : list (uPred M)) (P : uPred M) (e : expr) := {}.
- Global Instance quote_True Σ : Quote Σ Σ True ETrue.
+ Class Quote (Σ1 Σ2 : list PROP) (P : PROP) (e : expr) := {}.
+ Global Instance quote_True Σ : Quote Σ Σ emp%I EEmp.
Global Instance quote_var Σ1 Σ2 P i:
rlist.QuoteLookup Σ1 Σ2 P i → Quote Σ1 Σ2 P (EVar i) | 1000.
Global Instance quote_sep Σ1 Σ2 Σ3 P1 P2 e1 e2 :
- Quote Σ1 Σ2 P1 e1 → Quote Σ2 Σ3 P2 e2 → Quote Σ1 Σ3 (P1 ∗ P2) (ESep e1 e2).
+ Quote Σ1 Σ2 P1 e1 → Quote Σ2 Σ3 P2 e2 → Quote Σ1 Σ3 (P1 ∗ P2)%I (ESep e1 e2).
- Class QuoteArgs (Σ: list (uPred M)) (Ps: list (uPred M)) (ns: list nat) := {}.
+ Class QuoteArgs (Σ : list PROP) (Ps : list PROP) (ns : list nat) := {}.
Global Instance quote_args_nil Σ : QuoteArgs Σ nil nil.
Global Instance quote_args_cons Σ Ps P ns n :
rlist.QuoteLookup Σ Σ P n →
QuoteArgs Σ Ps ns → QuoteArgs Σ (P :: Ps) (n :: ns).
- End uPred_reflection.
+ End bi_reflection.
Ltac quote :=
match goal with
@@ -142,30 +144,37 @@ Module uPred_reflection. Section uPred_reflection.
lazymatch type of (_ : Quote [] _ P1 _) with Quote _ ?Σ2 _ ?e1 =>
change (eval Σ2 e1 ⊢ P2) end
end.
-End uPred_reflection.
+End bi_reflection.
Tactic Notation "solve_sep_entails" :=
- uPred_reflection.quote; apply uPred_reflection.flatten_entails;
+ bi_reflection.quote;
+ first
+ [apply bi_reflection.flatten_entails (* for affine BIs *)
+ |apply equiv_entails, bi_reflection.flatten_equiv (* for other BIs *) ];
+ apply (bool_decide_unpack _); vm_compute; exact Logic.I.
+
+Tactic Notation "solve_sep_equiv" :=
+ bi_reflection.quote; apply bi_reflection.flatten_equiv;
apply (bool_decide_unpack _); vm_compute; exact Logic.I.
Ltac close_uPreds Ps tac :=
- let M := match goal with |- @uPred_entails ?M _ _ => M end in
+ let PROP := match goal with |- @bi_entails ?PROP _ _ => PROP end in
let rec go Ps Qs :=
lazymatch Ps with
| [] => let Qs' := eval cbv [reverse rev_append] in (reverse Qs) in tac Qs'
| ?P :: ?Ps => find_pat P ltac:(fun Q => go Ps (Q :: Qs))
end in
(* avoid evars in case Ps = @nil ?A *)
- try match Ps with [] => unify Ps (@nil (uPred M)) end;
- go Ps (@nil (uPred M)).
+ try match Ps with [] => unify Ps (@nil PROP) end;
+ go Ps (@nil PROP).
Tactic Notation "cancel" constr(Ps) :=
- uPred_reflection.quote;
- let Σ := match goal with |- uPred_reflection.eval ?Σ _ ⊢ _ => Σ end in
- let ns' := lazymatch type of (_ : uPred_reflection.QuoteArgs Σ Ps _) with
- | uPred_reflection.QuoteArgs _ _ ?ns' => ns'
+ bi_reflection.quote;
+ let Σ := match goal with |- bi_reflection.eval ?Σ _ ⊢ _ => Σ end in
+ let ns' := lazymatch type of (_ : bi_reflection.QuoteArgs Σ Ps _) with
+ | bi_reflection.QuoteArgs _ _ ?ns' => ns'
end in
- eapply uPred_reflection.cancel_entails with (ns:=ns');
+ eapply bi_reflection.cancel_entails with (ns:=ns');
[cbv; reflexivity|cbv; reflexivity|simpl].
Tactic Notation "ecancel" open_constr(Ps) :=
@@ -175,24 +184,24 @@ Tactic Notation "ecancel" open_constr(Ps) :=
the assumptions P1, P2, ... appear at the front, in that order. *)
Tactic Notation "to_front" open_constr(Ps) :=
close_uPreds Ps ltac:(fun Ps =>
- uPred_reflection.quote_l;
- let Σ := match goal with |- uPred_reflection.eval ?Σ _ ⊢ _ => Σ end in
- let ns' := lazymatch type of (_ : uPred_reflection.QuoteArgs Σ Ps _) with
- | uPred_reflection.QuoteArgs _ _ ?ns' => ns'
+ bi_reflection.quote_l;
+ let Σ := match goal with |- bi_reflection.eval ?Σ _ ⊢ _ => Σ end in
+ let ns' := lazymatch type of (_ : bi_reflection.QuoteArgs Σ Ps _) with
+ | bi_reflection.QuoteArgs _ _ ?ns' => ns'
end in
eapply entails_equiv_l;
- first (apply uPred_reflection.split_l with (ns:=ns'); cbv; reflexivity);
+ first (apply bi_reflection.split_l with (ns:=ns'); cbv; reflexivity);
simpl).
Tactic Notation "to_back" open_constr(Ps) :=
close_uPreds Ps ltac:(fun Ps =>
- uPred_reflection.quote_l;
- let Σ := match goal with |- uPred_reflection.eval ?Σ _ ⊢ _ => Σ end in
- let ns' := lazymatch type of (_ : uPred_reflection.QuoteArgs Σ Ps _) with
- | uPred_reflection.QuoteArgs _ _ ?ns' => ns'
+ bi_reflection.quote_l;
+ let Σ := match goal with |- bi_reflection.eval ?Σ _ ⊢ _ => Σ end in
+ let ns' := lazymatch type of (_ : bi_reflection.QuoteArgs Σ Ps _) with
+ | bi_reflection.QuoteArgs _ _ ?ns' => ns'
end in
eapply entails_equiv_l;
- first (apply uPred_reflection.split_r with (ns:=ns'); cbv; reflexivity);
+ first (apply bi_reflection.split_r with (ns:=ns'); cbv; reflexivity);
simpl).
(** [sep_split] is used to introduce a (∗).
diff --git a/theories/heap_lang/adequacy.v b/theories/heap_lang/adequacy.v
index fa3bc513f..135811da5 100644
--- a/theories/heap_lang/adequacy.v
+++ b/theories/heap_lang/adequacy.v
@@ -18,10 +18,10 @@ Definition heap_adequacy Σ `{heapPreG Σ} e σ φ :
(∀ `{heapG Σ}, WP e {{ v, ⌜φ v⌠}}%I) →
adequate e σ φ.
Proof.
- intros Hwp; eapply (wp_adequacy _ _); iIntros (?) "".
+ intros Hwp; eapply (wp_adequacy _ _); iIntros (?).
iMod (own_alloc (◠to_gen_heap σ)) as (γ) "Hh".
{ apply: auth_auth_valid. exact: to_gen_heap_valid. }
iModIntro. iExists (λ σ, own γ (◠to_gen_heap σ)); iFrame.
set (Hheap := GenHeapG loc val Σ _ _ _ γ).
- iApply (Hwp (HeapG _ _ _)).
+ by iApply (Hwp (HeapG _ _ _)).
Qed.
diff --git a/theories/heap_lang/lifting.v b/theories/heap_lang/lifting.v
index b8d1570db..9b597d486 100644
--- a/theories/heap_lang/lifting.v
+++ b/theories/heap_lang/lifting.v
@@ -23,12 +23,12 @@ Global Opaque iris_invG.
(** Override the notations so that scopes and coercions work out *)
Notation "l ↦{ q } v" := (mapsto (L:=loc) (V:=val) l q v%V)
- (at level 20, q at level 50, format "l ↦{ q } v") : uPred_scope.
+ (at level 20, q at level 50, format "l ↦{ q } v") : bi_scope.
Notation "l ↦ v" :=
- (mapsto (L:=loc) (V:=val) l 1 v%V) (at level 20) : uPred_scope.
+ (mapsto (L:=loc) (V:=val) l 1 v%V) (at level 20) : bi_scope.
Notation "l ↦{ q } -" := (∃ v, l ↦{q} v)%I
- (at level 20, q at level 50, format "l ↦{ q } -") : uPred_scope.
-Notation "l ↦ -" := (l ↦{1} -)%I (at level 20) : uPred_scope.
+ (at level 20, q at level 50, format "l ↦{ q } -") : bi_scope.
+Notation "l ↦ -" := (l ↦{1} -)%I (at level 20) : bi_scope.
(** The tactic [inv_head_step] performs inversion on hypotheses of the shape
[head_step]. The tactic will discharge head-reductions starting from values, and
diff --git a/theories/heap_lang/proofmode.v b/theories/heap_lang/proofmode.v
index 5801ae991..bd962e495 100644
--- a/theories/heap_lang/proofmode.v
+++ b/theories/heap_lang/proofmode.v
@@ -68,7 +68,7 @@ Section heap.
Context `{heapG Σ}.
Implicit Types P Q : iProp Σ.
Implicit Types Φ : val → iProp Σ.
-Implicit Types Δ : envs (iResUR Σ).
+Implicit Types Δ : envs (uPredI (iResUR Σ)).
Lemma tac_wp_alloc Δ Δ' E j K e v Φ :
IntoVal e v →
diff --git a/theories/program_logic/adequacy.v b/theories/program_logic/adequacy.v
index ca5667882..7b14039a0 100644
--- a/theories/program_logic/adequacy.v
+++ b/theories/program_logic/adequacy.v
@@ -1,6 +1,6 @@
From iris.program_logic Require Export weakestpre.
From iris.algebra Require Import gmap auth agree gset coPset.
-From iris.base_logic Require Import big_op soundness.
+From iris.base_logic Require Import soundness.
From iris.base_logic.lib Require Import wsat.
From iris.proofmode Require Import tactics.
Set Default Proof Using "Type".
@@ -172,17 +172,17 @@ Proof.
- intros t2 σ2 v2 [n ?]%rtc_nsteps.
eapply (soundness (M:=iResUR Σ) _ (S (S (S n)))); iIntros "".
rewrite Nat_iter_S. iMod wsat_alloc as (Hinv) "[Hw HE]".
- rewrite fupd_eq in Hwp; iMod (Hwp with "[$Hw $HE]") as ">(Hw & HE & Hwp)".
+ rewrite fupd_eq in Hwp. iMod (Hwp with "[$Hw $HE]") as ">(Hw & HE & Hwp)".
iDestruct "Hwp" as (Istate) "[HI Hwp]".
iModIntro. iNext. iApply (@wptp_result _ _ (IrisG _ _ Hinv Istate)); eauto.
- by iFrame.
+ iFrame; auto.
- intros t2 σ2 e2 [n ?]%rtc_nsteps ?.
eapply (soundness (M:=iResUR Σ) _ (S (S (S n)))); iIntros "".
rewrite Nat_iter_S. iMod wsat_alloc as (Hinv) "[Hw HE]".
rewrite fupd_eq in Hwp; iMod (Hwp with "[$Hw $HE]") as ">(Hw & HE & Hwp)".
iDestruct "Hwp" as (Istate) "[HI Hwp]".
iModIntro. iNext. iApply (@wptp_safe _ _ (IrisG _ _ Hinv Istate)); eauto.
- by iFrame.
+ iFrame; auto.
Qed.
Theorem wp_invariance Σ Λ `{invPreG Σ} e σ1 t2 σ2 φ :
@@ -199,5 +199,5 @@ Proof.
rewrite {1}fupd_eq in Hwp; iMod (Hwp with "[$Hw $HE]") as ">(Hw & HE & Hwp)".
iDestruct "Hwp" as (Istate) "(HIstate & Hwp & Hclose)".
iModIntro. iNext. iApply (@wptp_invariance _ _ (IrisG _ _ Hinv Istate)); eauto.
- by iFrame.
+ iFrame; auto.
Qed.
diff --git a/theories/program_logic/lifting.v b/theories/program_logic/lifting.v
index 41edd498d..02eabf2f5 100644
--- a/theories/program_logic/lifting.v
+++ b/theories/program_logic/lifting.v
@@ -1,5 +1,4 @@
From iris.program_logic Require Export weakestpre.
-From iris.base_logic Require Export big_op.
From iris.proofmode Require Import tactics.
Set Default Proof Using "Type".
@@ -76,7 +75,7 @@ Lemma wp_pure_step_fupd `{Inhabited (state Λ)} E E' e1 e2 φ Φ :
Proof.
iIntros ([??] Hφ) "HWP".
iApply (wp_lift_pure_det_step with "[HWP]"); [eauto|naive_solver|].
- rewrite big_sepL_nil right_id //.
+ rewrite bi.big_sepL_nil right_id //.
Qed.
Lemma wp_pure_step_later `{Inhabited (state Λ)} E e1 e2 φ Φ :
diff --git a/theories/program_logic/ownp.v b/theories/program_logic/ownp.v
index 1c3a8d3e3..be52bb68e 100644
--- a/theories/program_logic/ownp.v
+++ b/theories/program_logic/ownp.v
@@ -44,7 +44,7 @@ Theorem ownP_adequacy Σ `{ownPPreG Λ Σ} e σ φ :
adequate e σ φ.
Proof.
intros Hwp. apply (wp_adequacy Σ _).
- iIntros (?) "". iMod (own_alloc (◠(Excl' (σ : leibnizC _)) ⋅ ◯ (Excl' σ)))
+ iIntros (?). iMod (own_alloc (◠(Excl' (σ : leibnizC _)) ⋅ ◯ (Excl' σ)))
as (γσ) "[Hσ Hσf]"; first done.
iModIntro. iExists (λ σ, own γσ (◠(Excl' (σ:leibnizC _)))). iFrame "Hσ".
iApply (Hwp (OwnPG _ _ _ _ γσ)). by rewrite /ownP.
@@ -57,7 +57,7 @@ Theorem ownP_invariance Σ `{ownPPreG Λ Σ} e σ1 t2 σ2 φ :
φ σ2.
Proof.
intros Hwp Hsteps. eapply (wp_invariance Σ Λ e σ1 t2 σ2 _)=> //.
- iIntros (?) "". iMod (own_alloc (◠(Excl' (σ1 : leibnizC _)) ⋅ ◯ (Excl' σ1)))
+ iIntros (?). iMod (own_alloc (◠(Excl' (σ1 : leibnizC _)) ⋅ ◯ (Excl' σ1)))
as (γσ) "[Hσ Hσf]"; first done.
iExists (λ σ, own γσ (◠(Excl' (σ:leibnizC _)))). iFrame "Hσ".
iMod (Hwp (OwnPG _ _ _ _ γσ) with "[Hσf]") as "[$ H]"; first by rewrite /ownP.
@@ -211,7 +211,7 @@ Section ectx_lifting.
{{{ ▷ ownP σ1 }}} e1 @ E {{{ RET v2; ownP σ2 }}}.
Proof.
intros. rewrite -(ownP_lift_atomic_det_head_step σ1 v2 σ2 []); [|done..].
- rewrite /= right_id. by apply uPred.wand_intro_r.
+ rewrite /= right_id. by apply bi.wand_intro_r.
Qed.
Lemma ownP_lift_pure_det_head_step {E Φ} e1 e2 efs :
diff --git a/theories/program_logic/weakestpre.v b/theories/program_logic/weakestpre.v
index e548668c0..92842e1c7 100644
--- a/theories/program_logic/weakestpre.v
+++ b/theories/program_logic/weakestpre.v
@@ -1,6 +1,5 @@
From iris.base_logic.lib Require Export fancy_updates.
From iris.program_logic Require Export language.
-From iris.base_logic Require Import big_op.
From iris.proofmode Require Import tactics classes.
Set Default Proof Using "Type".
Import uPred.
@@ -40,37 +39,37 @@ Instance: Params (@wp) 5.
Notation "'WP' e @ E {{ Φ } }" := (wp E e%E Φ)
(at level 20, e, Φ at level 200,
- format "'[' 'WP' e '/' @ E {{ Φ } } ']'") : uPred_scope.
+ format "'[' 'WP' e '/' @ E {{ Φ } } ']'") : bi_scope.
Notation "'WP' e {{ Φ } }" := (wp ⊤ e%E Φ)
(at level 20, e, Φ at level 200,
- format "'[' 'WP' e '/' {{ Φ } } ']'") : uPred_scope.
+ format "'[' 'WP' e '/' {{ Φ } } ']'") : bi_scope.
Notation "'WP' e @ E {{ v , Q } }" := (wp E e%E (λ v, Q))
(at level 20, e, Q at level 200,
- format "'[' 'WP' e '/' @ E {{ v , Q } } ']'") : uPred_scope.
+ format "'[' 'WP' e '/' @ E {{ v , Q } } ']'") : bi_scope.
Notation "'WP' e {{ v , Q } }" := (wp ⊤ e%E (λ v, Q))
(at level 20, e, Q at level 200,
- format "'[' 'WP' e '/' {{ v , Q } } ']'") : uPred_scope.
+ format "'[' 'WP' e '/' {{ v , Q } } ']'") : bi_scope.
(* Texan triples *)
Notation "'{{{' P } } } e @ E {{{ x .. y , 'RET' pat ; Q } } }" :=
(□ ∀ Φ,
P -∗ ▷ (∀ x, .. (∀ y, Q -∗ Φ pat%V) .. ) -∗ WP e @ E {{ Φ }})%I
(at level 20, x closed binder, y closed binder,
- format "{{{ P } } } e @ E {{{ x .. y , RET pat ; Q } } }") : uPred_scope.
+ format "{{{ P } } } e @ E {{{ x .. y , RET pat ; Q } } }") : bi_scope.
Notation "'{{{' P } } } e {{{ x .. y , 'RET' pat ; Q } } }" :=
(□ ∀ Φ,
P -∗ ▷ (∀ x, .. (∀ y, Q -∗ Φ pat%V) .. ) -∗ WP e {{ Φ }})%I
(at level 20, x closed binder, y closed binder,
- format "{{{ P } } } e {{{ x .. y , RET pat ; Q } } }") : uPred_scope.
+ format "{{{ P } } } e {{{ x .. y , RET pat ; Q } } }") : bi_scope.
Notation "'{{{' P } } } e @ E {{{ 'RET' pat ; Q } } }" :=
(□ ∀ Φ, P -∗ ▷ (Q -∗ Φ pat%V) -∗ WP e @ E {{ Φ }})%I
(at level 20,
- format "{{{ P } } } e @ E {{{ RET pat ; Q } } }") : uPred_scope.
+ format "{{{ P } } } e @ E {{{ RET pat ; Q } } }") : bi_scope.
Notation "'{{{' P } } } e {{{ 'RET' pat ; Q } } }" :=
(□ ∀ Φ, P -∗ ▷ (Q -∗ Φ pat%V) -∗ WP e {{ Φ }})%I
(at level 20,
- format "{{{ P } } } e {{{ RET pat ; Q } } }") : uPred_scope.
+ format "{{{ P } } } e {{{ RET pat ; Q } } }") : bi_scope.
Notation "'{{{' P } } } e @ E {{{ x .. y , 'RET' pat ; Q } } }" :=
(∀ Φ : _ → uPred _,
diff --git a/theories/proofmode/class_instances.v b/theories/proofmode/class_instances.v
index 234053f12..c7409798a 100644
--- a/theories/proofmode/class_instances.v
+++ b/theories/proofmode/class_instances.v
@@ -1,490 +1,512 @@
From iris.proofmode Require Export classes.
-From iris.algebra Require Import gmap.
-From stdpp Require Import gmultiset.
-From iris.base_logic Require Import big_op tactics.
+From iris.bi Require Import bi tactics.
Set Default Proof Using "Type".
-Import uPred.
-
-Section classes.
-Context {M : ucmraT}.
-Implicit Types P Q R : uPred M.
+Import bi.
+
+Section bi_instances.
+Context {PROP : bi}.
+Implicit Types P Q R : PROP.
+
+(* 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_persistently {A : ofeT} (x y : A) P :
+ IntoInternalEq P x y → IntoInternalEq (□ P) x y.
+Proof. rewrite /IntoInternalEq=> ->. by rewrite persistently_elim_absorbing. Qed.
+Global Instance into_internal_eq_bare {A : ofeT} (x y : A) P :
+ IntoInternalEq P x y → IntoInternalEq (■P) x y.
+Proof. rewrite /IntoInternalEq=> ->. by rewrite bare_elim. Qed.
+
+(* FromBare *)
+Global Instance from_bare_affine P : Affine P → FromBare P P.
+Proof. intros. by rewrite /FromBare bare_elim. Qed.
+Global Instance from_bare_default P : FromBare (â– P) P | 100.
+Proof. by rewrite /FromBare. Qed.
(* FromAssumption *)
Global Instance from_assumption_exact p P : FromAssumption p P P | 0.
-Proof. destruct p; by rewrite /FromAssumption /= ?persistently_elim. Qed.
-Global Instance from_assumption_False p P : FromAssumption p False P | 1.
-Proof. destruct p; rewrite /FromAssumption /= ?persistently_pure; apply False_elim. Qed.
+Proof. by rewrite /FromAssumption /= bare_persistently_if_elim. Qed.
Global Instance from_assumption_persistently_r P Q :
FromAssumption true P Q → FromAssumption true P (□ Q).
-Proof. rewrite /FromAssumption=><-. by rewrite persistent_persistently. Qed.
+Proof.
+ rewrite /FromAssumption /= =><-.
+ by rewrite -{1}bare_persistently_idemp bare_elim.
+Qed.
+Global Instance from_assumption_bare_r P Q :
+ FromAssumption true P Q → FromAssumption true P (■Q).
+Proof. rewrite /FromAssumption /= =><-. by rewrite bare_idemp. Qed.
-Global Instance from_assumption_persistently_l p P Q :
- FromAssumption p P Q → FromAssumption p (□ P) Q.
-Proof. rewrite /FromAssumption=><-. by rewrite persistently_elim. Qed.
-Global Instance from_assumption_later p P Q :
- FromAssumption p P Q → FromAssumption p P (▷ Q)%I.
-Proof. rewrite /FromAssumption=>->. apply later_intro. Qed.
-Global Instance from_assumption_laterN n p P Q :
- FromAssumption p P Q → FromAssumption p P (▷^n Q)%I.
-Proof. rewrite /FromAssumption=>->. apply laterN_intro. Qed.
-Global Instance from_assumption_except_0 p P Q :
- FromAssumption p P Q → FromAssumption p P (◇ Q)%I.
-Proof. rewrite /FromAssumption=>->. apply except_0_intro. Qed.
-Global Instance from_assumption_bupd p P Q :
- FromAssumption p P Q → FromAssumption p P (|==> Q)%I.
-Proof. rewrite /FromAssumption=>->. apply bupd_intro. Qed.
-Global Instance from_assumption_forall {A} p (Φ : A → uPred M) Q x :
+Global Instance from_assumption_bare_persistently_l p P Q :
+ FromAssumption true P Q → FromAssumption p (⬕ P) Q.
+Proof. rewrite /FromAssumption /= =><-. by rewrite bare_persistently_if_elim. Qed.
+Global Instance from_assumption_persistently_l_true P Q :
+ FromAssumption true P Q → FromAssumption true (□ P) Q.
+Proof. rewrite /FromAssumption /= =><-. by rewrite persistently_idemp. Qed.
+Global Instance from_assumption_persistently_l_false `{AffineBI PROP} P Q :
+ FromAssumption true P Q → FromAssumption false (□ P) Q.
+Proof. rewrite /FromAssumption /= =><-. by rewrite affine_bare. Qed.
+
+Global Instance from_assumption_forall {A} p (Φ : A → PROP) Q x :
FromAssumption p (Φ x) Q → FromAssumption p (∀ x, Φ x) Q.
Proof. rewrite /FromAssumption=> <-. by rewrite forall_elim. Qed.
(* IntoPure *)
-Global Instance into_pure_pure φ : @IntoPure M ⌜φ⌠φ.
-Proof. done. Qed.
+Global Instance into_pure_pure φ : @IntoPure PROP ⌜φ⌠φ.
+Proof. by rewrite /IntoPure. Qed.
+
Global Instance into_pure_eq {A : ofeT} (a b : A) :
Discrete a → @IntoPure M (a ≡ b) (a ≡ b).
Proof. intros. by rewrite /IntoPure discrete_eq. Qed.
-Global Instance into_pure_cmra_valid `{CmraDiscrete A} (a : A) :
- @IntoPure M (✓ a) (✓ a).
-Proof. by rewrite /IntoPure discrete_valid. Qed.
-
-Global Instance into_pure_persistently P φ : IntoPure P φ → IntoPure (□ P) φ.
-Proof. rewrite /IntoPure=> ->. by rewrite persistently_pure. Qed.
Global Instance into_pure_pure_and (φ1 φ2 : Prop) P1 P2 :
IntoPure P1 φ1 → IntoPure P2 φ2 → IntoPure (P1 ∧ P2) (φ1 ∧ φ2).
Proof. rewrite /IntoPure pure_and. by intros -> ->. Qed.
-Global Instance into_pure_pure_sep (φ1 φ2 : Prop) P1 P2 :
- IntoPure P1 φ1 → IntoPure P2 φ2 → IntoPure (P1 ∗ P2) (φ1 ∧ φ2).
-Proof. rewrite /IntoPure sep_and 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 :
FromPure P1 φ1 → IntoPure P2 φ2 → IntoPure (P1 → P2) (φ1 → φ2).
Proof. rewrite /FromPure /IntoPure pure_impl. by intros -> ->. 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) :
+ (∀ 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_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 P1 φ1 → IntoPure P2 φ2 → IntoPure (P1 -∗ P2) (φ1 → φ2).
-Proof. rewrite /FromPure /IntoPure pure_impl impl_wand. by intros -> ->. Qed.
-
-Global Instance into_pure_exist {X : Type} (Φ : X → uPred M) (φ : X → Prop) :
- (∀ x, @IntoPure M (Φ x) (φ x)) → @IntoPure M (∃ x, Φ x) (∃ x, φ x).
-Proof.
- rewrite /IntoPure=>Hx. apply exist_elim=>x. rewrite Hx.
- apply pure_elim'=>Hφ. apply pure_intro. eauto.
-Qed.
+Proof. rewrite /FromPure /IntoPure=> <- ->. by rewrite pure_impl impl_wand_2. Qed.
-Global Instance into_pure_forall {X : Type} (Φ : X → uPred M) (φ : X → Prop) :
- (∀ x, @IntoPure M (Φ x) (φ x)) → @IntoPure M (∀ x, Φ x) (∀ x, φ x).
-Proof.
- rewrite /IntoPure=>Hx. rewrite -pure_forall_2. by setoid_rewrite Hx.
-Qed.
+Global Instance into_pure_bare P φ : IntoPure P φ → IntoPure (■P) φ.
+Proof. rewrite /IntoPure=> ->. apply bare_elim. Qed.
+Global Instance into_pure_persistently P φ : IntoPure P φ → IntoPure (□ P) φ.
+Proof. rewrite /IntoPure=> ->. apply: persistently_elim_absorbing. Qed.
(* FromPure *)
-Global Instance from_pure_pure φ : @FromPure M ⌜φ⌠φ.
-Proof. done. Qed.
+Global Instance from_pure_pure φ : @FromPure PROP ⌜φ⌠φ.
+Proof. by rewrite /FromPure. Qed.
Global Instance from_pure_internal_eq {A : ofeT} (a b : A) :
- @FromPure M (a ≡ b) (a ≡ b).
-Proof.
- rewrite /FromPure. eapply pure_elim; [done|]=> ->. apply internal_eq_refl'.
-Qed.
-Global Instance from_pure_cmra_valid {A : cmraT} (a : A) :
- @FromPure M (✓ a) (✓ a).
-Proof.
- rewrite /FromPure. eapply pure_elim; [done|]=> ?.
- rewrite -cmra_valid_intro //. auto with I.
-Qed.
-
-Global Instance from_pure_persistently P φ : FromPure P φ → FromPure (□ P) φ.
-Proof. rewrite /FromPure=> <-. by rewrite persistently_pure. Qed.
-Global Instance from_pure_later P φ : FromPure P φ → FromPure (▷ P) φ.
-Proof. rewrite /FromPure=> ->. apply later_intro. Qed.
-Global Instance from_pure_laterN n P φ : FromPure P φ → FromPure (▷^n P) φ.
-Proof. rewrite /FromPure=> ->. apply laterN_intro. Qed.
-Global Instance from_pure_except_0 P φ : FromPure P φ → FromPure (◇ P) φ.
-Proof. rewrite /FromPure=> ->. apply except_0_intro. Qed.
-Global Instance from_pure_bupd P φ : FromPure P φ → FromPure (|==> P) φ.
-Proof. rewrite /FromPure=> ->. apply bupd_intro. Qed.
+ @FromPure PROP (a ≡ b) (a ≡ b).
+Proof. by rewrite /FromPure pure_internal_eq. Qed.
Global Instance from_pure_pure_and (φ1 φ2 : Prop) P1 P2 :
FromPure P1 φ1 → FromPure P2 φ2 → FromPure (P1 ∧ P2) (φ1 ∧ φ2).
Proof. rewrite /FromPure pure_and. by intros -> ->. Qed.
-Global Instance from_pure_pure_sep (φ1 φ2 : Prop) P1 P2 :
- FromPure P1 φ1 → FromPure P2 φ2 → FromPure (P1 ∗ P2) (φ1 ∧ φ2).
-Proof. rewrite /FromPure pure_and and_sep_l. by intros -> ->. Qed.
Global Instance from_pure_pure_or (φ1 φ2 : Prop) P1 P2 :
FromPure P1 φ1 → FromPure P2 φ2 → FromPure (P1 ∨ P2) (φ1 ∨ φ2).
Proof. rewrite /FromPure pure_or. by intros -> ->. Qed.
Global Instance from_pure_pure_impl (φ1 φ2 : Prop) P1 P2 :
IntoPure P1 φ1 → FromPure P2 φ2 → FromPure (P1 → P2) (φ1 → φ2).
Proof. rewrite /FromPure /IntoPure pure_impl. by intros -> ->. Qed.
+
+Global Instance from_pure_exist {A} (Φ : A → PROP) (φ : A → Prop) :
+ (∀ x, FromPure (Φ x) (φ x)) → FromPure (∃ x, Φ x) (∃ x, φ x).
+Proof. rewrite /FromPure=>Hx. rewrite pure_exist. by setoid_rewrite Hx. Qed.
+Global Instance from_pure_forall {A} (Φ : A → PROP) (φ : A → Prop) :
+ (∀ x, FromPure (Φ x) (φ x)) → FromPure (∀ x, Φ x) (∀ x, φ x).
+Proof. rewrite /FromPure=>Hx. rewrite pure_forall. by setoid_rewrite Hx. Qed.
+
+Global Instance from_pure_pure_sep (φ1 φ2 : Prop) P1 P2 :
+ FromPure P1 φ1 → FromPure P2 φ2 → FromPure (P1 ∗ P2) (φ1 ∧ φ2).
+Proof. rewrite /FromPure=> <- <-. by rewrite pure_and persistent_and_sep_l_1. Qed.
Global Instance from_pure_pure_wand (φ1 φ2 : Prop) P1 P2 :
IntoPure P1 φ1 → FromPure P2 φ2 → FromPure (P1 -∗ P2) (φ1 → φ2).
-Proof. rewrite /FromPure /IntoPure pure_impl impl_wand. by intros -> ->. Qed.
-
-Global Instance from_pure_exist {X : Type} (Φ : X → uPred M) (φ : X → Prop) :
- (∀ x, @FromPure M (Φ x) (φ x)) → @FromPure M (∃ x, Φ x) (∃ x, φ x).
Proof.
- rewrite /FromPure=>Hx. apply pure_elim'=>-[x ?]. rewrite -(exist_intro x).
- rewrite -Hx. apply pure_intro. done.
-Qed.
-Global Instance from_pure_forall {X : Type} (Φ : X → uPred M) (φ : X → Prop) :
- (∀ x, @FromPure M (Φ x) (φ x)) → @FromPure M (∀ x, Φ x) (∀ x, φ x).
-Proof.
- rewrite /FromPure=>Hx. apply forall_intro=>x. apply pure_elim'=>Hφ.
- rewrite -Hx. apply pure_intro. done.
+ rewrite /FromPure /IntoPure=> -> <-.
+ by rewrite pure_wand_forall pure_impl pure_impl_forall.
Qed.
+Global Instance from_pure_persistently P φ : FromPure P φ → FromPure (□ P) φ.
+Proof. rewrite /FromPure=> <-. by rewrite persistently_pure. Qed.
+
(* IntoPersistent *)
Global Instance into_persistent_persistently_trans p P Q :
IntoPersistent true P Q → IntoPersistent p (□ P) Q | 0.
-Proof. rewrite /IntoPersistent /==> ->. by rewrite persistent_persistently_if. Qed.
+Proof.
+ rewrite /IntoPersistent /= => ->.
+ destruct p; simpl; auto using persistently_idemp_1.
+Qed.
+Global Instance into_persistent_bare_trans p P Q :
+ IntoPersistent p P Q → IntoPersistent p (■P) Q | 0.
+Proof. rewrite /IntoPersistent /= => <-. by rewrite bare_elim. Qed.
Global Instance into_persistent_persistently P : IntoPersistent true P P | 1.
-Proof. done. Qed.
+Proof. by rewrite /IntoPersistent. Qed.
Global Instance into_persistent_persistent P :
Persistent P → IntoPersistent false P P | 100.
-Proof. done. Qed.
+Proof. intros. by rewrite /IntoPersistent /= persistent_persistently. Qed.
-(* IntoLater *)
-Global Instance into_laterN_later n P Q :
- IntoLaterN n P Q → IntoLaterN' (S n) (▷ P) Q.
-Proof. by rewrite /IntoLaterN' /IntoLaterN =>->. Qed.
-Global Instance into_laterN_laterN n P : IntoLaterN' n (â–·^n P) P.
-Proof. done. Qed.
-Global Instance into_laterN_laterN_plus n m P Q :
- IntoLaterN m P Q → IntoLaterN' (n + m) (▷^n P) Q.
-Proof. rewrite /IntoLaterN' /IntoLaterN=>->. by rewrite laterN_plus. Qed.
+(* FromPersistent *)
+Global Instance from_persistent_persistently P : FromPersistent (â–¡ P) P | 1.
+Proof. by rewrite /FromPersistent. Qed.
+Global Instance from_persistent_bare `{AffineBI PROP} P Q :
+ FromPersistent P Q → FromPersistent (■P) Q.
+Proof. rewrite /FromPersistent=> ->. by rewrite affine_bare. Qed.
-Global Instance into_laterN_and_l n P1 P2 Q1 Q2 :
- IntoLaterN' n P1 Q1 → IntoLaterN n P2 Q2 →
- IntoLaterN' n (P1 ∧ P2) (Q1 ∧ Q2) | 10.
-Proof. rewrite /IntoLaterN' /IntoLaterN=> -> ->. by rewrite laterN_and. Qed.
-Global Instance into_laterN_and_r n P P2 Q2 :
- IntoLaterN' n P2 Q2 → IntoLaterN' n (P ∧ P2) (P ∧ Q2) | 11.
+(* IntoWand *)
+Global Instance into_wand_wand p q P Q P' :
+ FromAssumption q P P' → IntoWand p q (P' -∗ Q) P Q.
Proof.
- rewrite /IntoLaterN' /IntoLaterN=> ->. by rewrite laterN_and -(laterN_intro _ P).
+ rewrite /FromAssumption /IntoWand=> HP. by rewrite HP bare_persistently_if_elim.
Qed.
-Global Instance into_later_forall {A} n (Φ Ψ : A → uPred M) :
- (∀ x, IntoLaterN' n (Φ x) (Ψ x)) → IntoLaterN' n (∀ x, Φ x) (∀ x, Ψ x).
-Proof. rewrite /IntoLaterN' /IntoLaterN laterN_forall=> ?. by apply forall_mono. Qed.
-Global Instance into_later_exist {A} n (Φ Ψ : A → uPred M) :
- (∀ x, IntoLaterN' n (Φ x) (Ψ x)) →
- IntoLaterN' n (∃ x, Φ x) (∃ x, Ψ x).
-Proof. rewrite /IntoLaterN' /IntoLaterN -laterN_exist_2=> ?. by apply exist_mono. Qed.
+Global Instance into_wand_impl_false_false `{!AffineBI PROP} P Q P' :
+ 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.
+Qed.
-Global Instance into_laterN_or_l n P1 P2 Q1 Q2 :
- IntoLaterN' n P1 Q1 → IntoLaterN n P2 Q2 →
- IntoLaterN' n (P1 ∨ P2) (Q1 ∨ Q2) | 10.
-Proof. rewrite /IntoLaterN' /IntoLaterN=> -> ->. by rewrite laterN_or. Qed.
-Global Instance into_laterN_or_r n P P2 Q2 :
- IntoLaterN' n P2 Q2 →
- IntoLaterN' n (P ∨ P2) (P ∨ Q2) | 11.
+Global Instance into_wand_impl_false_true P Q P' :
+ FromAssumption true P P' → Absorbing P' →
+ IntoWand false true (P' → Q) P Q.
Proof.
- rewrite /IntoLaterN' /IntoLaterN=> ->. by rewrite laterN_or -(laterN_intro _ P).
+ rewrite /IntoWand /FromAssumption /= => HP ?. apply wand_intro_l.
+ rewrite -(bare_persistently_idemp P) HP.
+ by rewrite -persistently_and_bare_sep_l persistently_elim_absorbing impl_elim_r.
Qed.
-Global Instance into_laterN_sep_l n P1 P2 Q1 Q2 :
- IntoLaterN' n P1 Q1 → IntoLaterN n P2 Q2 →
- IntoLaterN' n (P1 ∗ P2) (Q1 ∗ Q2) | 10.
-Proof. rewrite /IntoLaterN' /IntoLaterN=> -> ->. by rewrite laterN_sep. Qed.
-Global Instance into_laterN_sep_r n P P2 Q2 :
- IntoLaterN' n P2 Q2 →
- IntoLaterN' n (P ∗ P2) (P ∗ Q2) | 11.
+Global Instance into_wand_impl_true_false P Q P' :
+ FromAssumption false P P' → Affine P' →
+ IntoWand true false (P' → Q) P Q.
Proof.
- rewrite /IntoLaterN' /IntoLaterN=> ->. by rewrite laterN_sep -(laterN_intro _ P).
+ rewrite /FromAssumption /IntoWand /= => HP ?. apply wand_intro_r.
+ rewrite -persistently_and_bare_sep_l HP -{2}(affine_bare P') bare_and_l -bare_and_r.
+ by rewrite bare_persistently_elim impl_elim_l.
Qed.
-Global Instance into_laterN_big_sepL n {A} (Φ Ψ : nat → A → uPred M) (l: list A) :
- (∀ x k, IntoLaterN' n (Φ k x) (Ψ k x)) →
- IntoLaterN' n ([∗ list] k ↦ x ∈ l, Φ k x) ([∗ list] k ↦ x ∈ l, Ψ k x).
+Global Instance into_wand_impl_true_true P Q P' :
+ FromAssumption true P P' → IntoWand true true (P' → Q) P Q.
Proof.
- rewrite /IntoLaterN' /IntoLaterN=> ?.
- rewrite big_opL_commute. by apply big_sepL_mono.
+ rewrite /FromAssumption /IntoWand /= => <-. apply wand_intro_l.
+ rewrite -{1}(bare_persistently_idemp P) -bare_persistently_sep -persistently_and_sep.
+ by rewrite impl_elim_r bare_persistently_elim.
Qed.
-Global Instance into_laterN_big_sepM n `{Countable K} {A}
- (Φ Ψ : K → A → uPred M) (m : gmap K A) :
- (∀ x k, IntoLaterN' n (Φ k x) (Ψ k x)) →
- IntoLaterN' n ([∗ map] k ↦ x ∈ m, Φ k x) ([∗ map] k ↦ x ∈ m, Ψ k x).
+
+Global Instance into_wand_and_l p q R1 R2 P' Q' :
+ IntoWand p q R1 P' Q' → IntoWand p q (R1 ∧ R2) P' Q'.
+Proof. rewrite /IntoWand=> ?. by rewrite /bi_wand_iff and_elim_l. Qed.
+Global Instance into_wand_and_r p q R1 R2 P' Q' :
+ IntoWand p q R2 Q' P' → IntoWand p q (R1 ∧ R2) Q' P'.
+Proof. rewrite /IntoWand=> ?. by rewrite /bi_wand_iff and_elim_r. Qed.
+
+Global Instance into_wand_forall {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_persistently_true q R P Q :
+ IntoWand true q R P Q → IntoWand true q (□ R) P Q.
+Proof. by rewrite /IntoWand /= persistently_idemp. Qed.
+Global Instance into_wand_persistently_false `{!AffineBI PROP} q R P Q :
+ IntoWand false q R P Q → IntoWand false q (□ R) P Q.
+Proof. by rewrite /IntoWand persistently_elim_absorbing. Qed.
+
+Global Instance into_wand_bare_persistently p q R P Q :
+ IntoWand p q R P Q → IntoWand p q (⬕ R) P Q.
+Proof. by rewrite /IntoWand bare_persistently_elim. Qed.
+
+(* FromAnd *)
+Global Instance from_and_and P1 P2 : FromAnd (P1 ∧ P2) P1 P2 | 100.
+Proof. by rewrite /FromAnd. Qed.
+Global Instance from_and_sep_persistent_l P1 P1' P2 :
+ FromBare P1 P1' → Persistent P1' → FromAnd (P1 ∗ P2) P1' P2 | 9.
Proof.
- rewrite /IntoLaterN' /IntoLaterN=> ?.
- rewrite big_opM_commute; by apply big_sepM_mono.
+ rewrite /FromBare /FromAnd=> <- ?. by rewrite persistent_and_bare_sep_l.
Qed.
-Global Instance into_laterN_big_sepS n `{Countable A}
- (Φ Ψ : A → uPred M) (X : gset A) :
- (∀ x, IntoLaterN' n (Φ x) (Ψ x)) →
- IntoLaterN' n ([∗ set] x ∈ X, Φ x) ([∗ set] x ∈ X, Ψ x).
+Global Instance from_and_sep_persistent_r P1 P2 P2' :
+ FromBare P2 P2' → Persistent P2' → FromAnd (P1 ∗ P2) P1 P2' | 10.
Proof.
- rewrite /IntoLaterN' /IntoLaterN=> ?.
- rewrite big_opS_commute; by apply big_sepS_mono.
+ rewrite /FromBare /FromAnd=> <- ?. by rewrite persistent_and_bare_sep_r.
Qed.
-Global Instance into_laterN_big_sepMS n `{Countable A}
- (Φ Ψ : A → uPred M) (X : gmultiset A) :
- (∀ x, IntoLaterN' n (Φ x) (Ψ x)) →
- IntoLaterN' n ([∗ mset] x ∈ X, Φ x) ([∗ mset] x ∈ X, Ψ x).
+Global Instance from_and_sep_persistent P1 P2 :
+ Persistent P1 → Persistent P2 → FromAnd (P1 ∗ P2) P1 P2 | 11.
Proof.
- rewrite /IntoLaterN' /IntoLaterN=> ?.
- rewrite big_opMS_commute; by apply big_sepMS_mono.
+ rewrite /FromBare /FromAnd. intros ??. by rewrite -persistent_sep_and.
Qed.
-(* FromLater *)
-Global Instance from_laterN_later P : FromLaterN 1 (â–· P) P | 0.
-Proof. done. Qed.
-Global Instance from_laterN_laterN n P : FromLaterN n (â–·^n P) P | 0.
-Proof. done. Qed.
-
-(* The instances below are used when stripping a specific number of laters, or
-to balance laters in different branches of ∧, ∨ and ∗. *)
-Global Instance from_laterN_0 P : FromLaterN 0 P P | 100. (* fallthrough *)
-Proof. done. Qed.
-Global Instance from_laterN_later_S n P Q :
- FromLaterN n P Q → FromLaterN (S n) (▷ P) Q.
-Proof. by rewrite /FromLaterN=><-. Qed.
-Global Instance from_laterN_later_plus n m P Q :
- FromLaterN m P Q → FromLaterN (n + m) (▷^n P) Q.
-Proof. rewrite /FromLaterN=><-. by rewrite laterN_plus. Qed.
+Global Instance from_and_pure φ ψ : @FromAnd PROP ⌜φ ∧ ψ⌠⌜φ⌠⌜ψâŒ.
+Proof. by rewrite /FromAnd pure_and. Qed.
-Global Instance from_later_and n P1 P2 Q1 Q2 :
- FromLaterN n P1 Q1 → FromLaterN n P2 Q2 → FromLaterN n (P1 ∧ P2) (Q1 ∧ Q2).
-Proof. intros ??; red. by rewrite laterN_and; apply and_mono. Qed.
-Global Instance from_later_or n P1 P2 Q1 Q2 :
- FromLaterN n P1 Q1 → FromLaterN n P2 Q2 → FromLaterN n (P1 ∨ P2) (Q1 ∨ Q2).
-Proof. intros ??; red. by rewrite laterN_or; apply or_mono. Qed.
-Global Instance from_later_sep n P1 P2 Q1 Q2 :
- FromLaterN n P1 Q1 → FromLaterN n P2 Q2 → FromLaterN n (P1 ∗ P2) (Q1 ∗ Q2).
-Proof. intros ??; red. by rewrite laterN_sep; apply sep_mono. Qed.
+Global Instance from_and_bare P Q1 Q2 :
+ FromAnd P Q1 Q2 → FromAnd (■P) (■Q1) (■Q2).
+Proof. rewrite /FromAnd=> <-. by rewrite bare_and. Qed.
+Global Instance from_and_persistently P Q1 Q2 :
+ FromAnd P Q1 Q2 → FromAnd (□ P) (□ Q1) (□ Q2).
+Proof. rewrite /FromAnd=> <-. by rewrite persistently_and. Qed.
+Global Instance from_and_persistently_sep P Q1 Q2 :
+ FromSep P Q1 Q2 → FromAnd (□ P) (□ Q1) (□ Q2) | 11.
+Proof. rewrite /FromAnd=> <-. by rewrite -persistently_and persistently_and_sep. Qed.
-Global Instance from_later_persistently n P Q :
- FromLaterN n P Q → FromLaterN n (□ P) (□ Q).
-Proof. by rewrite /FromLaterN -persistently_laterN=> ->. Qed.
+Hint Extern 10 => assumption : typeclass_instances. (* TODO: move *)
-Global Instance from_later_forall {A} n (Φ Ψ : A → uPred M) :
- (∀ x, FromLaterN n (Φ x) (Ψ x)) → FromLaterN n (∀ x, Φ x) (∀ x, Ψ x).
-Proof. rewrite /FromLaterN laterN_forall=> ?. by apply forall_mono. Qed.
-Global Instance from_later_exist {A} n (Φ Ψ : A → uPred M) :
- Inhabited A → (∀ x, FromLaterN n (Φ x) (Ψ x)) →
- FromLaterN n (∃ x, Φ x) (∃ x, Ψ x).
-Proof. intros ?. rewrite /FromLaterN laterN_exist=> ?. by apply exist_mono. Qed.
+Global Instance from_and_big_sepL_cons_persistent {A} (Φ : nat → A → PROP) x l :
+ Persistent (Φ 0 x) →
+ FromAnd ([∗ list] k ↦ y ∈ x :: l, Φ k y) (Φ 0 x) ([∗ list] k ↦ y ∈ l, Φ (S k) y).
+Proof. intros. by rewrite /FromAnd big_opL_cons persistent_and_sep_l_1. Qed.
+Global Instance from_and_big_sepL_app_persistent {A} (Φ : nat → A → PROP) l1 l2 :
+ (∀ k y, Persistent (Φ k y)) →
+ FromAnd ([∗ list] k ↦ y ∈ l1 ++ l2, Φ k y)
+ ([∗ list] k ↦ y ∈ l1, Φ k y) ([∗ list] k ↦ y ∈ l2, Φ (length l1 + k) y).
+Proof.
+ intros. rewrite /FromAnd big_opL_app.
+ destruct (decide (l1 = [])) as [->|]; simpl.
+ - by rewrite left_id and_elim_r.
+ - by rewrite persistent_and_sep_l_1.
+Qed.
+
+(* FromSep *)
+Global Instance from_sep_sep P1 P2 : FromSep (P1 ∗ P2) P1 P2 | 100.
+Proof. by rewrite /FromSep. Qed.
+Global Instance from_sep_and P1 P2 :
+ TCOr (Affine P1) (Absorbing P2) → TCOr (Affine P2) (Absorbing P1) →
+ FromSep (P1 ∧ P2) P1 P2 | 101.
+Proof. intros. by rewrite /FromSep sep_and. Qed.
+
+Global Instance from_sep_pure φ ψ : @FromSep PROP ⌜φ ∧ ψ⌠⌜φ⌠⌜ψâŒ.
+Proof. by rewrite /FromSep pure_and sep_and. Qed.
+
+Global Instance from_sep_bare P Q1 Q2 :
+ FromSep P Q1 Q2 → FromSep (■P) (■Q1) (■Q2).
+Proof. rewrite /FromSep=> <-. by rewrite bare_sep. Qed.
+Global Instance from_sep_persistently P Q1 Q2 :
+ FromSep P Q1 Q2 → FromSep (□ P) (□ Q1) (□ Q2).
+Proof. rewrite /FromSep=> <-. by rewrite persistently_sep. Qed.
+
+Global Instance from_sep_big_sepL_cons {A} (Φ : nat → A → PROP) x l :
+ FromSep ([∗ list] k ↦ y ∈ x :: l, Φ k y) (Φ 0 x) ([∗ list] k ↦ y ∈ l, Φ (S k) y).
+Proof. by rewrite /FromSep big_sepL_cons. Qed.
+Global Instance from_sep_big_sepL_app {A} (Φ : nat → A → PROP) l1 l2 :
+ FromSep ([∗ list] k ↦ y ∈ l1 ++ l2, Φ k y)
+ ([∗ list] k ↦ y ∈ l1, Φ k y) ([∗ list] k ↦ y ∈ l2, Φ (length l1 + k) y).
+Proof. by rewrite /FromSep big_opL_app. Qed.
-(* IntoWand *)
-Global Instance wand_weaken_assumption p P1 P2 Q :
- FromAssumption p P2 P1 → WandWeaken p P1 Q P2 Q | 0.
-Proof. by rewrite /WandWeaken /FromAssumption /= =>->. Qed.
-Global Instance wand_weaken_later p P Q P' Q' :
- WandWeaken p P Q P' Q' → WandWeaken' p P Q (▷ P') (▷ Q').
+(* IntoAnd *)
+Global Instance into_and_and p P Q : IntoAnd p (P ∧ Q) P Q.
+Proof. by rewrite /IntoAnd bare_persistently_if_and. Qed.
+Global Instance into_and_sep P Q : IntoAnd true (P ∗ Q) P Q.
Proof.
- rewrite /WandWeaken' /WandWeaken=> ->.
- by rewrite persistently_if_later -later_wand -later_intro.
+ by rewrite /IntoAnd /= bare_persistently_sep -bare_persistently_sep
+ persistently_and_sep.
Qed.
-Global Instance wand_weaken_laterN p n P Q P' Q' :
- WandWeaken p P Q P' Q' → WandWeaken' p P Q (▷^n P') (▷^n Q').
+
+Global Instance into_and_pure p φ ψ : @IntoAnd PROP p ⌜φ ∧ ψ⌠⌜φ⌠⌜ψâŒ.
+Proof. by rewrite /IntoAnd pure_and bare_persistently_if_and. Qed.
+
+Global Instance into_and_bare p P Q1 Q2 :
+ IntoAnd p P Q1 Q2 → IntoAnd p (■P) (■Q1) (■Q2).
Proof.
- rewrite /WandWeaken' /WandWeaken=> ->.
- by rewrite persistently_if_laterN -laterN_wand -laterN_intro.
+ rewrite /IntoAnd. destruct p; simpl.
+ - by rewrite -bare_and !persistently_bare.
+ - intros ->. by rewrite bare_and.
Qed.
-Global Instance bupd_weaken_laterN p P Q P' Q' :
- WandWeaken false P Q P' Q' → WandWeaken' p P Q (|==> P') (|==> Q').
+Global Instance into_and_persistently p P Q1 Q2 :
+ IntoAnd p P Q1 Q2 → IntoAnd p (□ P) (□ Q1) (□ Q2).
Proof.
- rewrite /WandWeaken' /WandWeaken=> ->.
- apply wand_intro_l. by rewrite persistently_if_elim bupd_wand_r.
+ rewrite /IntoAnd /=. destruct p; simpl.
+ - by rewrite -persistently_and !persistently_idemp.
+ - intros ->. by rewrite persistently_and.
Qed.
-Global Instance into_wand_wand p P P' Q Q' :
- WandWeaken p P Q P' Q' → IntoWand p (P -∗ Q) P' Q'.
-Proof. done. Qed.
-Global Instance into_wand_impl p P P' Q Q' :
- WandWeaken p P Q P' Q' → IntoWand p (P → Q) P' Q'.
-Proof. rewrite /WandWeaken /IntoWand /= => <-. apply impl_wand_1. Qed.
-
-Global Instance into_wand_iff_l p P P' Q Q' :
- WandWeaken p P Q P' Q' → IntoWand p (P ↔ Q) P' Q'.
-Proof. rewrite /WandWeaken /IntoWand=> <-. apply and_elim_l', impl_wand_1. Qed.
-Global Instance into_wand_iff_r p P P' Q Q' :
- WandWeaken p Q P Q' P' → IntoWand p (P ↔ Q) Q' P'.
-Proof. rewrite /WandWeaken /IntoWand=> <-. apply and_elim_r', impl_wand_1. Qed.
+(* IntoSep *)
+Global Instance into_sep_sep p P Q : IntoSep p (P ∗ Q) P Q.
+Proof. by rewrite /IntoSep bare_persistently_if_sep. Qed.
+Global Instance into_sep_and P Q : IntoSep true (P ∧ Q) P Q.
+Proof. by rewrite /IntoSep /= persistently_and_sep. Qed.
-Global Instance into_wand_forall {A} p (Φ : A → uPred M) P Q x :
- IntoWand p (Φ x) P Q → IntoWand p (∀ x, Φ x) P Q.
-Proof. rewrite /IntoWand=> <-. apply forall_elim. Qed.
-Global Instance into_wand_persistently p R P Q :
- IntoWand p R P Q → IntoWand p (□ R) P Q.
-Proof. rewrite /IntoWand=> ->. apply persistently_elim. Qed.
-
-Global Instance into_wand_later p R P Q :
- IntoWand p R P Q → IntoWand p (▷ R) (▷ P) (▷ Q).
-Proof. rewrite /IntoWand=> ->. by rewrite persistently_if_later -later_wand. Qed.
-Global Instance into_wand_laterN p n R P Q :
- IntoWand p R P Q → IntoWand p (▷^n R) (▷^n P) (▷^n Q).
-Proof. rewrite /IntoWand=> ->. by rewrite persistently_if_laterN -laterN_wand. Qed.
-
-Global Instance into_wand_bupd R P Q :
- IntoWand false R P Q → IntoWand false (|==> R) (|==> P) (|==> Q).
+Global Instance into_sep_and_persistent_l P P' Q :
+ Persistent P → FromBare P' P → IntoSep false (P ∧ Q) P' Q.
Proof.
- rewrite /IntoWand=> ->. apply wand_intro_l. by rewrite bupd_sep wand_elim_r.
+ rewrite /FromBare /IntoSep /=. intros ? <-.
+ by rewrite persistent_and_bare_sep_l.
Qed.
-Global Instance into_wand_bupd_persistent R P Q :
- IntoWand true R P Q → IntoWand true (|==> R) P (|==> Q).
+Global Instance into_sep_and_persistent_r P Q Q' :
+ Persistent Q → FromBare Q' Q → IntoSep false (P ∧ Q) P Q'.
Proof.
- rewrite /IntoWand=>->. apply wand_intro_l. by rewrite bupd_frame_l wand_elim_r.
+ rewrite /FromBare /IntoSep /=. intros ? <-.
+ by rewrite persistent_and_bare_sep_r.
Qed.
-(* FromAnd *)
-Global Instance from_and_and p P1 P2 : FromAnd p (P1 ∧ P2) P1 P2 | 100.
-Proof. by apply mk_from_and_and. Qed.
-
-Global Instance from_and_sep P1 P2 : FromAnd false (P1 ∗ P2) P1 P2 | 100.
-Proof. done. Qed.
-Global Instance from_and_sep_persistent_l P1 P2 :
- Persistent P1 → FromAnd true (P1 ∗ P2) P1 P2 | 9.
-Proof. intros. by rewrite /FromAnd and_sep_l. Qed.
-Global Instance from_and_sep_persistent_r P1 P2 :
- Persistent P2 → FromAnd true (P1 ∗ P2) P1 P2 | 10.
-Proof. intros. by rewrite /FromAnd and_sep_r. Qed.
-
-Global Instance from_and_pure p φ ψ : @FromAnd M p ⌜φ ∧ ψ⌠⌜φ⌠⌜ψâŒ.
-Proof. apply mk_from_and_and. by rewrite pure_and. Qed.
-Global Instance from_and_persistently p P Q1 Q2 :
- FromAnd false P Q1 Q2 → FromAnd p (□ P) (□ Q1) (□ Q2).
-Proof.
- intros. apply mk_from_and_and.
- by rewrite persistently_and_sep_l -persistently_sep -(from_and _ P).
-Qed.
-Global Instance from_and_later p P Q1 Q2 :
- FromAnd p P Q1 Q2 → FromAnd p (▷ P) (▷ Q1) (▷ Q2).
-Proof. rewrite /FromAnd=> <-. destruct p; by rewrite ?later_and ?later_sep. Qed.
-Global Instance from_and_laterN p n P Q1 Q2 :
- FromAnd p P Q1 Q2 → FromAnd p (▷^n P) (▷^n Q1) (▷^n Q2).
-Proof. rewrite /FromAnd=> <-. destruct p; by rewrite ?laterN_and ?laterN_sep. Qed.
-Global Instance from_and_except_0 p P Q1 Q2 :
- FromAnd p P Q1 Q2 → FromAnd p (◇ P) (◇ Q1) (◇ Q2).
-Proof.
- rewrite /FromAnd=><-. by destruct p; rewrite ?except_0_and ?except_0_sep.
-Qed.
-
-Global Instance from_sep_ownM (a b1 b2 : M) :
- IsOp a b1 b2 →
- FromAnd false (uPred_ownM a) (uPred_ownM b1) (uPred_ownM b2).
-Proof. intros. by rewrite /FromAnd -ownM_op -is_op. Qed.
-Global Instance from_sep_ownM_persistent (a b1 b2 : M) :
- IsOp a b1 b2 → Or (CoreId b1) (CoreId b2) →
- FromAnd true (uPred_ownM a) (uPred_ownM b1) (uPred_ownM b2).
-Proof.
- intros ? Hper; apply mk_from_and_persistent; [destruct Hper; apply _|].
- by rewrite -ownM_op -is_op.
-Qed.
-
-Global Instance from_sep_bupd P Q1 Q2 :
- FromAnd false P Q1 Q2 → FromAnd false (|==> P) (|==> Q1) (|==> Q2).
-Proof. rewrite /FromAnd=><-. apply bupd_sep. Qed.
-
-Global Instance from_and_big_sepL_cons {A} (Φ : nat → A → uPred M) x l :
- FromAnd false ([∗ list] k ↦ y ∈ x :: l, Φ k y) (Φ 0 x) ([∗ list] k ↦ y ∈ l, Φ (S k) y).
-Proof. by rewrite /FromAnd big_sepL_cons. Qed.
-Global Instance from_and_big_sepL_cons_persistent {A} (Φ : nat → A → uPred M) x l :
- Persistent (Φ 0 x) →
- FromAnd true ([∗ list] k ↦ y ∈ x :: l, Φ k y) (Φ 0 x) ([∗ list] k ↦ y ∈ l, Φ (S k) y).
-Proof. intros. by rewrite /FromAnd big_opL_cons and_sep_l. Qed.
-
-Global Instance from_and_big_sepL_app {A} (Φ : nat → A → uPred M) l1 l2 :
- FromAnd false ([∗ list] k ↦ y ∈ l1 ++ l2, Φ k y)
- ([∗ list] k ↦ y ∈ l1, Φ k y) ([∗ list] k ↦ y ∈ l2, Φ (length l1 + k) y).
-Proof. by rewrite /FromAnd big_opL_app. Qed.
-Global Instance from_sep_big_sepL_app_persistent {A} (Φ : nat → A → uPred M) l1 l2 :
- (∀ k y, Persistent (Φ k y)) →
- FromAnd true ([∗ list] k ↦ y ∈ l1 ++ l2, Φ k y)
- ([∗ list] k ↦ y ∈ l1, Φ k y) ([∗ list] k ↦ y ∈ l2, Φ (length l1 + k) y).
-Proof. intros. by rewrite /FromAnd big_opL_app and_sep_l. Qed.
-
-(* FromOp *)
-(* TODO: Worst case there could be a lot of backtracking on these instances,
-try to refactor. *)
-Global Instance is_op_pair {A B : cmraT} (a b1 b2 : A) (a' b1' b2' : B) :
- IsOp a b1 b2 → IsOp a' b1' b2' → IsOp' (a,a') (b1,b1') (b2,b2').
-Proof. by constructor. Qed.
-Global Instance is_op_pair_persistent_l {A B : cmraT} (a : A) (a' b1' b2' : B) :
- CoreId a → IsOp a' b1' b2' → IsOp' (a,a') (a,b1') (a,b2').
-Proof. constructor=> //=. by rewrite -core_id_dup. Qed.
-Global Instance is_op_pair_persistent_r {A B : cmraT} (a b1 b2 : A) (a' : B) :
- CoreId a' → IsOp a b1 b2 → IsOp' (a,a') (b1,a') (b2,a').
-Proof. constructor=> //=. by rewrite -core_id_dup. Qed.
-
-Global Instance is_op_Some {A : cmraT} (a : A) b1 b2 :
- IsOp a b1 b2 → IsOp' (Some a) (Some b1) (Some b2).
-Proof. by constructor. Qed.
-(* This one has a higher precendence than [is_op_op] so we get a [+] instead of
-an [â‹…]. *)
-Global Instance is_op_plus (n1 n2 : nat) : IsOp (n1 + n2) n1 n2.
-Proof. done. Qed.
+Global Instance into_sep_pure p φ ψ : @IntoSep PROP p ⌜φ ∧ ψ⌠⌜φ⌠⌜ψâŒ.
+Proof.
+ by rewrite /IntoSep pure_and persistent_and_sep_l_1 bare_persistently_if_sep.
+Qed.
-(* IntoAnd *)
-Global Instance into_and_sep p P Q : IntoAnd p (P ∗ Q) P Q.
-Proof. by apply mk_into_and_sep. Qed.
-Global Instance into_and_ownM p (a b1 b2 : M) :
- IsOp a b1 b2 → IntoAnd p (uPred_ownM a) (uPred_ownM b1) (uPred_ownM b2).
-Proof. intros. apply mk_into_and_sep. by rewrite (is_op a) ownM_op. Qed.
-
-Global Instance into_and_and P Q : IntoAnd true (P ∧ Q) P Q.
-Proof. done. Qed.
-Global Instance into_and_and_persistent_l P Q :
- Persistent P → IntoAnd false (P ∧ Q) P Q.
-Proof. intros; by rewrite /IntoAnd /= and_sep_l. Qed.
-Global Instance into_and_and_persistent_r P Q :
- Persistent Q → IntoAnd false (P ∧ Q) P Q.
-Proof. intros; by rewrite /IntoAnd /= and_sep_r. Qed.
-
-Global Instance into_and_pure p φ ψ : @IntoAnd M p ⌜φ ∧ ψ⌠⌜φ⌠⌜ψâŒ.
-Proof. apply mk_into_and_sep. by rewrite pure_and and_sep_r. Qed.
-Global Instance into_and_persistently p P Q1 Q2 :
- IntoAnd true P Q1 Q2 → IntoAnd p (□ P) (□ Q1) (□ Q2).
+Global Instance into_sep_bare p P Q1 Q2 :
+ IntoSep p P Q1 Q2 → IntoSep p (■P) (■Q1) (■Q2).
Proof.
- rewrite /IntoAnd=>->. destruct p; by rewrite ?persistently_and persistently_and_sep_r.
+ rewrite /IntoSep /=. destruct p; simpl.
+ - by rewrite -bare_sep !persistently_bare.
+ - intros ->. by rewrite bare_sep.
Qed.
-Global Instance into_and_later p P Q1 Q2 :
- IntoAnd p P Q1 Q2 → IntoAnd p (▷ P) (▷ Q1) (▷ Q2).
-Proof. rewrite /IntoAnd=>->. destruct p; by rewrite ?later_and ?later_sep. Qed.
-Global Instance into_and_laterN n p P Q1 Q2 :
- IntoAnd p P Q1 Q2 → IntoAnd p (▷^n P) (▷^n Q1) (▷^n Q2).
-Proof. rewrite /IntoAnd=>->. destruct p; by rewrite ?laterN_and ?laterN_sep. Qed.
-Global Instance into_and_except_0 p P Q1 Q2 :
- IntoAnd p P Q1 Q2 → IntoAnd p (◇ P) (◇ Q1) (◇ Q2).
+Global Instance into_sep_persistently p P Q1 Q2 :
+ IntoSep p P Q1 Q2 → IntoSep p (□ P) (□ Q1) (□ Q2).
Proof.
- rewrite /IntoAnd=>->. by destruct p; rewrite ?except_0_and ?except_0_sep.
+ rewrite /IntoSep /=. destruct p; simpl.
+ - by rewrite -persistently_sep !persistently_idemp.
+ - intros ->. by rewrite persistently_sep.
Qed.
(* We use [IsCons] and [IsApp] to make sure that [frame_big_sepL_cons] and
[frame_big_sepL_app] cannot be applied repeatedly often when having
[ [∗ list] k ↦ x ∈ ?e, Φ k x] with [?e] an evar. *)
-Global Instance into_and_big_sepL_cons {A} p (Φ : nat → A → uPred M) l x l' :
+Global Instance into_sep_big_sepL_cons {A} p (Φ : nat → A → PROP) l x l' :
IsCons l x l' →
- IntoAnd p ([∗ list] k ↦ y ∈ l, Φ k y)
+ IntoSep p ([∗ list] k ↦ y ∈ l, Φ k y)
(Φ 0 x) ([∗ list] k ↦ y ∈ l', Φ (S k) y).
-Proof. rewrite /IsCons=>->. apply mk_into_and_sep. by rewrite big_sepL_cons. Qed.
-Global Instance into_and_big_sepL_app {A} p (Φ : nat → A → uPred M) l l1 l2 :
+Proof. rewrite /IsCons=>->. by rewrite /IntoSep big_sepL_cons. Qed.
+Global Instance into_sep_big_sepL_app {A} p (Φ : nat → A → PROP) l l1 l2 :
IsApp l l1 l2 →
- IntoAnd p ([∗ list] k ↦ y ∈ l, Φ k y)
+ IntoSep p ([∗ list] k ↦ y ∈ l, Φ k y)
([∗ list] k ↦ y ∈ l1, Φ k y) ([∗ list] k ↦ y ∈ l2, Φ (length l1 + k) y).
-Proof. rewrite /IsApp=>->. apply mk_into_and_sep. by rewrite big_sepL_app. Qed.
+Proof. rewrite /IsApp=>->. by rewrite /IntoSep big_sepL_app. Qed.
+
+(* FromOr *)
+Global Instance from_or_or P1 P2 : FromOr (P1 ∨ P2) P1 P2.
+Proof. by rewrite /FromOr. Qed.
+Global Instance from_or_pure φ ψ : @FromOr PROP ⌜φ ∨ ψ⌠⌜φ⌠⌜ψâŒ.
+Proof. by rewrite /FromOr pure_or. Qed.
+Global Instance from_or_bare P Q1 Q2 :
+ FromOr P Q1 Q2 → FromOr (■P) (■Q1) (■Q2).
+Proof. rewrite /FromOr=> <-. by rewrite bare_or. Qed.
+Global Instance from_or_persistently P Q1 Q2 :
+ FromOr P Q1 Q2 → FromOr (□ P) (□ Q1) (□ Q2).
+Proof. rewrite /FromOr=> <-. by rewrite persistently_or. Qed.
+
+(* IntoOr *)
+Global Instance into_or_or P Q : IntoOr (P ∨ Q) P Q.
+Proof. by rewrite /IntoOr. Qed.
+Global Instance into_or_pure φ ψ : @IntoOr PROP ⌜φ ∨ ψ⌠⌜φ⌠⌜ψâŒ.
+Proof. by rewrite /IntoOr pure_or. Qed.
+Global Instance into_or_bare P Q1 Q2 :
+ IntoOr P Q1 Q2 → IntoOr (■P) (■Q1) (■Q2).
+Proof. rewrite /IntoOr=>->. by rewrite bare_or. Qed.
+Global Instance into_or_persistently P Q1 Q2 :
+ IntoOr P Q1 Q2 → IntoOr (□ P) (□ Q1) (□ Q2).
+Proof. rewrite /IntoOr=>->. by rewrite persistently_or. Qed.
+
+(* FromExist *)
+Global Instance from_exist_exist {A} (Φ : A → PROP): FromExist (∃ a, Φ a) Φ.
+Proof. by rewrite /FromExist. Qed.
+Global Instance from_exist_pure {A} (φ : A → Prop) :
+ @FromExist PROP A ⌜∃ x, φ x⌠(λ a, ⌜φ aâŒ)%I.
+Proof. by rewrite /FromExist pure_exist. Qed.
+Global Instance from_exist_bare {A} P (Φ : A → PROP) :
+ FromExist P Φ → FromExist (■P) (λ a, ■(Φ a))%I.
+Proof. rewrite /FromExist=> <-. by rewrite bare_exist. Qed.
+Global Instance from_exist_persistently {A} P (Φ : A → PROP) :
+ FromExist P Φ → FromExist (□ P) (λ a, □ (Φ a))%I.
+Proof. rewrite /FromExist=> <-. by rewrite persistently_exist. Qed.
+
+(* IntoExist *)
+Global Instance into_exist_exist {A} (Φ : A → PROP) : IntoExist (∃ a, Φ a) Φ.
+Proof. by rewrite /IntoExist. Qed.
+Global Instance into_exist_pure {A} (φ : A → Prop) :
+ @IntoExist PROP A ⌜∃ x, φ x⌠(λ a, ⌜φ aâŒ)%I.
+Proof. by rewrite /IntoExist pure_exist. Qed.
+Global Instance into_exist_bare {A} P (Φ : A → PROP) :
+ IntoExist P Φ → IntoExist (■P) (λ a, ■(Φ a))%I.
+Proof. rewrite /IntoExist=> HP. by rewrite HP bare_exist. Qed.
+Global Instance into_exist_and_pure P Q φ :
+ IntoPureT P φ → IntoExist (P ∧ Q) (λ _ : φ, Q).
+Proof.
+ intros (φ'&->&?). rewrite /IntoExist (into_pure P).
+ apply pure_elim_l=> Hφ. by rewrite -(exist_intro Hφ).
+Qed.
+Global Instance into_exist_sep_pure P Q φ :
+ TCOr (Affine P) (Absorbing Q) → IntoPureT P φ → IntoExist (P ∗ Q) (λ _ : φ, Q).
+Proof.
+ intros ? (φ'&->&?). rewrite /IntoExist.
+ eapply (pure_elim φ'); [by rewrite (into_pure P); apply absorbing, _|]=>?.
+ rewrite -exist_intro //. apply sep_elim_r, _.
+Qed.
+Global Instance into_exist_persistently {A} P (Φ : A → PROP) :
+ IntoExist P Φ → IntoExist (□ P) (λ a, □ (Φ a))%I.
+Proof. rewrite /IntoExist=> HP. by rewrite HP persistently_exist. Qed.
+
+(* IntoForall *)
+Global Instance into_forall_forall {A} (Φ : A → PROP) : IntoForall (∀ a, Φ a) Φ.
+Proof. by rewrite /IntoForall. Qed.
+Global Instance into_forall_bare {A} P (Φ : A → PROP) :
+ IntoForall P Φ → IntoForall (■P) (λ a, ■(Φ a))%I.
+Proof. rewrite /IntoForall=> HP. by rewrite HP bare_forall. Qed.
+Global Instance into_forall_persistently {A} P (Φ : A → PROP) :
+ IntoForall P Φ → IntoForall (□ P) (λ a, □ (Φ a))%I.
+Proof. rewrite /IntoForall=> HP. by rewrite HP persistently_forall. Qed.
+
+(* FromForall *)
+Global Instance from_forall_forall {A} (Φ : A → PROP) :
+ FromForall (∀ x, Φ x)%I Φ.
+Proof. by rewrite /FromForall. 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_impl_pure P Q φ :
+ IntoPureT P φ → FromForall (P → Q)%I (λ _ : φ, Q)%I.
+Proof.
+ intros (φ'&->&?). by rewrite /FromForall -pure_impl_forall (into_pure P).
+Qed.
+Global Instance from_forall_wand_pure P Q φ :
+ TCOr (Affine P) (Absorbing Q) → IntoPureT P φ →
+ FromForall (P -∗ Q)%I (λ _ : φ, Q)%I.
+Proof.
+ intros [|] (φ'&->&?); rewrite /FromForall; apply wand_intro_r.
+ - rewrite -(affine_bare P) (into_pure P) -persistent_and_bare_sep_r.
+ apply pure_elim_r=>?. by rewrite forall_elim.
+ - by rewrite (into_pure P) -pure_wand_forall wand_elim_l.
+Qed.
+
+Global Instance from_forall_persistently {A} P (Φ : A → PROP) :
+ FromForall P Φ → FromForall (□ P)%I (λ a, □ (Φ a))%I.
+Proof. rewrite /FromForall=> <-. by rewrite persistently_forall. Qed.
+
+(* ElimModal *)
+Global Instance elim_modal_wand P P' Q Q' R :
+ ElimModal P P' Q Q' → ElimModal P P' (R -∗ Q) (R -∗ Q').
+Proof.
+ rewrite /ElimModal=> H. apply wand_intro_r.
+ by rewrite wand_curry -assoc (comm _ P') -wand_curry wand_elim_l.
+Qed.
+Global Instance forall_modal_wand {A} P P' (Φ Ψ : A → PROP) :
+ (∀ x, ElimModal P P' (Φ x) (Ψ x)) → ElimModal P P' (∀ x, Φ x) (∀ x, Ψ x).
+Proof.
+ rewrite /ElimModal=> H. apply forall_intro=> a. by rewrite (forall_elim a).
+Qed.
(* Frame *)
-Global Instance frame_here p R : Frame p R R True.
-Proof. by rewrite /Frame right_id persistently_if_elim. Qed.
+Global Instance frame_here_absorbing p R : Absorbing R → Frame p R R True.
+Proof. intros. by rewrite /Frame bare_persistently_if_elim sep_elim_l. Qed.
+Global Instance frame_here p R : Frame p R R emp.
+Proof. intros. by rewrite /Frame bare_persistently_if_elim sep_elim_l. Qed.
Global Instance frame_here_pure p φ Q : FromPure Q φ → Frame p ⌜φ⌠Q True.
-Proof. rewrite /FromPure /Frame=> ->. by rewrite persistently_if_elim right_id. Qed.
+Proof.
+ rewrite /FromPure /Frame=> <-. by rewrite bare_persistently_if_elim sep_elim_l.
+Qed.
-Class MakeSep (P Q PQ : uPred M) := make_sep : P ∗ Q ⊣⊢ PQ.
-Global Instance make_sep_true_l P : MakeSep True P P.
+Class MakeSep (P Q PQ : PROP) := make_sep : P ∗ Q ⊣⊢ PQ.
+Arguments MakeSep _%I _%I _%I.
+Global Instance make_sep_emp_l P : MakeSep emp P P.
Proof. by rewrite /MakeSep left_id. Qed.
-Global Instance make_sep_true_r P : MakeSep P True P.
+Global Instance make_sep_emp_r P : MakeSep P emp P.
Proof. by rewrite /MakeSep right_id. Qed.
+Global Instance make_sep_true_l P : Absorbing P → MakeSep True P P.
+Proof. intros. by rewrite /MakeSep True_sep. Qed.
+Global Instance make_sep_true_r P : Absorbing P → MakeSep P True P.
+Proof. intros. by rewrite /MakeSep sep_True. Qed.
Global Instance make_sep_default P Q : MakeSep P Q (P ∗ Q) | 100.
-Proof. done. Qed.
+Proof. by rewrite /MakeSep. Qed.
Global Instance frame_sep_persistent_l R P1 P2 Q1 Q2 Q' :
Frame true R P1 Q1 → MaybeFrame true R P2 Q2 → MakeSep Q1 Q2 Q' →
Frame true R (P1 ∗ P2) Q' | 9.
Proof.
rewrite /Frame /MaybeFrame /MakeSep /= => <- <- <-.
- rewrite {1}(sep_dup (â–¡ R)). solve_sep_entails.
+ rewrite {1}(persistently_sep_dup R) bare_sep. solve_sep_entails.
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.
@@ -493,39 +515,67 @@ 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 → uPred M) R Q l x l' :
+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.
Proof. rewrite /IsCons=>->. by rewrite /Frame big_sepL_cons. Qed.
-Global Instance frame_big_sepL_app {A} p (Φ : nat → A → uPred M) R Q l l1 l2 :
+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.
Proof. rewrite /IsApp=>->. by rewrite /Frame big_opL_app. Qed.
-Class MakeAnd (P Q PQ : uPred M) := make_and : P ∧ Q ⊣⊢ PQ.
+Class MakeAnd (P Q PQ : PROP) := make_and : P ∧ Q ⊣⊢ PQ.
+Arguments MakeAnd _%I _%I _%I.
Global Instance make_and_true_l P : MakeAnd True P P.
Proof. by rewrite /MakeAnd left_id. Qed.
Global Instance make_and_true_r P : MakeAnd P True P.
Proof. by rewrite /MakeAnd right_id. Qed.
+Global Instance make_and_emp_l P : Affine P → MakeAnd emp P P.
+Proof. intros. by rewrite /MakeAnd emp_and. Qed.
+Global Instance make_and_emp_r P : Affine P → MakeAnd P emp P.
+Proof. intros. by rewrite /MakeAnd and_emp. Qed.
Global Instance make_and_default P Q : MakeAnd P Q (P ∧ Q) | 100.
-Proof. done. Qed.
-Global Instance frame_and_l p R P1 P2 Q Q' :
- Frame p R P1 Q → MakeAnd Q P2 Q' → Frame p R (P1 ∧ P2) Q' | 9.
-Proof. rewrite /Frame /MakeAnd => <- <-; eauto 10 with I. Qed.
-Global Instance frame_and_r p R P1 P2 Q Q' :
- Frame p R P2 Q → MakeAnd P1 Q Q' → Frame p R (P1 ∧ P2) Q' | 10.
-Proof. rewrite /Frame /MakeAnd => <- <-; eauto 10 with I. Qed.
-
-Class MakeOr (P Q PQ : uPred M) := make_or : P ∨ Q ⊣⊢ PQ.
+Proof. by rewrite /MakeAnd. Qed.
+
+Global Instance frame_and_l p R P1 P2 Q1 Q2 Q :
+ Frame p R P1 Q1 → MaybeFrame p R P2 Q2 →
+ MakeAnd Q1 Q2 Q → Frame p R (P1 ∧ P2) Q | 9.
+Proof.
+ rewrite /Frame /MakeAnd => <- <- <- /=.
+ auto using and_intro, and_elim_l, and_elim_r, sep_mono.
+Qed.
+Global Instance frame_and_persistent_r R P1 P2 Q2 Q :
+ Frame true R P2 Q2 →
+ MakeAnd P1 Q2 Q → Frame true R (P1 ∧ P2) Q | 10.
+Proof.
+ rewrite /Frame /MakeAnd => <- <- /=. rewrite -!persistently_and_bare_sep_l.
+ auto using and_intro, and_elim_l', and_elim_r'.
+Qed.
+Global Instance frame_and_r R P1 P2 Q2 Q :
+ TCOr (Affine R) (Absorbing P1) →
+ Frame false R P2 Q2 →
+ MakeAnd P1 Q2 Q → Frame false R (P1 ∧ P2) Q | 10.
+Proof.
+ rewrite /Frame /MakeAnd=> ? <- <- /=. apply and_intro.
+ - by rewrite and_elim_l sep_elim_r.
+ - by rewrite and_elim_r.
+Qed.
+
+Class MakeOr (P Q PQ : PROP) := make_or : P ∨ Q ⊣⊢ PQ.
+Arguments MakeOr _%I _%I _%I.
Global Instance make_or_true_l P : MakeOr True P True.
Proof. by rewrite /MakeOr left_absorb. Qed.
Global Instance make_or_true_r P : MakeOr P True True.
Proof. by rewrite /MakeOr right_absorb. Qed.
+Global Instance make_or_emp_l P : Affine P → MakeOr emp P emp.
+Proof. intros. by rewrite /MakeOr emp_or. Qed.
+Global Instance make_or_emp_r P : Affine P → MakeOr P emp emp.
+Proof. intros. by rewrite /MakeOr or_emp. Qed.
Global Instance make_or_default P Q : MakeOr P Q (P ∨ Q) | 100.
-Proof. done. Qed.
+Proof. by rewrite /MakeOr. Qed.
Global Instance frame_or_persistent_l R P1 P2 Q1 Q2 Q :
Frame true R P1 Q1 → MaybeFrame true R P2 Q2 → MakeOr Q1 Q2 Q →
@@ -535,7 +585,8 @@ Global Instance frame_or_persistent_r R P1 P2 Q1 Q2 Q :
MaybeFrame true R P2 Q2 → MakeOr P1 Q2 Q →
Frame true R (P1 ∨ P2) Q | 10.
Proof.
- rewrite /Frame /MaybeFrame /MakeOr => <- <-. by rewrite sep_or_l sep_elim_r.
+ rewrite /Frame /MaybeFrame /MakeOr => <- <- /=.
+ by rewrite sep_or_l sep_elim_r.
Qed.
Global Instance frame_or R P1 P2 Q1 Q2 Q :
Frame false R P1 Q1 → Frame false R P2 Q2 → MakeOr Q1 Q2 Q →
@@ -549,79 +600,155 @@ Proof.
by rewrite assoc (comm _ P1) -assoc wand_elim_r.
Qed.
-Class MakeLater (P lP : uPred M) := make_later : ▷ P ⊣⊢ lP.
-Global Instance make_later_true : MakeLater True True.
-Proof. by rewrite /MakeLater later_True. Qed.
-Global Instance make_later_default P : MakeLater P (â–· P) | 100.
-Proof. done. Qed.
+Class MakeBare (P Q : PROP) := make_bare : ■P ⊣⊢ Q.
+Arguments MakeBare _%I _%I.
+Global Instance make_bare_affine P : Affine P → MakeBare P P.
+Proof. intros. by rewrite /MakeBare affine_bare. Qed.
+Global Instance make_bare_default P : MakeBare P (â– P) | 100.
+Proof. by rewrite /MakeBare. Qed.
-Global Instance frame_later p R R' P Q Q' :
- IntoLaterN 1 R' R → Frame p R P Q → MakeLater Q Q' → Frame p R' (▷ P) Q'.
-Proof.
- rewrite /Frame /MakeLater /IntoLaterN=>-> <- <-.
- by rewrite persistently_if_later later_sep.
-Qed.
+Global Instance frame_bare R P Q Q' :
+ Frame true R P Q → MakeBare Q Q' → Frame true R (■P) Q'.
+Proof. rewrite /Frame /MakeBare=> <- <- /=. by rewrite bare_sep bare_idemp. Qed.
-Class MakeLaterN (n : nat) (P lP : uPred M) := make_laterN : ▷^n P ⊣⊢ lP.
-Global Instance make_laterN_true n : MakeLaterN n True True.
-Proof. by rewrite /MakeLaterN laterN_True. Qed.
-Global Instance make_laterN_default P : MakeLaterN n P (â–·^n P) | 100.
-Proof. done. Qed.
-
-Global Instance frame_laterN p n R R' P Q Q' :
- IntoLaterN n R' R → Frame p R P Q → MakeLaterN n Q Q' → Frame p R' (▷^n P) Q'.
-Proof.
- rewrite /Frame /MakeLater /IntoLaterN=>-> <- <-.
- by rewrite persistently_if_laterN laterN_sep.
-Qed.
-
-Class MakePersistently (P Q : uPred M) := make_persistently : □ P ⊣⊢ Q.
+Class MakePersistently (P Q : PROP) := make_persistently : □ P ⊣⊢ Q.
+Arguments MakePersistently _%I _%I.
Global Instance make_persistently_true : MakePersistently True True.
Proof. by rewrite /MakePersistently persistently_pure. Qed.
+Global Instance make_persistently_emp : MakePersistently emp True.
+Proof. by rewrite /MakePersistently -persistently_True_emp persistently_pure. Qed.
Global Instance make_persistently_default P : MakePersistently P (â–¡ P) | 100.
-Proof. done. Qed.
+Proof. by rewrite /MakePersistently. Qed.
Global Instance frame_persistently R P Q Q' :
Frame true R P Q → MakePersistently Q Q' → Frame true R (□ P) Q'.
Proof.
- rewrite /Frame /MakePersistently=> <- <-.
- by rewrite persistently_sep /= persistent_persistently.
-Qed.
-
-Class MakeExcept0 (P Q : uPred M) := make_except_0 : ◇ P ⊣⊢ Q.
-Global Instance make_except_0_True : MakeExcept0 True True.
-Proof. by rewrite /MakeExcept0 except_0_True. Qed.
-Global Instance make_except_0_default P : MakeExcept0 P (â—‡ P) | 100.
-Proof. done. Qed.
-
-Global Instance frame_except_0 p R P Q Q' :
- Frame p R P Q → MakeExcept0 Q Q' → Frame p R (◇ P) Q'.
-Proof.
- rewrite /Frame /MakeExcept0=><- <-.
- by rewrite except_0_sep -(except_0_intro (â–¡?p R)).
+ rewrite /Frame /MakePersistently=> <- <- /=.
+ by rewrite -persistently_and_bare_sep_l persistently_sep persistently_bare
+ persistently_idemp -persistently_and_sep_l_1.
Qed.
-Global Instance frame_exist {A} p R (Φ Ψ : A → uPred M) :
+Global Instance frame_exist {A} p R (Φ Ψ : A → PROP) :
(∀ a, Frame p R (Φ a) (Ψ a)) → Frame p R (∃ x, Φ x) (∃ x, Ψ x).
Proof. rewrite /Frame=> ?. by rewrite sep_exist_l; apply exist_mono. Qed.
-Global Instance frame_forall {A} p R (Φ Ψ : A → uPred M) :
+Global Instance frame_forall {A} p R (Φ Ψ : A → PROP) :
(∀ a, Frame p R (Φ a) (Ψ a)) → Frame p R (∀ x, Φ x) (∀ x, Ψ x).
Proof. rewrite /Frame=> ?. by rewrite sep_forall_l; apply forall_mono. Qed.
+End bi_instances.
+
+Section sbi_instances.
+Context {PROP : sbi}.
+Implicit Types P Q R : PROP.
+
+(* FromAssumption *)
+Global Instance from_assumption_later p P Q :
+ FromAssumption p P Q → FromAssumption p P (▷ Q)%I.
+Proof. rewrite /FromAssumption=>->. apply later_intro. Qed.
+Global Instance from_assumption_laterN n p P Q :
+ FromAssumption p P Q → FromAssumption p P (▷^n Q)%I.
+Proof. rewrite /FromAssumption=>->. apply laterN_intro. Qed.
+Global Instance from_assumption_except_0 p P Q :
+ FromAssumption p P Q → FromAssumption p P (◇ Q)%I.
+Proof. rewrite /FromAssumption=>->. apply except_0_intro. Qed.
+
+(* FromPure *)
+Global Instance from_pure_later P φ : FromPure P φ → FromPure (▷ P) φ.
+Proof. rewrite /FromPure=> ->. apply later_intro. Qed.
+Global Instance from_pure_laterN n P φ : FromPure P φ → FromPure (▷^n P) φ.
+Proof. rewrite /FromPure=> ->. apply laterN_intro. Qed.
+Global Instance from_pure_except_0 P φ : FromPure P φ → FromPure (◇ P) φ.
+Proof. rewrite /FromPure=> ->. apply except_0_intro. Qed.
+
+(* IntoWand *)
+Global Instance into_wand_later p q R P Q :
+ IntoWand p q R P Q → IntoWand p q (▷ R) (▷ P) (▷ Q).
+Proof.
+ rewrite /IntoWand /= => HR. by rewrite !bare_persistently_if_later -later_wand HR.
+Qed.
+
+Global Instance into_wand_later_args p q R P Q :
+ IntoWand p q R P Q → IntoWand' p q R (▷ P) (▷ Q).
+Proof.
+ rewrite /IntoWand' /IntoWand /= => HR.
+ by rewrite !bare_persistently_if_later (later_intro (⬕?p R)%I) -later_wand HR.
+Qed.
+
+Global Instance into_wand_laterN n p q R P Q :
+ IntoWand p q R P Q → IntoWand p q (▷^n R) (▷^n P) (▷^n Q).
+Proof.
+ rewrite /IntoWand /= => HR. by rewrite !bare_persistently_if_laterN -laterN_wand HR.
+Qed.
+
+Global Instance into_wand_laterN_args n p q R P Q :
+ IntoWand p q R P Q → IntoWand' p q R (▷^n P) (▷^n Q).
+Proof.
+ rewrite /IntoWand' /IntoWand /= => HR.
+ by rewrite !bare_persistently_if_laterN (laterN_intro _ (⬕?p R)%I) -laterN_wand HR.
+Qed.
-Global Instance frame_bupd p R P Q : Frame p R P Q → Frame p R (|==> P) (|==> Q).
-Proof. rewrite /Frame=><-. by rewrite bupd_frame_l. Qed.
+(* FromAnd *)
+Global Instance from_and_later P Q1 Q2 :
+ FromAnd P Q1 Q2 → FromAnd (▷ P) (▷ Q1) (▷ Q2).
+Proof. rewrite /FromAnd=> <-. by rewrite later_and. Qed.
+Global Instance from_and_laterN n P Q1 Q2 :
+ FromAnd P Q1 Q2 → FromAnd (▷^n P) (▷^n Q1) (▷^n Q2).
+Proof. rewrite /FromAnd=> <-. by rewrite laterN_and. Qed.
+Global Instance from_and_except_0 P Q1 Q2 :
+ FromAnd P Q1 Q2 → FromAnd (◇ P) (◇ Q1) (◇ Q2).
+Proof. rewrite /FromAnd=><-. by rewrite except_0_and. Qed.
+
+(* FromSep *)
+Global Instance from_sep_later P Q1 Q2 :
+ FromSep P Q1 Q2 → FromSep (▷ P) (▷ Q1) (▷ Q2).
+Proof. rewrite /FromSep=> <-. by rewrite later_sep. Qed.
+Global Instance from_sep_laterN n P Q1 Q2 :
+ FromSep P Q1 Q2 → FromSep (▷^n P) (▷^n Q1) (▷^n Q2).
+Proof. rewrite /FromSep=> <-. by rewrite laterN_sep. Qed.
+Global Instance from_sep_except_0 P Q1 Q2 :
+ FromSep P Q1 Q2 → FromSep (◇ P) (◇ Q1) (◇ Q2).
+Proof. rewrite /FromSep=><-. by rewrite except_0_sep. Qed.
+
+(* IntoAnd *)
+Global Instance into_and_later p P Q1 Q2 :
+ IntoAnd p P Q1 Q2 → IntoAnd p (▷ P) (▷ Q1) (▷ Q2).
+Proof.
+ rewrite /IntoAnd=> HP. apply bare_persistently_if_intro'.
+ by rewrite bare_persistently_if_later HP bare_persistently_if_elim later_and.
+Qed.
+Global Instance into_and_laterN n p P Q1 Q2 :
+ IntoAnd p P Q1 Q2 → IntoAnd p (▷^n P) (▷^n Q1) (▷^n Q2).
+Proof.
+ rewrite /IntoAnd=> HP. apply bare_persistently_if_intro'.
+ by rewrite bare_persistently_if_laterN HP bare_persistently_if_elim laterN_and.
+Qed.
+Global Instance into_and_except_0 p P Q1 Q2 :
+ IntoAnd p P Q1 Q2 → IntoAnd p (◇ P) (◇ Q1) (◇ Q2).
+Proof.
+ rewrite /IntoAnd=> HP. apply bare_persistently_if_intro'.
+ by rewrite bare_persistently_if_except_0 HP bare_persistently_if_elim except_0_and.
+Qed.
+
+(* IntoSep *)
+Global Instance into_sep_later p P Q1 Q2 :
+ IntoSep p P Q1 Q2 → IntoSep p (▷ P) (▷ Q1) (▷ Q2).
+Proof.
+ rewrite /IntoSep=> HP. apply bare_persistently_if_intro'.
+ by rewrite bare_persistently_if_later HP bare_persistently_if_elim later_sep.
+Qed.
+Global Instance into_sep_laterN n p P Q1 Q2 :
+ IntoSep p P Q1 Q2 → IntoSep p (▷^n P) (▷^n Q1) (▷^n Q2).
+Proof.
+ rewrite /IntoSep=> HP. apply bare_persistently_if_intro'.
+ by rewrite bare_persistently_if_laterN HP bare_persistently_if_elim laterN_sep.
+Qed.
+Global Instance into_sep_except_0 p P Q1 Q2 :
+ IntoSep p P Q1 Q2 → IntoSep p (◇ P) (◇ Q1) (◇ Q2).
+Proof.
+ rewrite /IntoSep=> HP. apply bare_persistently_if_intro'.
+ by rewrite bare_persistently_if_except_0 HP bare_persistently_if_elim except_0_sep.
+Qed.
(* FromOr *)
-Global Instance from_or_or P1 P2 : FromOr (P1 ∨ P2) P1 P2.
-Proof. done. Qed.
-Global Instance from_or_bupd P Q1 Q2 :
- FromOr P Q1 Q2 → FromOr (|==> P) (|==> Q1) (|==> Q2).
-Proof. rewrite /FromOr=><-. apply or_elim; apply bupd_mono; auto with I. Qed.
-Global Instance from_or_pure φ ψ : @FromOr M ⌜φ ∨ ψ⌠⌜φ⌠⌜ψâŒ.
-Proof. by rewrite /FromOr pure_or. Qed.
-Global Instance from_or_persistently P Q1 Q2 :
- FromOr P Q1 Q2 → FromOr (□ P) (□ Q1) (□ Q2).
-Proof. rewrite /FromOr=> <-. by rewrite persistently_or. Qed.
Global Instance from_or_later P Q1 Q2 :
FromOr P Q1 Q2 → FromOr (▷ P) (▷ Q1) (▷ Q2).
Proof. rewrite /FromOr=><-. by rewrite later_or. Qed.
@@ -633,13 +760,6 @@ Global Instance from_or_except_0 P Q1 Q2 :
Proof. rewrite /FromOr=><-. by rewrite except_0_or. Qed.
(* IntoOr *)
-Global Instance into_or_or P Q : IntoOr (P ∨ Q) P Q.
-Proof. done. Qed.
-Global Instance into_or_pure φ ψ : @IntoOr M ⌜φ ∨ ψ⌠⌜φ⌠⌜ψâŒ.
-Proof. by rewrite /IntoOr pure_or. Qed.
-Global Instance into_or_persistently P Q1 Q2 :
- IntoOr P Q1 Q2 → IntoOr (□ P) (□ Q1) (□ Q2).
-Proof. rewrite /IntoOr=>->. by rewrite persistently_or. Qed.
Global Instance into_or_later P Q1 Q2 :
IntoOr P Q1 Q2 → IntoOr (▷ P) (▷ Q1) (▷ Q2).
Proof. rewrite /IntoOr=>->. by rewrite later_or. Qed.
@@ -651,154 +771,236 @@ Global Instance into_or_except_0 P Q1 Q2 :
Proof. rewrite /IntoOr=>->. by rewrite except_0_or. Qed.
(* FromExist *)
-Global Instance from_exist_exist {A} (Φ : A → uPred M): FromExist (∃ a, Φ a) Φ.
-Proof. done. Qed.
-Global Instance from_exist_bupd {A} P (Φ : A → uPred M) :
- FromExist P Φ → FromExist (|==> P) (λ a, |==> Φ a)%I.
-Proof.
- rewrite /FromExist=><-. apply exist_elim=> a. by rewrite -(exist_intro a).
-Qed.
-Global Instance from_exist_pure {A} (φ : A → Prop) :
- @FromExist M A ⌜∃ x, φ x⌠(λ a, ⌜φ aâŒ)%I.
-Proof. by rewrite /FromExist pure_exist. Qed.
-Global Instance from_exist_persistently {A} P (Φ : A → uPred M) :
- FromExist P Φ → FromExist (□ P) (λ a, □ (Φ a))%I.
-Proof. rewrite /FromExist=> <-. by rewrite persistently_exist. Qed.
-Global Instance from_exist_later {A} P (Φ : A → uPred M) :
+Global Instance from_exist_later {A} P (Φ : A → PROP) :
FromExist P Φ → FromExist (▷ P) (λ a, ▷ (Φ a))%I.
Proof.
rewrite /FromExist=> <-. apply exist_elim=>x. apply later_mono, exist_intro.
Qed.
-Global Instance from_exist_laterN {A} n P (Φ : A → uPred M) :
+Global Instance from_exist_laterN {A} n P (Φ : A → PROP) :
FromExist P Φ → FromExist (▷^n P) (λ a, ▷^n (Φ a))%I.
Proof.
rewrite /FromExist=> <-. apply exist_elim=>x. apply laterN_mono, exist_intro.
Qed.
-Global Instance from_exist_except_0 {A} P (Φ : A → uPred M) :
+Global Instance from_exist_except_0 {A} P (Φ : A → PROP) :
FromExist P Φ → FromExist (◇ P) (λ a, ◇ (Φ a))%I.
Proof. rewrite /FromExist=> <-. by rewrite except_0_exist_2. Qed.
(* IntoExist *)
-Global Instance into_exist_exist {A} (Φ : A → uPred M) : IntoExist (∃ a, Φ a) Φ.
-Proof. done. Qed.
-Global Instance into_exist_pure {A} (φ : A → Prop) :
- @IntoExist M A ⌜∃ x, φ x⌠(λ a, ⌜φ aâŒ)%I.
-Proof. by rewrite /IntoExist pure_exist. Qed.
-
-Global Instance into_exist_and_pure P Q φ :
- IntoPureT P φ → IntoExist (P ∧ Q) (λ _ : φ, Q).
-Proof.
- intros (φ'&->&?). rewrite /IntoExist (into_pure P).
- apply pure_elim_l=> Hφ. by rewrite -(exist_intro Hφ).
-Qed.
-Global Instance into_exist_sep_pure P Q φ :
- IntoPureT P φ → IntoExist (P ∗ Q) (λ _ : φ, Q).
-Proof.
- intros (φ'&->&?). rewrite /IntoExist (into_pure P).
- apply pure_elim_sep_l=> Hφ. by rewrite -(exist_intro Hφ).
-Qed.
-
-Global Instance into_exist_persistently {A} P (Φ : A → uPred M) :
- IntoExist P Φ → IntoExist (□ P) (λ a, □ (Φ a))%I.
-Proof. rewrite /IntoExist=> HP. by rewrite HP persistently_exist. Qed.
-Global Instance into_exist_later {A} P (Φ : A → uPred M) :
+Global Instance into_exist_later {A} P (Φ : A → PROP) :
IntoExist P Φ → Inhabited A → IntoExist (▷ P) (λ a, ▷ (Φ a))%I.
Proof. rewrite /IntoExist=> HP ?. by rewrite HP later_exist. Qed.
-Global Instance into_exist_laterN {A} n P (Φ : A → uPred M) :
+Global Instance into_exist_laterN {A} n P (Φ : A → PROP) :
IntoExist P Φ → Inhabited A → IntoExist (▷^n P) (λ a, ▷^n (Φ a))%I.
Proof. rewrite /IntoExist=> HP ?. by rewrite HP laterN_exist. Qed.
-Global Instance into_exist_except_0 {A} P (Φ : A → uPred M) :
+Global Instance into_exist_except_0 {A} P (Φ : A → PROP) :
IntoExist P Φ → Inhabited A → IntoExist (◇ P) (λ a, ◇ (Φ a))%I.
Proof. rewrite /IntoExist=> HP ?. by rewrite HP except_0_exist. Qed.
(* IntoForall *)
-Global Instance into_forall_forall {A} (Φ : A → uPred M) : IntoForall (∀ a, Φ a) Φ.
-Proof. done. Qed.
-Global Instance into_forall_persistently {A} P (Φ : A → uPred M) :
- IntoForall P Φ → IntoForall (□ P) (λ a, □ (Φ a))%I.
-Proof. rewrite /IntoForall=> HP. by rewrite HP persistently_forall. Qed.
-Global Instance into_forall_later {A} P (Φ : A → uPred M) :
+Global Instance into_forall_later {A} P (Φ : A → PROP) :
IntoForall P Φ → IntoForall (▷ P) (λ a, ▷ (Φ a))%I.
Proof. rewrite /IntoForall=> HP. by rewrite HP later_forall. Qed.
(* FromForall *)
-Global Instance from_forall_forall {A} (Φ : A → uPred M) :
- FromForall (∀ x, Φ x) Φ.
-Proof. done. Qed.
-Global Instance from_forall_pure {A} (φ : A → Prop) :
- @FromForall M A (⌜∀ a : A, φ aâŒ) (λ a, ⌜ φ a âŒ)%I.
-Proof. by rewrite /FromForall pure_forall. Qed.
-Global Instance from_forall_impl_pure P Q φ :
- IntoPureT P φ → FromForall (P → Q) (λ _ : φ, Q)%I.
-Proof.
- intros (φ'&->&?). by rewrite /FromForall -pure_impl_forall (into_pure P).
-Qed.
-Global Instance from_forall_wand_pure P Q φ :
- IntoPureT P φ → FromForall (P -∗ Q) (λ _ : φ, Q)%I.
-Proof.
- intros (φ'&->&?). rewrite /FromForall -pure_impl_forall.
- by rewrite impl_wand (into_pure P).
-Qed.
-
-Global Instance from_forall_persistently {A} P (Φ : A → uPred M) :
- FromForall P Φ → FromForall (□ P) (λ a, □ (Φ a))%I.
-Proof. rewrite /FromForall=> <-. by rewrite persistently_forall. Qed.
-Global Instance from_forall_later {A} P (Φ : A → uPred M) :
- FromForall P Φ → FromForall (▷ P) (λ a, ▷ (Φ a))%I.
+Global Instance from_forall_later {A} P (Φ : A → PROP) :
+ FromForall P Φ → FromForall (▷ P)%I (λ a, ▷ (Φ a))%I.
Proof. rewrite /FromForall=> <-. by rewrite later_forall. Qed.
+(* IsExcept0 *)
+Global Instance is_except_0_except_0 P : IsExcept0 (â—‡ P).
+Proof. by rewrite /IsExcept0 except_0_idemp. Qed.
+Global Instance is_except_0_later P : IsExcept0 (â–· P).
+Proof. by rewrite /IsExcept0 except_0_later. Qed.
+
(* FromModal *)
Global Instance from_modal_later P : FromModal (â–· P) P.
Proof. apply later_intro. Qed.
-Global Instance from_modal_bupd P : FromModal (|==> P) P.
-Proof. apply bupd_intro. Qed.
Global Instance from_modal_except_0 P : FromModal (â—‡ P) P.
Proof. apply except_0_intro. Qed.
(* ElimModal *)
-Global Instance elim_modal_wand P P' Q Q' R :
- ElimModal P P' Q Q' → ElimModal P P' (R -∗ Q) (R -∗ Q').
+Global Instance elim_modal_except_0 P Q : IsExcept0 Q → ElimModal (◇ P) P Q Q.
Proof.
- rewrite /ElimModal=> H. apply wand_intro_r.
- by rewrite wand_curry -assoc (comm _ P') -wand_curry wand_elim_l.
+ intros. rewrite /ElimModal (except_0_intro (_ -∗ _)%I).
+ by rewrite -except_0_sep wand_elim_r.
Qed.
-Global Instance forall_modal_wand {A} P P' (Φ Ψ : A → uPred M) :
- (∀ x, ElimModal P P' (Φ x) (Ψ x)) → ElimModal P P' (∀ x, Φ x) (∀ x, Ψ x).
+Global Instance elim_modal_timeless_later P Q :
+ Timeless P → IsExcept0 Q → ElimModal (▷ P) P Q Q.
Proof.
- rewrite /ElimModal=> H. apply forall_intro=> a. by rewrite (forall_elim a).
+ intros. rewrite /ElimModal (except_0_intro (_ -∗ _)%I) (timeless P).
+ by rewrite -except_0_sep wand_elim_r.
+Qed.
+Global Instance elim_modal_timeless_later_if p P Q :
+ Timeless P → IsExcept0 Q → ElimModal (▷?p P) P Q Q.
+Proof.
+ destruct p; simpl; auto using elim_modal_timeless_later.
+ intros _ _. by rewrite /ElimModal wand_elim_r.
Qed.
-Global Instance elim_modal_persistently P Q : ElimModal (â–¡ P) P Q Q.
-Proof. intros. by rewrite /ElimModal persistently_elim wand_elim_r. Qed.
+(* Frame *)
+Class MakeLater (P lP : PROP) := make_later : ▷ P ⊣⊢ lP.
+Arguments MakeLater _%I _%I.
-Global Instance elim_modal_bupd P Q : ElimModal (|==> P) P (|==> Q) (|==> Q).
-Proof. by rewrite /ElimModal bupd_frame_r wand_elim_r bupd_trans. Qed.
+Global Instance make_later_true : MakeLater True True.
+Proof. by rewrite /MakeLater later_True. Qed.
+Global Instance make_later_default P : MakeLater P (â–· P) | 100.
+Proof. by rewrite /MakeLater. Qed.
-Global Instance elim_modal_except_0 P Q : IsExcept0 Q → ElimModal (◇ P) P Q Q.
+Global Instance frame_later p R R' P Q Q' :
+ IntoLaterN 1 R' R → Frame p R P Q → MakeLater Q Q' → Frame p R' (▷ P) Q'.
Proof.
- intros. rewrite /ElimModal (except_0_intro (_ -∗ _)).
- by rewrite -except_0_sep wand_elim_r.
+ rewrite /Frame /MakeLater /IntoLaterN=>-> <- <- /=.
+ by rewrite bare_persistently_if_later later_sep.
Qed.
-Global Instance elim_modal_timeless_bupd P Q :
- Timeless P → IsExcept0 Q → ElimModal (▷ P) P Q Q.
+
+Class MakeLaterN (n : nat) (P lP : PROP) := make_laterN : ▷^n P ⊣⊢ lP.
+Arguments MakeLaterN _%nat _%I _%I.
+
+Global Instance make_laterN_true n : MakeLaterN n True True.
+Proof. by rewrite /MakeLaterN laterN_True. Qed.
+Global Instance make_laterN_default P : MakeLaterN n P (â–·^n P) | 100.
+Proof. by rewrite /MakeLaterN. Qed.
+
+Global Instance frame_laterN p n R R' P Q Q' :
+ IntoLaterN n R' R → Frame p R P Q → MakeLaterN n Q Q' → Frame p R' (▷^n P) Q'.
Proof.
- intros. rewrite /ElimModal (except_0_intro (_ -∗ _)) (timelessP P).
- by rewrite -except_0_sep wand_elim_r.
+ rewrite /Frame /MakeLaterN /IntoLaterN=>-> <- <-.
+ by rewrite bare_persistently_if_laterN laterN_sep.
Qed.
-Global Instance elim_modal_timeless_bupd' p P Q :
- Timeless P → IsExcept0 Q → ElimModal (▷?p P) P Q Q.
+
+Class MakeExcept0 (P Q : PROP) := make_except_0 : ◇ P ⊣⊢ Q.
+Arguments MakeExcept0 _%I _%I.
+
+Global Instance make_except_0_True : MakeExcept0 True True.
+Proof. by rewrite /MakeExcept0 except_0_True. Qed.
+Global Instance make_except_0_default P : MakeExcept0 P (â—‡ P) | 100.
+Proof. by rewrite /MakeExcept0. Qed.
+
+Global Instance frame_except_0 p R P Q Q' :
+ Frame p R P Q → MakeExcept0 Q Q' → Frame p R (◇ P) Q'.
Proof.
- destruct p; simpl; auto using elim_modal_timeless_bupd.
- intros _ _. by rewrite /ElimModal wand_elim_r.
+ rewrite /Frame /MakeExcept0=><- <-.
+ by rewrite except_0_sep -(except_0_intro (⬕?p R)%I).
Qed.
-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_bupd P : IsExcept0 P → IsExcept0 (|==> P).
+(* IntoLater *)
+Global Instance into_laterN_later n P Q :
+ IntoLaterN n P Q → IntoLaterN' (S n) (▷ P) Q.
+Proof. by rewrite /IntoLaterN' /IntoLaterN =>->. Qed.
+Global Instance into_laterN_laterN n P : IntoLaterN' n (â–·^n P) P.
+Proof. by rewrite /IntoLaterN' /IntoLaterN. Qed.
+Global Instance into_laterN_laterN_plus n m P Q :
+ IntoLaterN m P Q → IntoLaterN' (n + m) (▷^n P) Q.
+Proof. rewrite /IntoLaterN' /IntoLaterN=>->. by rewrite laterN_plus. Qed.
+
+Global Instance into_laterN_and_l n P1 P2 Q1 Q2 :
+ IntoLaterN' n P1 Q1 → IntoLaterN n P2 Q2 →
+ IntoLaterN' n (P1 ∧ P2) (Q1 ∧ Q2) | 10.
+Proof. rewrite /IntoLaterN' /IntoLaterN=> -> ->. by rewrite laterN_and. Qed.
+Global Instance into_laterN_and_r n P P2 Q2 :
+ IntoLaterN' n P2 Q2 → IntoLaterN' n (P ∧ P2) (P ∧ Q2) | 11.
+Proof.
+ rewrite /IntoLaterN' /IntoLaterN=> ->. by rewrite laterN_and -(laterN_intro _ P).
+Qed.
+
+Global Instance into_laterN_or_l n P1 P2 Q1 Q2 :
+ IntoLaterN' n P1 Q1 → IntoLaterN n P2 Q2 →
+ IntoLaterN' n (P1 ∨ P2) (Q1 ∨ Q2) | 10.
+Proof. rewrite /IntoLaterN' /IntoLaterN=> -> ->. by rewrite laterN_or. Qed.
+Global Instance into_laterN_or_r n P P2 Q2 :
+ IntoLaterN' n P2 Q2 →
+ IntoLaterN' n (P ∨ P2) (P ∨ Q2) | 11.
+Proof.
+ rewrite /IntoLaterN' /IntoLaterN=> ->. by rewrite laterN_or -(laterN_intro _ P).
+Qed.
+
+Global Instance into_laterN_forall {A} n (Φ Ψ : A → PROP) :
+ (∀ x, IntoLaterN' n (Φ x) (Ψ x)) → IntoLaterN' n (∀ x, Φ x) (∀ x, Ψ x).
+Proof. rewrite /IntoLaterN' /IntoLaterN laterN_forall=> ?. by apply forall_mono. Qed.
+Global Instance into_laterN_exist {A} n (Φ Ψ : A → PROP) :
+ (∀ x, IntoLaterN' n (Φ x) (Ψ x)) →
+ IntoLaterN' n (∃ x, Φ x) (∃ x, Ψ x).
+Proof. rewrite /IntoLaterN' /IntoLaterN -laterN_exist_2=> ?. by apply exist_mono. Qed.
+
+Global Instance into_laterN_sep_l n P1 P2 Q1 Q2 :
+ IntoLaterN' n P1 Q1 → IntoLaterN n P2 Q2 →
+ IntoLaterN' n (P1 ∗ P2) (Q1 ∗ Q2) | 10.
+Proof. rewrite /IntoLaterN' /IntoLaterN=> -> ->. by rewrite laterN_sep. Qed.
+Global Instance into_laterN_sep_r n P P2 Q2 :
+ IntoLaterN' n P2 Q2 →
+ IntoLaterN' n (P ∗ P2) (P ∗ Q2) | 11.
+Proof.
+ rewrite /IntoLaterN' /IntoLaterN=> ->. by rewrite laterN_sep -(laterN_intro _ P).
+Qed.
+
+Global Instance into_laterN_big_sepL n {A} (Φ Ψ : nat → A → PROP) (l: list A) :
+ (∀ x k, IntoLaterN' n (Φ k x) (Ψ k x)) →
+ IntoLaterN' n ([∗ list] k ↦ x ∈ l, Φ k x) ([∗ list] k ↦ x ∈ l, Ψ k x).
+Proof.
+ rewrite /IntoLaterN' /IntoLaterN=> ?.
+ rewrite big_opL_commute. by apply big_sepL_mono.
+Qed.
+Global Instance into_laterN_big_sepM n `{Countable K} {A}
+ (Φ Ψ : K → A → PROP) (m : gmap K A) :
+ (∀ x k, IntoLaterN' n (Φ k x) (Ψ k x)) →
+ IntoLaterN' n ([∗ map] k ↦ x ∈ m, Φ k x) ([∗ map] k ↦ x ∈ m, Ψ k x).
+Proof.
+ rewrite /IntoLaterN' /IntoLaterN=> ?.
+ rewrite big_opM_commute. by apply big_sepM_mono.
+Qed.
+Global Instance into_laterN_big_sepS n `{Countable A}
+ (Φ Ψ : A → PROP) (X : gset A) :
+ (∀ x, IntoLaterN' n (Φ x) (Ψ x)) →
+ IntoLaterN' n ([∗ set] x ∈ X, Φ x) ([∗ set] x ∈ X, Ψ x).
+Proof.
+ rewrite /IntoLaterN' /IntoLaterN=> ?.
+ rewrite big_opS_commute. by apply big_sepS_mono.
+Qed.
+Global Instance into_laterN_big_sepMS n `{Countable A}
+ (Φ Ψ : A → PROP) (X : gmultiset A) :
+ (∀ x, IntoLaterN' n (Φ x) (Ψ x)) →
+ IntoLaterN' n ([∗ mset] x ∈ X, Φ x) ([∗ mset] x ∈ X, Ψ x).
Proof.
- rewrite /IsExcept0=> HP.
- by rewrite -{2}HP -(except_0_idemp P) -except_0_bupd -(except_0_intro P).
+ rewrite /IntoLaterN' /IntoLaterN=> ?.
+ rewrite big_opMS_commute. by apply big_sepMS_mono.
Qed.
-End classes.
+
+(* FromLater *)
+Global Instance from_laterN_later P : FromLaterN 1 (â–· P) P | 0.
+Proof. by rewrite /FromLaterN. Qed.
+Global Instance from_laterN_laterN n P : FromLaterN n (â–·^n P) P | 0.
+Proof. by rewrite /FromLaterN. Qed.
+
+(* The instances below are used when stripping a specific number of laters, or
+to balance laters in different branches of ∧, ∨ and ∗. *)
+Global Instance from_laterN_0 P : FromLaterN 0 P P | 100. (* fallthrough *)
+Proof. by rewrite /FromLaterN. Qed.
+Global Instance from_laterN_later_S n P Q :
+ FromLaterN n P Q → FromLaterN (S n) (▷ P) Q.
+Proof. by rewrite /FromLaterN=><-. Qed.
+Global Instance from_laterN_later_plus n m P Q :
+ FromLaterN m P Q → FromLaterN (n + m) (▷^n P) Q.
+Proof. rewrite /FromLaterN=><-. by rewrite laterN_plus. Qed.
+
+Global Instance from_later_and n P1 P2 Q1 Q2 :
+ FromLaterN n P1 Q1 → FromLaterN n P2 Q2 → FromLaterN n (P1 ∧ P2) (Q1 ∧ Q2).
+Proof. intros ??; red. by rewrite laterN_and; apply and_mono. Qed.
+Global Instance from_later_or n P1 P2 Q1 Q2 :
+ FromLaterN n P1 Q1 → FromLaterN n P2 Q2 → FromLaterN n (P1 ∨ P2) (Q1 ∨ Q2).
+Proof. intros ??; red. by rewrite laterN_or; apply or_mono. Qed.
+Global Instance from_later_sep n P1 P2 Q1 Q2 :
+ FromLaterN n P1 Q1 → FromLaterN n P2 Q2 → FromLaterN n (P1 ∗ P2) (Q1 ∗ Q2).
+Proof. intros ??; red. by rewrite laterN_sep; apply sep_mono. Qed.
+
+Global Instance from_later_persistently n P Q :
+ FromLaterN n P Q → FromLaterN n (□ P) (□ Q).
+Proof. by rewrite /FromLaterN laterN_persistently=> ->. Qed.
+
+Global Instance from_later_forall {A} n (Φ Ψ : A → PROP) :
+ (∀ x, FromLaterN n (Φ x) (Ψ x)) → FromLaterN n (∀ x, Φ x) (∀ x, Ψ x).
+Proof. rewrite /FromLaterN laterN_forall=> ?. by apply forall_mono. Qed.
+Global Instance from_later_exist {A} n (Φ Ψ : A → PROP) :
+ Inhabited A → (∀ x, FromLaterN n (Φ x) (Ψ x)) →
+ FromLaterN n (∃ x, Φ x) (∃ x, Ψ x).
+Proof. intros ?. rewrite /FromLaterN laterN_exist=> ?. by apply exist_mono. Qed.
+End sbi_instances.
diff --git a/theories/proofmode/classes.v b/theories/proofmode/classes.v
index 028fe9441..1f620fb70 100644
--- a/theories/proofmode/classes.v
+++ b/theories/proofmode/classes.v
@@ -1,26 +1,19 @@
-From iris.base_logic Require Export base_logic.
+From iris.bi Require Export bi.
Set Default Proof Using "Type".
-Import uPred.
-
-(* The Or class is useful for efficiency: instead of having two instances
-[P → Q1 → R] and [P → Q2 → R] we could have one instance [P → Or Q1 Q2 → R],
-which avoids the need to derive [P] twice. *)
-Inductive Or (P1 P2 : Type) :=
- | Or_l : P1 → Or P1 P2
- | Or_r : P2 → Or P1 P2.
-Existing Class Or.
-Existing Instance Or_l | 9.
-Existing Instance Or_r | 10.
-
-Class FromAssumption {M} (p : bool) (P Q : uPred M) :=
- from_assumption : □?p P ⊢ Q.
-Arguments from_assumption {_} _ _ _ {_}.
-(* No need to restrict Hint Mode, we have a default instance that will persistently
+Import bi.
+
+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 {_}.
+(* No need to restrict Hint Mode, we have a default instance that will always
be used in case of evars *)
Hint Mode FromAssumption + + - - : typeclass_instances.
-Class IntoPure {M} (P : uPred M) (φ : Prop) := into_pure : P ⊢ ⌜φâŒ.
-Arguments into_pure {_} _ _ {_}.
+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.
(* [IntoPureT] is a variant of [IntoPure] with the argument in [Type] to avoid
@@ -43,191 +36,150 @@ once, and use [IntoPureT] in any instance like [into_exist_and_pure].
TODO: Report this as a Coq bug, or wait for https://github.com/coq/coq/pull/991
to be finished and merged someday. *)
-Class IntoPureT {M} (P : uPred M) (φ : Type) :=
+Class IntoPureT {PROP : bi} (P : PROP) (φ : Type) :=
into_pureT : ∃ ψ : Prop, φ = ψ ∧ IntoPure P ψ.
-Lemma into_pureT_hint {M} (P : uPred M) (φ : Prop) : IntoPure P φ → IntoPureT P φ.
+Lemma into_pureT_hint {PROP : bi} (P : PROP) (φ : Prop) : IntoPure P φ → IntoPureT P φ.
Proof. by exists φ. Qed.
Hint Extern 0 (IntoPureT _ _) =>
notypeclasses refine (into_pureT_hint _ _ _) : typeclass_instances.
-Class FromPure {M} (P : uPred M) (φ : Prop) := from_pure : ⌜φ⌠⊢ P.
-Arguments from_pure {_} _ _ {_}.
+Class FromPure {PROP : bi} (P : PROP) (φ : Prop) :=
+ from_pure : ⌜φ⌠⊢ P.
+Arguments FromPure {_} _%I _%type_scope : simpl never.
+Arguments from_pure {_} _%I _%type_scope {_}.
Hint Mode FromPure + ! - : typeclass_instances.
-Class IntoPersistent {M} (p : bool) (P Q : uPred M) :=
+Class IntoPersistent {PROP : bi} (p : bool) (P Q : PROP) :=
into_persistent : □?p P ⊢ □ Q.
-Arguments into_persistent {_} _ _ _ {_}.
+Arguments IntoPersistent {_} _ _%I _%I : simpl never.
+Arguments into_persistent {_} _ _%I _%I {_}.
Hint Mode IntoPersistent + + ! - : typeclass_instances.
-(* The class [IntoLaterN] has only two instances:
-
-- The default instance [IntoLaterN n P P], i.e. [▷^n P -∗ P]
-- The instance [IntoLaterN' n P Q → IntoLaterN n P Q], where [IntoLaterN']
- is identical to [IntoLaterN], but computationally is supposed to make
- progress, i.e. its instances should actually strip a later.
-
-The point of using the auxilary class [IntoLaterN'] is to ensure that the
-default instance is not applied deeply in the term, which may cause in too many
-definitions being unfolded (see issue #55).
-
-For binary connectives we have the following instances:
-
-<<
-IntoLaterN' n P P' IntoLaterN n Q Q'
-------------------------------------------
- IntoLaterN' n (P /\ Q) (P' /\ Q')
-
-
- IntoLaterN' n Q Q'
--------------------------------
-IntoLaterN n (P /\ Q) (P /\ Q')
->>
+Class FromPersistent {PROP : bi} (P Q : PROP) :=
+ from_persistent : □ Q ⊢ P.
+Arguments FromPersistent {_} _%I _%I : simpl never.
+Arguments from_persistent {_} _%I _%I {_}.
+Hint Mode FromPersistent + ! - : typeclass_instances.
+
+Class FromBare {PROP : bi} (P Q : PROP) :=
+ from_bare : ■Q ⊢ P.
+Arguments FromBare {_} _%I _%type_scope : simpl never.
+Arguments from_bare {_} _%I _%type_scope {_}.
+Hint Mode FromBare + ! - : typeclass_instances.
+Hint Mode FromBare + - ! : typeclass_instances.
+
+Class IntoInternalEq {PROP : bi} {A : ofeT} (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.
+
+(*
+Converting an assumption [R] into a wand [P -∗ Q] is done in three stages:
+
+- Strip modalities and universal quantifiers of [R] until an arrow or a wand
+ has been obtained.
+- Balance modalities in the arguments [P] and [Q] to match the goal (which used
+ for [iApply]) or the premise (when used with [iSpecialize] and a specific
+ hypothesis).
+- Instantiate the premise of the wand or implication.
*)
-Class IntoLaterN {M} (n : nat) (P Q : uPred M) := into_laterN : P ⊢ ▷^n Q.
-Arguments into_laterN {_} _ _ _ {_}.
-Hint Mode IntoLaterN + - - - : typeclass_instances.
-
-Class IntoLaterN' {M} (n : nat) (P Q : uPred M) :=
- into_laterN' :> IntoLaterN n P Q.
-Arguments into_laterN' {_} _ _ _ {_}.
-Hint Mode IntoLaterN' + - ! - : typeclass_instances.
-
-Instance into_laterN_default {M} n (P : uPred M) : IntoLaterN n P P | 1000.
-Proof. apply laterN_intro. Qed.
-
-Class FromLaterN {M} (n : nat) (P Q : uPred M) := from_laterN : ▷^n Q ⊢ P.
-Arguments from_laterN {_} _ _ _ {_}.
-Hint Mode FromLaterN + - ! - : typeclass_instances.
+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.
+
+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.
+
+Instance into_wand_wand' {PROP : bi} p q (P Q P' Q' : PROP) :
+ IntoWand' p q (P -∗ Q) P' Q' → IntoWand p q (P -∗ Q) P' Q' | 100.
+Proof. done. Qed.
+Instance into_wand_impl' {PROP : bi} p q (P Q P' Q' : PROP) :
+ IntoWand' p q (P → Q) P' Q' → IntoWand p q (P → Q) P' Q' | 100.
+Proof. done. Qed.
-Class WandWeaken {M} (p : bool) (P Q P' Q' : uPred M) :=
- wand_weaken : (P -∗ Q) ⊢ (□?p P' -∗ Q').
-Hint Mode WandWeaken + + - - - - : typeclass_instances.
-
-Class WandWeaken' {M} (p : bool) (P Q P' Q' : uPred M) :=
- wand_weaken' :> WandWeaken p P Q P' Q'.
-Hint Mode WandWeaken' + + - - ! - : typeclass_instances.
-Hint Mode WandWeaken' + + - - - ! : typeclass_instances.
-
-Class IntoWand {M} (p : bool) (R P Q : uPred M) := into_wand : R ⊢ □?p P -∗ Q.
-Arguments into_wand {_} _ _ _ _ {_}.
-Hint Mode IntoWand + + ! - - : typeclass_instances.
-
-Class FromAnd {M} (p : bool) (P Q1 Q2 : uPred M) :=
- from_and : (if p then Q1 ∧ Q2 else Q1 ∗ Q2) ⊢ P.
-Arguments from_and {_} _ _ _ _ {_}.
-Hint Mode FromAnd + + ! - - : typeclass_instances.
-Hint Mode FromAnd + + - ! ! : typeclass_instances. (* For iCombine *)
-
-Lemma mk_from_and_and {M} p (P Q1 Q2 : uPred M) :
- (Q1 ∧ Q2 ⊢ P) → FromAnd p P Q1 Q2.
-Proof. rewrite /FromAnd=><-. destruct p; auto using sep_and. Qed.
-Lemma mk_from_and_persistent {M} (P Q1 Q2 : uPred M) :
- Or (Persistent Q1) (Persistent Q2) → (Q1 ∗ Q2 ⊢ P) → FromAnd true P Q1 Q2.
-Proof.
- intros [?|?] ?; rewrite /FromAnd.
- - by rewrite and_sep_l.
- - by rewrite and_sep_r.
-Qed.
-
-Class IntoAnd {M} (p : bool) (P Q1 Q2 : uPred M) :=
- into_and : P ⊢ if p then Q1 ∧ Q2 else Q1 ∗ Q2.
-Arguments into_and {_} _ _ _ _ {_}.
+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 *)
+
+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 *)
+
+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.
-Lemma mk_into_and_sep {M} p (P Q1 Q2 : uPred M) :
- (P ⊢ Q1 ∗ Q2) → IntoAnd p P Q1 Q2.
-Proof. rewrite /IntoAnd=>->. destruct p; auto using sep_and. Qed.
-
-(* There are various versions of [IsOp] with different modes:
-
-- [IsOp a b1 b2]: this one has no mode, it can be used regardless of whether
- any of the arguments is an evar. This class has only one direct instance:
- [IsOp (a â‹… b) a b].
-- [IsOp' a b1 b2]: requires either [a] to start with a constructor, OR [b1] and
- [b2] to start with a constructor. All usual instances should be of this
- class to avoid loops.
-- [IsOp'LR a b1 b2]: requires either [a] to start with a constructor. This one
- has just one instance: [IsOp'LR (a â‹… b) a b] with a very low precendence.
- This is important so that when performing, for example, an [iDestruct] on
- [own γ (q1 + q2)] where [q1] and [q2] are fractions, we actually get
- [own γ q1] and [own γ q2] instead of [own γ ((q1 + q2)/2)] twice.
-*)
-Class IsOp {A : cmraT} (a b1 b2 : A) := is_op : a ≡ b1 ⋅ b2.
-Arguments is_op {_} _ _ _ {_}.
-Hint Mode IsOp + - - - : typeclass_instances.
-
-Instance is_op_op {A : cmraT} (a b : A) : IsOp (a â‹… b) a b | 100.
-Proof. by rewrite /IsOp. Qed.
-
-Class IsOp' {A : cmraT} (a b1 b2 : A) := is_op' :> IsOp a b1 b2.
-Hint Mode IsOp' + ! - - : typeclass_instances.
-Hint Mode IsOp' + - ! ! : typeclass_instances.
-
-Class IsOp'LR {A : cmraT} (a b1 b2 : A) := is_op_lr : IsOp a b1 b2.
-Existing Instance is_op_lr | 0.
-Hint Mode IsOp'LR + ! - - : typeclass_instances.
-Instance is_op_lr_op {A : cmraT} (a b : A) : IsOp'LR (a â‹… b) a b | 0.
-Proof. by rewrite /IsOp'LR /IsOp. Qed.
-
-Class Frame {M} (p : bool) (R P Q : uPred M) := frame : □?p R ∗ Q ⊢ P.
-Arguments frame {_ _} _ _ _ {_}.
-Hint Mode Frame + + ! ! - : typeclass_instances.
-
-Class MaybeFrame {M} (p : bool) (R P Q : uPred M) := maybe_frame : □?p R ∗ Q ⊢ P.
-Arguments maybe_frame {_} _ _ _ {_}.
-Hint Mode MaybeFrame + + ! ! - : typeclass_instances.
-
-Instance maybe_frame_frame {M} p (R P Q : uPred M) :
- Frame p R P Q → MaybeFrame p R P Q.
-Proof. done. Qed.
-Instance maybe_frame_default {M} p (R P : uPred M) : MaybeFrame p R P P | 100.
-Proof. apply sep_elim_r. Qed.
+Class IntoSep {PROP : bi} (p : bool) (P Q1 Q2 : PROP) :=
+ into_sep : ⬕?p P ⊢ ⬕?p (Q1 ∗ Q2).
+Arguments IntoSep {_} _ _%I _%I _%I : simpl never.
+Arguments into_sep {_} _ _%I _%I _%I {_}.
+Hint Mode IntoAnd + + ! - - : typeclass_instances.
-Class FromOr {M} (P Q1 Q2 : uPred M) := from_or : Q1 ∨ Q2 ⊢ P.
-Arguments from_or {_} _ _ _ {_}.
+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.
-Class IntoOr {M} (P Q1 Q2 : uPred M) := into_or : P ⊢ Q1 ∨ Q2.
-Arguments into_or {_} _ _ _ {_}.
+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.
-Class FromExist {M A} (P : uPred M) (Φ : A → uPred M) :=
+Class FromExist {PROP : bi} {A} (P : PROP) (Φ : A → PROP) :=
from_exist : (∃ x, Φ x) ⊢ P.
-Arguments from_exist {_ _} _ _ {_}.
+Arguments FromExist {_ _} _%I _%I : simpl never.
+Arguments from_exist {_ _} _%I _%I {_}.
Hint Mode FromExist + - ! - : typeclass_instances.
-Class IntoExist {M A} (P : uPred M) (Φ : A → uPred M) :=
+Class IntoExist {PROP : bi} {A} (P : PROP) (Φ : A → PROP) :=
into_exist : P ⊢ ∃ x, Φ x.
-Arguments into_exist {_ _} _ _ {_}.
+Arguments IntoExist {_ _} _%I _%I : simpl never.
+Arguments into_exist {_ _} _%I _%I {_}.
Hint Mode IntoExist + - ! - : typeclass_instances.
-Class IntoForall {M A} (P : uPred M) (Φ : A → uPred M) :=
+Class IntoForall {PROP : bi} {A} (P : PROP) (Φ : A → PROP) :=
into_forall : P ⊢ ∀ x, Φ x.
-Arguments into_forall {_ _} _ _ {_}.
+Arguments IntoForall {_ _} _%I _%I : simpl never.
+Arguments into_forall {_ _} _%I _%I {_}.
Hint Mode IntoForall + - ! - : typeclass_instances.
-Class FromForall {M A} (P : uPred M) (Φ : A → uPred M) :=
+Class FromForall {PROP : bi} {A} (P : PROP) (Φ : A → PROP) :=
from_forall : (∀ x, Φ x) ⊢ P.
Arguments from_forall {_ _} _ _ {_}.
Hint Mode FromForall + - ! - : typeclass_instances.
-Class FromModal {M} (P Q : uPred M) := from_modal : Q ⊢ P.
-Arguments from_modal {_} _ _ {_}.
+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.
+
+Class FromModal {PROP : bi} (P Q : PROP) := from_modal : Q ⊢ P.
+Arguments FromModal {_} _%I _%I : simpl never.
+Arguments from_modal {_} _%I _%I {_}.
Hint Mode FromModal + ! - : typeclass_instances.
-Class ElimModal {M} (P P' : uPred M) (Q Q' : uPred M) :=
+Class ElimModal {PROP : bi} (P P' : PROP) (Q Q' : PROP) :=
elim_modal : P ∗ (P' -∗ Q') ⊢ Q.
-Arguments elim_modal {_} _ _ _ _ {_}.
+Arguments ElimModal {_} _%I _%I _%I _%I : simpl never.
+Arguments elim_modal {_} _%I _%I _%I _%I {_}.
Hint Mode ElimModal + ! - ! - : typeclass_instances.
Hint Mode ElimModal + - ! - ! : typeclass_instances.
-Lemma elim_modal_dummy {M} (P Q : uPred M) : ElimModal P P Q Q.
+Lemma elim_modal_dummy {PROP : bi} (P Q : PROP) : ElimModal P P Q Q.
Proof. by rewrite /ElimModal wand_elim_r. Qed.
-Class IsExcept0 {M} (Q : uPred M) := is_except_0 : ◇ Q ⊢ Q.
-Arguments is_except_0 {_} _ {_}.
-Hint Mode IsExcept0 + ! : typeclass_instances.
-
Class IsCons {A} (l : list A) (x : A) (k : list A) := is_cons : l = x :: k.
Class IsApp {A} (l k1 k2 : list A) := is_app : l = k1 ++ k2.
Global Hint Mode IsCons + ! - - : typeclass_instances.
@@ -238,6 +190,69 @@ Proof. done. Qed.
Instance is_app_app {A} (l1 l2 : list A) : IsApp (l1 ++ l2) l1 l2.
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.
+
+Class MaybeFrame {PROP : bi} (p : bool) (R P Q : PROP) :=
+ maybe_frame : ⬕?p R ∗ Q ⊢ P.
+Arguments MaybeFrame {_} _ _%I _%I _%I.
+Arguments maybe_frame {_} _%I _%I _%I {_}.
+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.
+Proof. done. Qed.
+Instance maybe_frame_default_persistent {PROP : bi} (R P : PROP) :
+ MaybeFrame true R P P | 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 | 100.
+Proof. intros. rewrite /MaybeFrame /=. apply: sep_elim_r. Qed.
+
+(* The class [IntoLaterN] has only two instances:
+
+- The default instance [IntoLaterN n P P], i.e. [▷^n P -∗ P]
+- The instance [IntoLaterN' n P Q → IntoLaterN n P Q], where [IntoLaterN']
+ is identical to [IntoLaterN], but computationally is supposed to make
+ progress, i.e. its instances should actually strip a later.
+
+The point of using the auxilary class [IntoLaterN'] is to ensure that the
+default instance is not applied deeply in the term, which may cause in too many
+definitions being unfolded (see issue #55).
+
+For binary connectives we have the following instances:
+
+<<
+IntoLaterN' n P P' IntoLaterN n Q Q'
+------------------------------------------
+ IntoLaterN' n (P /\ Q) (P' /\ Q')
+
+
+ IntoLaterN' n Q Q'
+-------------------------------
+IntoLaterN n (P /\ Q) (P /\ Q')
+>>
+*)
+Class IntoLaterN {PROP : sbi} (n : nat) (P Q : PROP) := into_laterN : P ⊢ ▷^n Q.
+Arguments IntoLaterN {_} _%nat_scope _%I _%I.
+Arguments into_laterN {_} _%nat_scope _%I _%I {_}.
+Hint Mode IntoLaterN + - - - : typeclass_instances.
+
+Class IntoLaterN' {PROP : sbi} (n : nat) (P Q : PROP) :=
+ into_laterN' :> IntoLaterN n P Q.
+Arguments IntoLaterN' {_} _%nat_scope _%I _%I.
+Hint Mode IntoLaterN' + - ! - : typeclass_instances.
+
+Instance into_laterN_default {PROP : sbi} n (P : PROP) : IntoLaterN n P P | 1000.
+Proof. apply laterN_intro. Qed.
+
+Class FromLaterN {PROP : sbi} (n : nat) (P Q : PROP) := from_laterN : ▷^n Q ⊢ P.
+Arguments FromLaterN {_} _%nat_scope _%I _%I.
+Arguments from_laterN {_} _%nat_scope _%I _%I {_}.
+Hint Mode FromLaterN + - ! - : typeclass_instances.
+
(* We make sure that tactics that perform actions on *specific* hypotheses or
parts of the goal look through the [tc_opaque] connective, which is used to make
definitions opaque for type class search. For example, when using `iDestruct`,
@@ -250,34 +265,34 @@ This means that there are [tc_opaque] instances for all proofmode type classes
with the exception of:
- [FromAssumption] used by [iAssumption]
-- [Frame] used by [iFrame]
+- [Frame] and [MaybeFrame] used by [iFrame]
- [IntoLaterN] and [FromLaterN] used by [iNext]
-- [IntoPersistentP] used by [iPersistent]
+- [IntoPersistent] used by [iPersistent]
*)
-Instance into_pure_tc_opaque {M} (P : uPred M) φ :
+Instance into_pure_tc_opaque {PROP : bi} (P : PROP) φ :
IntoPure P φ → IntoPure (tc_opaque P) φ := id.
-Instance from_pure_tc_opaque {M} (P : uPred M) φ :
+Instance from_pure_tc_opaque {PROP : bi} (P : PROP) φ :
FromPure P φ → FromPure (tc_opaque P) φ := id.
-Instance from_laterN_tc_opaque {M} n (P Q : uPred M) :
+Instance from_laterN_tc_opaque {PROP : sbi} n (P Q : PROP) :
FromLaterN n P Q → FromLaterN n (tc_opaque P) Q := id.
-Instance into_wand_tc_opaque {M} p (R P Q : uPred M) :
- IntoWand p R P Q → IntoWand p (tc_opaque R) P Q := id.
+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 {M} p (P Q1 Q2 : uPred M) :
- FromAnd p P Q1 Q2 → FromAnd p (tc_opaque P) Q1 Q2 | 102 := id.
-Instance into_and_tc_opaque {M} p (P Q1 Q2 : uPred M) :
+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) :
IntoAnd p P Q1 Q2 → IntoAnd p (tc_opaque P) Q1 Q2 := id.
-Instance from_or_tc_opaque {M} (P Q1 Q2 : uPred M) :
+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 {M} (P Q1 Q2 : uPred M) :
+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 {M A} (P : uPred M) (Φ : A → uPred M) :
+Instance from_exist_tc_opaque {PROP : bi} {A} (P : PROP) (Φ : A → PROP) :
FromExist P Φ → FromExist (tc_opaque P) Φ := id.
-Instance into_exist_tc_opaque {M A} (P : uPred M) (Φ : A → uPred M) :
+Instance into_exist_tc_opaque {PROP : bi} {A} (P : PROP) (Φ : A → PROP) :
IntoExist P Φ → IntoExist (tc_opaque P) Φ := id.
-Instance into_forall_tc_opaque {M A} (P : uPred M) (Φ : A → uPred M) :
+Instance into_forall_tc_opaque {PROP : bi} {A} (P : PROP) (Φ : A → PROP) :
IntoForall P Φ → IntoForall (tc_opaque P) Φ := id.
-Instance from_modal_tc_opaque {M} (P Q : uPred M) :
+Instance from_modal_tc_opaque {PROP : bi} (P Q : PROP) :
FromModal P Q → FromModal (tc_opaque P) Q := id.
-Instance elim_modal_tc_opaque {M} (P P' Q Q' : uPred M) :
+Instance elim_modal_tc_opaque {PROP : bi} (P P' Q Q' : PROP) :
ElimModal P P' Q Q' → ElimModal (tc_opaque P) P' Q Q' := id.
diff --git a/theories/proofmode/coq_tactics.v b/theories/proofmode/coq_tactics.v
index 724e7175e..fa8acee90 100644
--- a/theories/proofmode/coq_tactics.v
+++ b/theories/proofmode/coq_tactics.v
@@ -1,60 +1,63 @@
-From iris.base_logic Require Export base_logic.
-From iris.base_logic Require Import big_op tactics.
+From iris.bi Require Export bi.
+From iris.bi Require Import tactics.
From iris.proofmode Require Export environments classes.
From stdpp Require Import stringmap hlist.
Set Default Proof Using "Type".
-Import uPred.
+Import bi.
Import env_notations.
Local Notation "b1 && b2" := (if b1 then b2 else false) : bool_scope.
-Record envs (M : ucmraT) :=
- Envs { env_persistent : env (uPred M); env_spatial : env (uPred M) }.
+Record envs (PROP : bi) :=
+ Envs { env_persistent : env PROP; env_spatial : env PROP }.
Add Printing Constructor envs.
Arguments Envs {_} _ _.
Arguments env_persistent {_} _.
Arguments env_spatial {_} _.
-Record envs_wf {M} (Δ : envs M) := {
+Record envs_wf {PROP} (Δ : envs PROP) := {
env_persistent_valid : env_wf (env_persistent Δ);
env_spatial_valid : env_wf (env_spatial Δ);
envs_disjoint i : env_persistent Δ !! i = None ∨ env_spatial Δ !! i = None
}.
-Coercion of_envs {M} (Δ : envs M) : uPred M :=
- (⌜envs_wf Δ⌠∗ □ [∗] env_persistent Δ ∗ [∗] env_spatial Δ)%I.
+Coercion of_envs {PROP} (Δ : envs PROP) : PROP :=
+ (⌜envs_wf Δ⌠∧ ⬕ [∗] env_persistent Δ ∗ [∗] env_spatial Δ)%I.
Instance: Params (@of_envs) 1.
+Arguments of_envs : simpl never.
-Record envs_Forall2 {M} (R : relation (uPred M)) (Δ1 Δ2 : envs M) : Prop := {
+Record envs_Forall2 {PROP : bi} (R : relation PROP) (Δ1 Δ2 : envs PROP) := {
env_persistent_Forall2 : env_Forall2 R (env_persistent Δ1) (env_persistent Δ2);
env_spatial_Forall2 : env_Forall2 R (env_spatial Δ1) (env_spatial Δ2)
}.
-Definition envs_dom {M} (Δ : envs M) : list string :=
+Definition envs_dom {PROP} (Δ : envs PROP) : list string :=
env_dom (env_persistent Δ) ++ env_dom (env_spatial Δ).
-Definition envs_lookup {M} (i : string) (Δ : envs M) : option (bool * uPred M) :=
+Definition envs_lookup {PROP} (i : string) (Δ : envs PROP) : option (bool * PROP) :=
let (Γp,Γs) := Δ in
match env_lookup i Γp with
- | Some P => Some (true, P) | None => P ↠env_lookup i Γs; Some (false, P)
+ | Some P => Some (true, P)
+ | None => P ↠env_lookup i Γs; Some (false, P)
end.
-Definition envs_delete {M} (i : string) (p : bool) (Δ : envs M) : envs M :=
+Definition envs_delete {PROP} (i : string) (p : bool) (Δ : envs PROP) : envs PROP :=
let (Γp,Γs) := Δ in
match p with
- | true => Envs (env_delete i Γp) Γs | false => Envs Γp (env_delete i Γs)
+ | true => Envs (env_delete i Γp) Γs
+ | false => Envs Γp (env_delete i Γs)
end.
-Definition envs_lookup_delete {M} (i : string)
- (Δ : envs M) : option (bool * uPred M * envs M) :=
+Definition envs_lookup_delete {PROP} (i : string)
+ (Δ : envs PROP) : option (bool * PROP * envs PROP) :=
let (Γp,Γs) := Δ in
match env_lookup_delete i Γp with
| Some (P,Γp') => Some (true, P, Envs Γp' Γs)
| None => '(P,Γs') ↠env_lookup_delete i Γs; Some (false, P, Envs Γp Γs')
end.
-Fixpoint envs_lookup_delete_list {M} (js : list string) (remove_persistent : bool)
- (Δ : envs M) : option (bool * list (uPred M) * envs M) :=
+Fixpoint envs_lookup_delete_list {PROP} (js : list string) (remove_persistent : bool)
+ (Δ : envs PROP) : option (bool * list PROP * envs PROP) :=
match js with
| [] => Some (true, [], Δ)
| j :: js =>
@@ -64,43 +67,43 @@ Fixpoint envs_lookup_delete_list {M} (js : list string) (remove_persistent : boo
Some (p && q, P :: Hs, Δ'')
end.
-Definition envs_snoc {M} (Δ : envs M)
- (p : bool) (j : string) (P : uPred M) : envs M :=
+Definition envs_snoc {PROP} (Δ : envs PROP)
+ (p : bool) (j : string) (P : PROP) : envs PROP :=
let (Γp,Γs) := Δ in
if p then Envs (Esnoc Γp j P) Γs else Envs Γp (Esnoc Γs j P).
-Definition envs_app {M} (p : bool)
- (Γ : env (uPred M)) (Δ : envs M) : option (envs M) :=
+Definition envs_app {PROP : bi} (p : bool)
+ (Γ : env PROP) (Δ : envs PROP) : option (envs PROP) :=
let (Γp,Γs) := Δ in
match p with
| true => _ ↠env_app Γ Γs; Γp' ↠env_app Γ Γp; Some (Envs Γp' Γs)
| false => _ ↠env_app Γ Γp; Γs' ↠env_app Γ Γs; Some (Envs Γp Γs')
end.
-Definition envs_simple_replace {M} (i : string) (p : bool) (Γ : env (uPred M))
- (Δ : envs M) : option (envs M) :=
+Definition envs_simple_replace {PROP : bi} (i : string) (p : bool)
+ (Γ : env PROP) (Δ : envs PROP) : option (envs PROP) :=
let (Γp,Γs) := Δ in
match p with
| true => _ ↠env_app Γ Γs; Γp' ↠env_replace i Γ Γp; Some (Envs Γp' Γs)
| false => _ ↠env_app Γ Γp; Γs' ↠env_replace i Γ Γs; Some (Envs Γp Γs')
end.
-Definition envs_replace {M} (i : string) (p q : bool) (Γ : env (uPred M))
- (Δ : envs M) : option (envs M) :=
+Definition envs_replace {PROP : bi} (i : string) (p q : bool)
+ (Γ : env PROP) (Δ : envs PROP) : option (envs PROP) :=
if eqb p q then envs_simple_replace i p Γ Δ
else envs_app q Γ (envs_delete i p Δ).
-Definition env_spatial_is_nil {M} (Δ : envs M) :=
+Definition env_spatial_is_nil {PROP} (Δ : envs PROP) : bool :=
if env_spatial Δ is Enil then true else false.
-Definition envs_clear_spatial {M} (Δ : envs M) : envs M :=
+Definition envs_clear_spatial {PROP} (Δ : envs PROP) : envs PROP :=
Envs (env_persistent Δ) Enil.
-Definition envs_clear_persistent {M} (Δ : envs M) : envs M :=
+Definition envs_clear_persistent {PROP} (Δ : envs PROP) : envs PROP :=
Envs Enil (env_spatial Δ).
-Fixpoint envs_split_go {M}
- (js : list string) (Δ1 Δ2 : envs M) : option (envs M * envs M) :=
+Fixpoint envs_split_go {PROP}
+ (js : list string) (Δ1 Δ2 : envs PROP) : option (envs PROP * envs PROP) :=
match js with
| [] => Some (Δ1, Δ2)
| j :: js =>
@@ -110,20 +113,20 @@ Fixpoint envs_split_go {M}
end.
(* if [lr = true] then [result = (remaining hyps, hyps named js)] and
if [lr = false] then [result = (hyps named js, remaining hyps)] *)
-Definition envs_split {M} (lr : bool)
- (js : list string) (Δ : envs M) : option (envs M * envs M) :=
+Definition envs_split {PROP} (lr : bool)
+ (js : list string) (Δ : envs PROP) : option (envs PROP * envs PROP) :=
'(Δ1,Δ2) ↠envs_split_go js Δ (envs_clear_spatial Δ);
if lr then Some (Δ1,Δ2) else Some (Δ2,Δ1).
(* Coq versions of the tactics *)
-Section tactics.
-Context {M : ucmraT}.
-Implicit Types Γ : env (uPred M).
-Implicit Types Δ : envs M.
-Implicit Types P Q : uPred M.
-
-Lemma of_envs_def Δ :
- of_envs Δ = (⌜envs_wf Δ⌠∗ □ [∗] env_persistent Δ ∗ [∗] env_spatial Δ)%I.
+Section bi_tactics.
+Context {PROP : bi}.
+Implicit Types Γ : env PROP.
+Implicit Types Δ : envs PROP.
+Implicit Types P Q : PROP.
+
+Lemma of_envs_eq Δ :
+ of_envs Δ = (⌜envs_wf Δ⌠∧ ⬕ [∗] env_persistent Δ ∗ [∗] env_spatial Δ)%I.
Proof. done. Qed.
Lemma envs_lookup_delete_Some Δ Δ' i p P :
@@ -136,62 +139,58 @@ Proof.
Qed.
Lemma envs_lookup_sound Δ i p P :
- envs_lookup i Δ = Some (p,P) → Δ ⊢ □?p P ∗ envs_delete i p Δ.
+ envs_lookup i Δ = Some (p,P) → Δ ⊢ ⬕?p P ∗ envs_delete i p Δ.
Proof.
- rewrite /envs_lookup /envs_delete /of_envs=>?; apply pure_elim_sep_l=> Hwf.
+ rewrite /envs_lookup /envs_delete /of_envs=>?. apply pure_elim_l=> Hwf.
destruct Δ as [Γp Γs], (Γp !! i) eqn:?; simplify_eq/=.
- - rewrite (env_lookup_perm Γp) //= persistently_sep.
- ecancel [□ [∗] _; □ P; [∗] Γs]%I; apply pure_intro.
- destruct Hwf; constructor;
- naive_solver eauto using env_delete_wf, env_delete_fresh.
+ - rewrite pure_True ?left_id; last (destruct Hwf; constructor;
+ naive_solver eauto using env_delete_wf, env_delete_fresh).
+ by rewrite (env_lookup_perm Γp) //= bare_persistently_sep -assoc.
- destruct (Γs !! i) eqn:?; simplify_eq/=.
- rewrite (env_lookup_perm Γs) //=.
- ecancel [□ [∗] _; P; [∗] (env_delete _ _)]%I; apply pure_intro.
- destruct Hwf; constructor;
- naive_solver eauto using env_delete_wf, env_delete_fresh.
-Qed.
-Lemma envs_lookup_sound' Δ i p P :
- envs_lookup i Δ = Some (p,P) → Δ ⊢ P ∗ envs_delete i p Δ.
-Proof. intros. rewrite envs_lookup_sound //. by rewrite persistently_if_elim. Qed.
+ rewrite pure_True ?left_id; last (destruct Hwf; constructor;
+ naive_solver eauto using env_delete_wf, env_delete_fresh).
+ rewrite (env_lookup_perm Γs) //=. by rewrite !assoc -(comm _ P).
+Qed.
Lemma envs_lookup_persistent_sound Δ i P :
- envs_lookup i Δ = Some (true,P) → Δ ⊢ □ P ∗ Δ.
+ envs_lookup i Δ = Some (true,P) → Δ ⊢ ⬕ P ∗ Δ.
Proof.
- intros. apply (persistently_entails_l _ _). by rewrite envs_lookup_sound // sep_elim_l.
+ intros. rewrite -persistently_and_bare_sep_l. apply and_intro; last done.
+ rewrite envs_lookup_sound //; simpl.
+ by rewrite -persistently_and_bare_sep_l and_elim_l.
Qed.
Lemma envs_lookup_split Δ i p P :
- envs_lookup i Δ = Some (p,P) → Δ ⊢ □?p P ∗ (□?p P -∗ Δ).
+ envs_lookup i Δ = Some (p,P) → Δ ⊢ ⬕?p P ∗ (⬕?p P -∗ Δ).
Proof.
- rewrite /envs_lookup /of_envs=>?; apply pure_elim_sep_l=> Hwf.
+ rewrite /envs_lookup /of_envs=>?. apply pure_elim_l=> Hwf.
destruct Δ as [Γp Γs], (Γp !! i) eqn:?; simplify_eq/=.
- - rewrite (env_lookup_perm Γp) //= persistently_sep.
- rewrite pure_True // left_id.
- cancel [â–¡ P]%I. apply wand_intro_l. solve_sep_entails.
+ - rewrite pure_True // left_id.
+ rewrite (env_lookup_perm Γp) //= bare_persistently_sep.
+ cancel [⬕ P]%I. apply wand_intro_l. solve_sep_entails.
- destruct (Γs !! i) eqn:?; simplify_eq/=.
rewrite (env_lookup_perm Γs) //=. rewrite pure_True // left_id.
cancel [P]. apply wand_intro_l. solve_sep_entails.
Qed.
Lemma envs_lookup_delete_sound Δ Δ' i p P :
- envs_lookup_delete i Δ = Some (p,P,Δ') → Δ ⊢ □?p P ∗ Δ'.
+ envs_lookup_delete i Δ = Some (p,P,Δ') → Δ ⊢ ⬕?p P ∗ Δ'.
Proof. intros [? ->]%envs_lookup_delete_Some. by apply envs_lookup_sound. Qed.
-Lemma envs_lookup_delete_sound' Δ Δ' i p P :
- envs_lookup_delete i Δ = Some (p,P,Δ') → Δ ⊢ P ∗ Δ'.
-Proof. intros [? ->]%envs_lookup_delete_Some. by apply envs_lookup_sound'. Qed.
Lemma envs_lookup_delete_list_sound Δ Δ' js rp p Ps :
- envs_lookup_delete_list js rp Δ = Some (p, Ps,Δ') → Δ ⊢ □?p [∗] Ps ∗ Δ'.
+ envs_lookup_delete_list js rp Δ = Some (p,Ps,Δ') → Δ ⊢ ⬕?p [∗] Ps ∗ Δ'.
Proof.
revert Δ Δ' p Ps. induction js as [|j js IH]=> Δ Δ'' p Ps ?; simplify_eq/=.
- { by rewrite persistently_pure left_id. }
+ { by rewrite bare_persistently_emp left_id. }
destruct (envs_lookup_delete j Δ) as [[[q1 P] Δ']|] eqn:Hj; simplify_eq/=.
apply envs_lookup_delete_Some in Hj as [Hj ->].
destruct (envs_lookup_delete_list js rp _) as [[[q2 Ps'] ?]|] eqn:?; simplify_eq/=.
- rewrite persistently_if_sep -assoc. destruct q1; simpl.
+ rewrite bare_persistently_if_sep -assoc. destruct q1; simpl.
- destruct rp.
- + rewrite envs_lookup_sound //; simpl. by rewrite IH // (persistently_elim_if q2).
- + rewrite envs_lookup_persistent_sound //. by rewrite IH // (persistently_elim_if q2).
- - rewrite envs_lookup_sound // IH //; simpl. by rewrite persistently_if_elim.
+ + rewrite envs_lookup_sound //; simpl.
+ by rewrite IH // (bare_persistently_bare_persistently_if q2).
+ + rewrite envs_lookup_persistent_sound //.
+ by rewrite IH // (bare_persistently_bare_persistently_if q2).
+ - rewrite envs_lookup_sound // IH //; simpl. by rewrite bare_persistently_if_elim.
Qed.
Lemma envs_lookup_snoc Δ i p P :
@@ -208,36 +207,36 @@ Proof.
Qed.
Lemma envs_snoc_sound Δ p i P :
- envs_lookup i Δ = None → Δ ⊢ □?p P -∗ envs_snoc Δ p i P.
+ envs_lookup i Δ = None → Δ ⊢ ⬕?p P -∗ envs_snoc Δ p i P.
Proof.
- rewrite /envs_lookup /envs_snoc /of_envs=> ?; apply pure_elim_sep_l=> Hwf.
+ rewrite /envs_lookup /envs_snoc /of_envs=> ?; apply pure_elim_l=> Hwf.
destruct Δ as [Γp Γs], (Γp !! i) eqn:?, (Γs !! i) eqn:?; simplify_eq/=.
apply wand_intro_l; destruct p; simpl.
- - apply sep_intro_True_l; [apply pure_intro|].
+ - apply and_intro; [apply pure_intro|].
+ destruct Hwf; constructor; simpl; eauto using Esnoc_wf.
intros j; destruct (strings.string_beq_reflect j i); naive_solver.
- + by rewrite persistently_sep assoc.
- - apply sep_intro_True_l; [apply pure_intro|].
+ + by rewrite bare_persistently_sep assoc.
+ - apply and_intro; [apply pure_intro|].
+ destruct Hwf; constructor; simpl; eauto using Esnoc_wf.
intros j; destruct (strings.string_beq_reflect j i); naive_solver.
+ solve_sep_entails.
Qed.
-Lemma envs_app_sound Δ Δ' p Γ : envs_app p Γ Δ = Some Δ' → Δ ⊢ □?p [∗] Γ -∗ Δ'.
+Lemma envs_app_sound Δ Δ' p Γ : envs_app p Γ Δ = Some Δ' → Δ ⊢ ⬕?p [∗] Γ -∗ Δ'.
Proof.
- rewrite /of_envs /envs_app=> ?; apply pure_elim_sep_l=> Hwf.
+ rewrite /of_envs /envs_app=> ?; apply pure_elim_l=> Hwf.
destruct Δ as [Γp Γs], p; simplify_eq/=.
- destruct (env_app Γ Γs) eqn:Happ,
(env_app Γ Γp) as [Γp'|] eqn:?; simplify_eq/=.
- apply wand_intro_l, sep_intro_True_l; [apply pure_intro|].
+ apply wand_intro_l, and_intro; [apply pure_intro|].
+ destruct Hwf; constructor; simpl; eauto using env_app_wf.
intros j. apply (env_app_disjoint _ _ _ j) in Happ.
naive_solver eauto using env_app_fresh.
+ rewrite (env_app_perm _ _ Γp') //.
- rewrite big_opL_app persistently_sep. solve_sep_entails.
+ rewrite big_opL_app bare_persistently_sep. solve_sep_entails.
- destruct (env_app Γ Γp) eqn:Happ,
(env_app Γ Γs) as [Γs'|] eqn:?; simplify_eq/=.
- apply wand_intro_l, sep_intro_True_l; [apply pure_intro|].
+ apply wand_intro_l, and_intro; [apply pure_intro|].
+ destruct Hwf; constructor; simpl; eauto using env_app_wf.
intros j. apply (env_app_disjoint _ _ _ j) in Happ.
naive_solver eauto using env_app_fresh.
@@ -246,21 +245,21 @@ Qed.
Lemma envs_simple_replace_sound' Δ Δ' i p Γ :
envs_simple_replace i p Γ Δ = Some Δ' →
- envs_delete i p Δ ⊢ □?p [∗] Γ -∗ Δ'.
+ envs_delete i p Δ ⊢ ⬕?p [∗] Γ -∗ Δ'.
Proof.
rewrite /envs_simple_replace /envs_delete /of_envs=> ?.
- apply pure_elim_sep_l=> Hwf. destruct Δ as [Γp Γs], p; simplify_eq/=.
+ apply pure_elim_l=> Hwf. destruct Δ as [Γp Γs], p; simplify_eq/=.
- destruct (env_app Γ Γs) eqn:Happ,
(env_replace i Γ Γp) as [Γp'|] eqn:?; simplify_eq/=.
- apply wand_intro_l, sep_intro_True_l; [apply pure_intro|].
+ apply wand_intro_l, and_intro; [apply pure_intro|].
+ destruct Hwf; constructor; simpl; eauto using env_replace_wf.
intros j. apply (env_app_disjoint _ _ _ j) in Happ.
destruct (decide (i = j)); try naive_solver eauto using env_replace_fresh.
+ rewrite (env_replace_perm _ _ Γp') //.
- rewrite big_opL_app persistently_sep. solve_sep_entails.
+ rewrite big_opL_app bare_persistently_sep. solve_sep_entails.
- destruct (env_app Γ Γp) eqn:Happ,
(env_replace i Γ Γs) as [Γs'|] eqn:?; simplify_eq/=.
- apply wand_intro_l, sep_intro_True_l; [apply pure_intro|].
+ apply wand_intro_l, and_intro; [apply pure_intro|].
+ destruct Hwf; constructor; simpl; eauto using env_replace_wf.
intros j. apply (env_app_disjoint _ _ _ j) in Happ.
destruct (decide (i = j)); try naive_solver eauto using env_replace_fresh.
@@ -269,11 +268,11 @@ Qed.
Lemma envs_simple_replace_sound Δ Δ' i p P Γ :
envs_lookup i Δ = Some (p,P) → envs_simple_replace i p Γ Δ = Some Δ' →
- Δ ⊢ □?p P ∗ (□?p [∗] Γ -∗ Δ').
+ Δ ⊢ ⬕?p P ∗ (⬕?p [∗] Γ -∗ Δ').
Proof. intros. by rewrite envs_lookup_sound// envs_simple_replace_sound'//. Qed.
Lemma envs_replace_sound' Δ Δ' i p q Γ :
- envs_replace i p q Γ Δ = Some Δ' → envs_delete i p Δ ⊢ □?q [∗] Γ -∗ Δ'.
+ envs_replace i p q Γ Δ = Some Δ' → envs_delete i p Δ ⊢ ⬕?q [∗] Γ -∗ Δ'.
Proof.
rewrite /envs_replace; destruct (eqb _ _) eqn:Hpq.
- apply eqb_prop in Hpq as ->. apply envs_simple_replace_sound'.
@@ -282,7 +281,7 @@ Qed.
Lemma envs_replace_sound Δ Δ' i p q P Γ :
envs_lookup i Δ = Some (p,P) → envs_replace i p q Γ Δ = Some Δ' →
- Δ ⊢ □?p P ∗ (□?q [∗] Γ -∗ Δ').
+ Δ ⊢ ⬕?p P ∗ (⬕?q [∗] Γ -∗ Δ').
Proof. intros. by rewrite envs_lookup_sound// envs_replace_sound'//. Qed.
Lemma envs_lookup_envs_clear_spatial Δ j :
@@ -294,17 +293,21 @@ Proof.
by destruct (Γs !! j).
Qed.
-Lemma envs_clear_spatial_sound Δ : Δ ⊢ envs_clear_spatial Δ ∗ [∗] env_spatial Δ.
+Lemma envs_clear_spatial_sound Δ :
+ Δ ⊢ envs_clear_spatial Δ ∗ [∗] env_spatial Δ.
Proof.
- rewrite /of_envs /envs_clear_spatial /=; apply pure_elim_sep_l=> Hwf.
- rewrite right_id -assoc; apply sep_intro_True_l; [apply pure_intro|done].
- destruct Hwf; constructor; simpl; auto using Enil_wf.
+ rewrite /of_envs /envs_clear_spatial /=. apply pure_elim_l=> Hwf.
+ rewrite right_id -persistent_and_sep_assoc. apply and_intro; [|done].
+ apply pure_intro. destruct Hwf; constructor; simpl; auto using Enil_wf.
Qed.
-Lemma env_spatial_is_nil_persistent Δ :
- env_spatial_is_nil Δ = true → Persistent Δ.
-Proof. intros; destruct Δ as [? []]; simplify_eq/=; apply _. Qed.
-Hint Immediate env_spatial_is_nil_persistent : typeclass_instances.
+Lemma env_spatial_is_nil_bare_persistently Δ :
+ env_spatial_is_nil Δ = true → Δ ⊢ ⬕ Δ.
+Proof.
+ intros. unfold of_envs; destruct Δ as [? []]; simplify_eq/=.
+ rewrite !right_id {1}bare_and_l persistently_and.
+ by rewrite persistently_bare persistently_idemp persistently_pure.
+Qed.
Lemma envs_lookup_envs_delete Δ i p P :
envs_wf Δ →
@@ -326,11 +329,13 @@ Qed.
Lemma envs_split_go_sound js Δ1 Δ2 Δ1' Δ2' :
(∀ j P, envs_lookup j Δ1 = Some (false, P) → envs_lookup j Δ2 = None) →
- envs_split_go js Δ1 Δ2 = Some (Δ1',Δ2') → Δ1 ∗ Δ2 ⊢ Δ1' ∗ Δ2'.
+ envs_split_go js Δ1 Δ2 = Some (Δ1',Δ2') →
+ Δ1 ∗ Δ2 ⊢ Δ1' ∗ Δ2'.
Proof.
revert Δ1 Δ2 Δ1' Δ2'.
induction js as [|j js IH]=> Δ1 Δ2 Δ1' Δ2' Hlookup HΔ; simplify_eq/=; [done|].
- apply pure_elim with (envs_wf Δ1); [unfold of_envs; solve_sep_entails|]=> Hwf.
+ apply pure_elim with (envs_wf Δ1)=> [|Hwf].
+ { by rewrite /of_envs !and_elim_l sep_elim_l. }
destruct (envs_lookup_delete j Δ1)
as [[[[] P] Δ1'']|] eqn:Hdel; simplify_eq; auto.
apply envs_lookup_delete_Some in Hdel as [??]; subst.
@@ -344,58 +349,76 @@ Qed.
Lemma envs_split_sound Δ lr js Δ1 Δ2 :
envs_split lr js Δ = Some (Δ1,Δ2) → Δ ⊢ Δ1 ∗ Δ2.
Proof.
- rewrite /envs_split=> ?. rewrite -(idemp uPred_and Δ).
- rewrite {2}envs_clear_spatial_sound sep_elim_l and_sep_r.
+ rewrite /envs_split=> ?. rewrite -(idemp bi_and Δ).
+ rewrite {2}envs_clear_spatial_sound.
+ rewrite (env_spatial_is_nil_bare_persistently (envs_clear_spatial _)) //.
+ rewrite -persistently_and_bare_sep_l.
+ rewrite (and_elim_l (â–¡ _)%I) persistently_and_bare_sep_r bare_persistently_elim.
destruct (envs_split_go _ _) as [[Δ1' Δ2']|] eqn:HΔ; [|done].
apply envs_split_go_sound in HΔ as ->; last first.
{ intros j P. by rewrite envs_lookup_envs_clear_spatial=> ->. }
destruct lr; simplify_eq; solve_sep_entails.
Qed.
-Global Instance envs_Forall2_refl (R : relation (uPred M)) :
+Global Instance envs_Forall2_refl (R : relation PROP) :
Reflexive R → Reflexive (envs_Forall2 R).
Proof. by constructor. Qed.
-Global Instance envs_Forall2_sym (R : relation (uPred M)) :
+Global Instance envs_Forall2_sym (R : relation PROP) :
Symmetric R → Symmetric (envs_Forall2 R).
Proof. intros ??? [??]; by constructor. Qed.
-Global Instance envs_Forall2_trans (R : relation (uPred M)) :
+Global Instance envs_Forall2_trans (R : relation PROP) :
Transitive R → Transitive (envs_Forall2 R).
Proof. intros ??? [??] [??] [??]; constructor; etrans; eauto. Qed.
-Global Instance envs_Forall2_antisymm (R R' : relation (uPred M)) :
+Global Instance envs_Forall2_antisymm (R R' : relation PROP) :
AntiSymm R R' → AntiSymm (envs_Forall2 R) (envs_Forall2 R').
Proof. intros ??? [??] [??]; constructor; by eapply (anti_symm _). Qed.
-Lemma envs_Forall2_impl (R R' : relation (uPred M)) Δ1 Δ2 :
+Lemma envs_Forall2_impl (R R' : relation PROP) Δ1 Δ2 :
envs_Forall2 R Δ1 Δ2 → (∀ P Q, R P Q → R' P Q) → envs_Forall2 R' Δ1 Δ2.
Proof. intros [??] ?; constructor; eauto using env_Forall2_impl. Qed.
-Global Instance of_envs_mono : Proper (envs_Forall2 (⊢) ==> (⊢)) (@of_envs M).
+Global Instance of_envs_mono : Proper (envs_Forall2 (⊢) ==> (⊢)) (@of_envs PROP).
Proof.
- intros [Γp1 Γs1] [Γp2 Γs2] [Hp Hs]; unfold of_envs; simpl in *.
- apply pure_elim_sep_l=>Hwf. apply sep_intro_True_l.
- - destruct Hwf; apply pure_intro; constructor;
+ intros [Γp1 Γs1] [Γp2 Γs2] [Hp Hs]; apply and_mono; simpl in *.
+ - apply pure_mono=> -[???]. constructor;
naive_solver eauto using env_Forall2_wf, env_Forall2_fresh.
- by repeat f_equiv.
Qed.
-Global Instance of_envs_proper : Proper (envs_Forall2 (⊣⊢) ==> (⊣⊢)) (@of_envs M).
+Global Instance of_envs_proper :
+ Proper (envs_Forall2 (⊣⊢) ==> (⊣⊢)) (@of_envs PROP).
Proof.
intros Δ1 Δ2 HΔ; apply (anti_symm (⊢)); apply of_envs_mono;
eapply (envs_Forall2_impl (⊣⊢)); [| |symmetry|]; eauto using equiv_entails.
Qed.
-Global Instance Envs_mono (R : relation (uPred M)) :
- Proper (env_Forall2 R ==> env_Forall2 R ==> envs_Forall2 R) (@Envs M).
+Global Instance Envs_mono (R : relation PROP) :
+ Proper (env_Forall2 R ==> env_Forall2 R ==> envs_Forall2 R) (@Envs PROP).
Proof. by constructor. Qed.
(** * Adequacy *)
Lemma tac_adequate P : (Envs Enil Enil ⊢ P) → P.
Proof.
- intros <-. rewrite /of_envs /= persistently_pure !right_id.
- apply pure_intro; repeat constructor.
+ intros <-. rewrite /of_envs /= bare_persistently_emp left_id.
+ apply and_intro=> //. apply pure_intro; repeat constructor.
Qed.
(** * Basic rules *)
-Lemma tac_assumption Δ i p P Q :
- envs_lookup i Δ = Some (p,P) → FromAssumption p P Q → Δ ⊢ Q.
-Proof. intros. by rewrite envs_lookup_sound // sep_elim_l. Qed.
+Lemma tac_emp_intro Δ :
+ env_spatial_is_nil Δ = true →
+ Δ ⊢ emp.
+Proof.
+ intros. by rewrite (env_spatial_is_nil_bare_persistently Δ) // (affine (⬕ Δ)).
+Qed.
+
+Lemma tac_assumption Δ Δ' i p P Q :
+ envs_lookup_delete i Δ = Some (p,P,Δ') →
+ FromAssumption p P Q →
+ (if env_spatial_is_nil Δ' then TCTrue else Absorbing Q) →
+ Δ ⊢ Q.
+Proof.
+ intros. rewrite envs_lookup_delete_sound //.
+ destruct (env_spatial_is_nil Δ') eqn:?.
+ - by rewrite (env_spatial_is_nil_bare_persistently Δ') // sep_elim_l.
+ - by rewrite from_assumption.
+Qed.
Lemma tac_rename Δ Δ' i j p P Q :
envs_lookup i Δ = Some (p,P) →
@@ -405,90 +428,71 @@ Proof.
intros. rewrite envs_simple_replace_sound //.
destruct p; simpl; by rewrite right_id wand_elim_r.
Qed.
+
Lemma tac_clear Δ Δ' i p P Q :
- envs_lookup_delete i Δ = Some (p,P,Δ') → (Δ' ⊢ Q) → Δ ⊢ Q.
-Proof. intros. by rewrite envs_lookup_delete_sound // sep_elim_r. Qed.
+ envs_lookup_delete i Δ = Some (p,P,Δ') →
+ (if p then TCTrue else TCOr (Affine P) (Absorbing Q)) →
+ (Δ' ⊢ Q) →
+ Δ ⊢ Q.
+Proof.
+ intros ? Hp HQ. rewrite envs_lookup_delete_sound //.
+ destruct p; by rewrite /= HQ sep_elim_r.
+Qed.
(** * False *)
Lemma tac_ex_falso Δ Q : (Δ ⊢ False) → Δ ⊢ Q.
Proof. by rewrite -(False_elim Q). Qed.
+Lemma tac_false_destruct Δ i p P Q :
+ envs_lookup i Δ = Some (p,P) →
+ P = False%I →
+ Δ ⊢ Q.
+Proof.
+ intros ? ->. rewrite envs_lookup_sound //; simpl.
+ by rewrite bare_persistently_if_elim sep_elim_l False_elim.
+Qed.
+
(** * Pure *)
Lemma tac_pure_intro Δ Q (φ : Prop) : FromPure Q φ → φ → Δ ⊢ Q.
Proof. intros ??. rewrite -(from_pure Q). by apply pure_intro. Qed.
Lemma tac_pure Δ Δ' i p P φ Q :
- envs_lookup_delete i Δ = Some (p, P, Δ') → IntoPure P φ →
+ envs_lookup_delete i Δ = Some (p, P, Δ') →
+ IntoPure P φ →
+ (if p then TCTrue else Affine P) →
(φ → Δ' ⊢ Q) → Δ ⊢ Q.
Proof.
- intros ?? HQ. rewrite envs_lookup_delete_sound' //; simpl.
- rewrite (into_pure P); by apply pure_elim_sep_l.
+ intros ??? HQ. rewrite envs_lookup_delete_sound //; simpl. destruct p; simpl.
+ - rewrite (into_pure P) -persistently_and_bare_sep_l persistently_pure.
+ by apply pure_elim_l.
+ - rewrite -(affine_bare P) (into_pure P) -persistent_and_bare_sep_l.
+ by apply pure_elim_l.
Qed.
Lemma tac_pure_revert Δ φ Q : (Δ ⊢ ⌜φ⌠→ Q) → (φ → Δ ⊢ Q).
Proof. intros HΔ ?. by rewrite HΔ pure_True // left_id. Qed.
-(** * Later *)
-Class IntoLaterNEnv (n : nat) (Γ1 Γ2 : env (uPred M)) :=
- into_laterN_env : env_Forall2 (IntoLaterN n) Γ1 Γ2.
-Class IntoLaterNEnvs (n : nat) (Δ1 Δ2 : envs M) := {
- into_later_persistent: IntoLaterNEnv n (env_persistent Δ1) (env_persistent Δ2);
- into_later_spatial: IntoLaterNEnv n (env_spatial Δ1) (env_spatial Δ2)
-}.
-
-Global Instance into_laterN_env_nil n : IntoLaterNEnv n Enil Enil.
-Proof. constructor. Qed.
-Global Instance into_laterN_env_snoc n Γ1 Γ2 i P Q :
- IntoLaterNEnv n Γ1 Γ2 → IntoLaterN n P Q →
- IntoLaterNEnv n (Esnoc Γ1 i P) (Esnoc Γ2 i Q).
-Proof. by constructor. Qed.
-
-Global Instance into_laterN_envs n Γp1 Γp2 Γs1 Γs2 :
- IntoLaterNEnv n Γp1 Γp2 → IntoLaterNEnv n Γs1 Γs2 →
- IntoLaterNEnvs n (Envs Γp1 Γs1) (Envs Γp2 Γs2).
-Proof. by split. Qed.
-
-Lemma into_laterN_env_sound n Δ1 Δ2 : IntoLaterNEnvs n Δ1 Δ2 → Δ1 ⊢ ▷^n Δ2.
+(** * Persistently *)
+Lemma tac_persistently_intro Δ Q Q' :
+ FromPersistent Q' Q →
+ (envs_clear_spatial Δ ⊢ Q) → Δ ⊢ Q'.
Proof.
- intros [Hp Hs]; rewrite /of_envs /= !laterN_sep -persistently_laterN.
- repeat apply sep_mono; try apply persistently_mono.
- - rewrite -laterN_intro; apply pure_mono; destruct 1; constructor;
- naive_solver eauto using env_Forall2_wf, env_Forall2_fresh.
- - induction Hp; rewrite /= ?laterN_sep. apply laterN_intro. by apply sep_mono.
- - induction Hs; rewrite /= ?laterN_sep. apply laterN_intro. by apply sep_mono.
-Qed.
-
-Lemma tac_next Δ Δ' n Q Q' :
- FromLaterN n Q Q' → IntoLaterNEnvs n Δ Δ' → (Δ' ⊢ Q') → Δ ⊢ Q.
-Proof. intros ?? HQ. by rewrite -(from_laterN n Q) into_laterN_env_sound HQ. Qed.
-
-Lemma tac_löb Δ Δ' i Q :
- env_spatial_is_nil Δ = true →
- envs_app true (Esnoc Enil i (▷ Q)%I) Δ = Some Δ' →
- (Δ' ⊢ Q) → Δ ⊢ Q.
-Proof.
- intros ?? HQ. rewrite -(persistently_elim Q) -(löb (□ Q)) -persistently_later.
- apply impl_intro_l, (persistently_intro _ _).
- rewrite envs_app_sound //; simpl.
- by rewrite right_id persistently_and_sep_l wand_elim_r HQ.
-Qed.
-
-(** * Always *)
-Lemma tac_persistently_intro Δ Q :
- (envs_clear_spatial Δ ⊢ Q) → Δ ⊢ □ Q.
-Proof.
- intros <-. rewrite envs_clear_spatial_sound sep_elim_l.
- by apply (persistently_intro _ _).
+ intros ? HQ. rewrite -(from_persistent Q') -HQ envs_clear_spatial_sound.
+ rewrite {1}(env_spatial_is_nil_bare_persistently (envs_clear_spatial Δ)) //.
+ by rewrite -persistently_and_bare_sep_l and_elim_l.
Qed.
Lemma tac_persistent Δ Δ' i p P P' Q :
envs_lookup i Δ = Some (p, P) →
IntoPersistent p P P' →
+ (if p then TCTrue else Affine P) →
envs_replace i p true (Esnoc Enil i P') Δ = Some Δ' →
(Δ' ⊢ Q) → Δ ⊢ Q.
Proof.
- intros ? HP ? <-. rewrite envs_replace_sound //; simpl.
- by rewrite right_id (into_persistent _ P) wand_elim_r.
+ intros ???? <-. rewrite envs_replace_sound //; simpl.
+ rewrite right_id. apply wand_elim_r', wand_mono=> //. destruct p; simpl.
+ - by rewrite -(into_persistent _ P).
+ - by rewrite -(into_persistent _ P) /= affine_bare.
Qed.
(** * Implication and wand *)
@@ -498,19 +502,20 @@ Lemma tac_impl_intro Δ Δ' i P Q :
(Δ' ⊢ Q) → Δ ⊢ P → Q.
Proof.
intros ?? <-. destruct (env_spatial_is_nil Δ) eqn:?.
- - rewrite (persistent Δ) envs_app_sound //; simpl.
- by rewrite right_id -persistently_impl_wand persistently_elim.
+ - rewrite (env_spatial_is_nil_bare_persistently Δ) // envs_app_sound //; simpl.
+ rewrite right_id. apply impl_intro_l. rewrite bare_and_l persistently_and_sep_r_1.
+ by rewrite bare_sep bare_persistently_elim bare_elim wand_elim_r.
- apply impl_intro_l. rewrite envs_app_sound //; simpl.
- by rewrite and_sep_l right_id wand_elim_r.
+ by rewrite persistent_and_sep_l_1 right_id wand_elim_r.
Qed.
Lemma tac_impl_intro_persistent Δ Δ' i P P' Q :
IntoPersistent false P P' →
envs_app true (Esnoc Enil i P') Δ = Some Δ' →
(Δ' ⊢ Q) → Δ ⊢ P → Q.
Proof.
- intros ?? HQ. rewrite envs_app_sound //=; simpl. apply impl_intro_l.
- rewrite (_ : P = â–¡?false P) // (into_persistent false P).
- by rewrite right_id persistently_and_sep_l wand_elim_r.
+ intros ?? <-. rewrite envs_app_sound //; simpl. apply impl_intro_l.
+ rewrite (_ : P = â–¡?false P)%I // (into_persistent false P).
+ by rewrite right_id persistently_and_bare_sep_l wand_elim_r.
Qed.
Lemma tac_impl_intro_drop Δ P Q : (Δ ⊢ Q) → Δ ⊢ P → Q.
@@ -523,21 +528,26 @@ Proof.
Qed.
Lemma tac_wand_intro_persistent Δ Δ' i P P' Q :
IntoPersistent false P P' →
+ Affine P →
envs_app true (Esnoc Enil i P') Δ = Some Δ' →
(Δ' ⊢ Q) → Δ ⊢ P -∗ Q.
Proof.
- intros. rewrite envs_app_sound //; simpl.
- rewrite right_id. by apply wand_mono.
+ intros ??? <-. rewrite envs_app_sound //; simpl.
+ rewrite right_id. apply wand_mono=>//.
+ by rewrite -(into_persistent _ P) /= affine_bare.
Qed.
-Lemma tac_wand_intro_drop Δ P Q : (Δ ⊢ Q) → Δ ⊢ P -∗ Q.
-Proof. intros. apply wand_intro_l. by rewrite sep_elim_r. Qed.
+Lemma tac_wand_intro_drop Δ P Q :
+ TCOr (Affine P) (Absorbing Q) →
+ (Δ ⊢ Q) →
+ Δ ⊢ P -∗ Q.
+Proof. intros HPQ ->. apply wand_intro_l. by rewrite sep_elim_r. Qed.
(* This is pretty much [tac_specialize_assert] with [js:=[j]] and [tac_exact],
but it is doing some work to keep the order of hypotheses preserved. *)
Lemma tac_specialize Δ Δ' Δ'' i p j q P1 P2 R Q :
envs_lookup_delete i Δ = Some (p, P1, Δ') →
envs_lookup j (if p then Δ else Δ') = Some (q, R) →
- IntoWand p R P1 P2 →
+ IntoWand q p R P1 P2 →
match p with
| true => envs_simple_replace j q (Esnoc Enil j P2) Δ
| false => envs_replace j q false (Esnoc Enil j P2) Δ'
@@ -547,17 +557,18 @@ Lemma tac_specialize Δ Δ' Δ'' i p j q P1 P2 R Q :
Proof.
intros [? ->]%envs_lookup_delete_Some ??? <-. destruct p.
- rewrite envs_lookup_persistent_sound // envs_simple_replace_sound //; simpl.
- rewrite right_id assoc (into_wand _ R) /=. destruct q; simpl.
- + by rewrite persistently_wand persistent_persistently !wand_elim_r.
- + by rewrite !wand_elim_r.
+ rewrite -bare_persistently_if_idemp -bare_persistently_idemp into_wand /=.
+ rewrite assoc (bare_persistently_bare_persistently_if q) -bare_persistently_if_sep wand_elim_r.
+ by rewrite right_id wand_elim_r.
- rewrite envs_lookup_sound //; simpl.
rewrite envs_lookup_sound // (envs_replace_sound' _ Δ'') //; simpl.
- by rewrite right_id assoc (into_wand _ R) persistently_if_elim wand_elim_r wand_elim_r.
+ by rewrite into_wand /= assoc wand_elim_r right_id wand_elim_r.
Qed.
Lemma tac_specialize_assert Δ Δ' Δ1 Δ2' j q lr js R P1 P2 P1' Q :
envs_lookup_delete j Δ = Some (q, R, Δ') →
- IntoWand false R P1 P2 → ElimModal P1' P1 Q Q →
+ IntoWand q false R P1 P2 →
+ ElimModal P1' P1 Q Q →
('(Δ1,Δ2) ↠envs_split lr js Δ';
Δ2' ↠envs_app false (Esnoc Enil j P2) Δ2;
Some (Δ1,Δ2')) = Some (Δ1,Δ2') → (* does not preserve position of [j] *)
@@ -568,9 +579,8 @@ Proof.
destruct (envs_app _ _ _) eqn:?; simplify_eq/=.
rewrite envs_lookup_sound // envs_split_sound //.
rewrite (envs_app_sound Δ2) //; simpl.
- rewrite right_id (into_wand _ R) HP1 assoc -(comm _ P1') -assoc.
- rewrite -(elim_modal P1' P1 Q Q). apply sep_mono_r, wand_intro_l.
- by rewrite persistently_if_elim assoc !wand_elim_r.
+ rewrite HP1 into_wand /= -(elim_modal P1' P1 Q Q). cancel [P1'].
+ apply wand_intro_l. by rewrite assoc right_id !wand_elim_r.
Qed.
Lemma tac_unlock P Q : (P ⊢ Q) → P ⊢ locked Q.
@@ -578,7 +588,7 @@ Proof. by unlock. Qed.
Lemma tac_specialize_frame Δ Δ' j q R P1 P2 P1' Q Q' :
envs_lookup_delete j Δ = Some (q, R, Δ') →
- IntoWand false R P1 P2 →
+ IntoWand q false R P1 P2 →
ElimModal P1' P1 Q Q →
(Δ' ⊢ P1' ∗ locked Q') →
Q' = (P2 -∗ Q)%I →
@@ -586,66 +596,74 @@ Lemma tac_specialize_frame Δ Δ' j q R P1 P2 P1' Q Q' :
Proof.
intros [? ->]%envs_lookup_delete_Some ?? HPQ ->.
rewrite envs_lookup_sound //. rewrite HPQ -lock.
- rewrite (into_wand _ R) assoc -(comm _ P1') -assoc persistently_if_elim.
- rewrite -{2}(elim_modal P1' P1 Q Q). apply sep_mono_r, wand_intro_l.
- by rewrite assoc !wand_elim_r.
+ rewrite into_wand -{2}(elim_modal P1' P1 Q Q). cancel [P1'].
+ apply wand_intro_l. by rewrite assoc !wand_elim_r.
Qed.
Lemma tac_specialize_assert_pure Δ Δ' j q R P1 P2 φ Q :
envs_lookup j Δ = Some (q, R) →
- IntoWand false R P1 P2 → FromPure P1 φ →
+ IntoWand q true R P1 P2 →
+ FromPure P1 φ →
envs_simple_replace j q (Esnoc Enil j P2) Δ = Some Δ' →
φ → (Δ' ⊢ Q) → Δ ⊢ Q.
Proof.
intros. rewrite envs_simple_replace_sound //; simpl.
- rewrite right_id (into_wand _ R) -(from_pure P1) pure_True //.
- by rewrite wand_True wand_elim_r.
+ rewrite -bare_persistently_if_idemp into_wand /= -(from_pure P1).
+ rewrite pure_True // persistently_pure bare_True_emp bare_emp.
+ by rewrite emp_wand right_id wand_elim_r.
Qed.
Lemma tac_specialize_assert_persistent Δ Δ' Δ'' j q P1 P2 R Q :
envs_lookup_delete j Δ = Some (q, R, Δ') →
- IntoWand false R P1 P2 → Persistent P1 →
+ IntoWand q true R P1 P2 →
+ Persistent P1 →
envs_simple_replace j q (Esnoc Enil j P2) Δ = Some Δ'' →
(Δ' ⊢ P1) → (Δ'' ⊢ Q) → Δ ⊢ Q.
Proof.
intros [? ->]%envs_lookup_delete_Some ??? HP1 <-.
rewrite envs_lookup_sound //.
- rewrite -(idemp uPred_and (envs_delete _ _ _)).
- rewrite {1}HP1 (persistent P1) persistently_and_sep_l assoc.
- rewrite envs_simple_replace_sound' //; simpl.
- rewrite right_id (into_wand _ R) (persistently_elim_if q) -persistently_if_sep wand_elim_l.
- by rewrite wand_elim_r.
+ rewrite -(idemp bi_and (envs_delete _ _ _)).
+ rewrite {2}envs_simple_replace_sound' //; simpl.
+ rewrite {1}HP1 persistent_and_bare_sep_l -(persistent_persistently P1) assoc.
+ rewrite -bare_persistently_if_idemp -bare_persistently_idemp.
+ rewrite (bare_persistently_bare_persistently_if q) -bare_persistently_if_sep.
+ by rewrite into_wand wand_elim_l right_id wand_elim_r.
Qed.
-Lemma tac_specialize_persistent_helper Δ Δ' j q P R Q :
+Lemma tac_specialize_persistent_helper Δ Δ'' j q P R R' Q :
envs_lookup j Δ = Some (q,P) →
- (Δ ⊢ R) → Persistent R →
- envs_replace j q true (Esnoc Enil j R) Δ = Some Δ' →
- (Δ' ⊢ Q) → Δ ⊢ Q.
+ (Δ ⊢ R) →
+ IntoPersistent false R R' →
+ (if q then TCTrue else Affine R) →
+ envs_replace j q true (Esnoc Enil j R') Δ = Some Δ'' →
+ (Δ'' ⊢ Q) → Δ ⊢ Q.
Proof.
- intros ? HR ?? <-.
- rewrite -(idemp uPred_and Δ) {1}HR and_sep_l.
- rewrite envs_replace_sound //; simpl.
- by rewrite right_id assoc (sep_elim_l R) persistent_persistently wand_elim_r.
+ intros ? HR ??? <-. rewrite -(idemp bi_and Δ) {1}HR.
+ rewrite envs_replace_sound //; rewrite /= right_id. destruct q; simpl.
+ - rewrite (_ : R = â–¡?false R)%I // (into_persistent _ R).
+ by rewrite sep_elim_r persistently_and_bare_sep_l wand_elim_r.
+ - rewrite -(affine_bare R) (_ : R = â–¡?false R)%I // (into_persistent _ R).
+ rewrite bare_and_r -bare_and_l bare_sep sep_elim_r bare_elim.
+ by rewrite persistently_and_bare_sep_l wand_elim_r.
Qed.
Lemma tac_revert Δ Δ' i p P Q :
envs_lookup_delete i Δ = Some (p,P,Δ') →
- (Δ' ⊢ (if p then □ P else P) -∗ Q) → Δ ⊢ Q.
+ (Δ' ⊢ (if p then ⬕ P else P) -∗ Q) → Δ ⊢ Q.
Proof.
intros ? HQ. rewrite envs_lookup_delete_sound //; simpl.
- by rewrite HQ /uPred_persistently_if wand_elim_r.
+ rewrite HQ. destruct p; simpl; auto using wand_elim_r.
Qed.
-Class IntoIH (φ : Prop) (Δ : envs M) (Q : uPred M) :=
+Class IntoIH {PROP : bi} (φ : Prop) (Δ : envs PROP) (Q : PROP) :=
into_ih : φ → Δ ⊢ Q.
Global Instance into_ih_entails Δ Q : IntoIH (of_envs Δ ⊢ Q) Δ Q.
Proof. by rewrite /IntoIH. Qed.
Global Instance into_ih_forall {A} (φ : A → Prop) Δ Φ :
- (∀ x, IntoIH (φ x) Δ (Φ x)) → IntoIH (∀ x, φ x) Δ (∀ x, Φ x) | 2.
+ (∀ x, IntoIH (φ x) Δ (Φ x)) → IntoIH (∀ x, φ x) Δ (∀ x, Φ x)%I | 2.
Proof. rewrite /IntoIH=> HΔ ?. apply forall_intro=> x. by rewrite (HΔ x). Qed.
Global Instance into_ih_impl (φ ψ : Prop) Δ Q :
- IntoIH φ Δ Q → IntoIH (ψ → φ) Δ (⌜ψ⌠→ Q) | 1.
+ IntoIH φ Δ Q → IntoIH (ψ → φ) Δ (⌜ψ⌠→ Q)%I | 1.
Proof. rewrite /IntoIH=> HΔ ?. apply impl_intro_l, pure_elim_l. auto. Qed.
Lemma tac_revert_ih Δ P Q {φ : Prop} (Hφ : φ) :
@@ -655,7 +673,9 @@ Lemma tac_revert_ih Δ P Q {φ : Prop} (Hφ : φ) :
(of_envs Δ ⊢ Q).
Proof.
rewrite /IntoIH. intros HP ? HPQ.
- by rewrite -(idemp uPred_and Δ) {1}(persistent Δ) {1}HP // HPQ impl_elim_r.
+ rewrite (env_spatial_is_nil_bare_persistently Δ) //.
+ rewrite -(idemp bi_and (⬕ Δ)%I) {1}HP // HPQ.
+ by rewrite -{1}persistently_idemp !bare_persistently_elim impl_elim_r.
Qed.
Lemma tac_assert Δ Δ1 Δ2 Δ2' lr js j P P' Q :
@@ -669,24 +689,28 @@ Proof.
by rewrite right_id HP HQ.
Qed.
-Lemma tac_assert_persistent Δ Δ1 Δ2 Δ' lr js j P Q :
+Lemma tac_assert_persistent Δ Δ1 Δ2 Δ' lr js j P P' Q :
envs_split lr js Δ = Some (Δ1,Δ2) →
- envs_app false (Esnoc Enil j P) Δ = Some Δ' →
Persistent P →
+ FromBare P' P →
+ envs_app false (Esnoc Enil j P') Δ = Some Δ' →
(Δ1 ⊢ P) → (Δ' ⊢ Q) → Δ ⊢ Q.
Proof.
- intros ??? HP <-. rewrite -(idemp uPred_and Δ) {1}envs_split_sound //.
- rewrite HP sep_elim_l (and_sep_l P) envs_app_sound //; simpl.
+ intros ???? HP <-. rewrite -(idemp bi_and Δ) {1}envs_split_sound //.
+ rewrite HP sep_elim_l persistent_and_bare_sep_l from_bare.
+ rewrite envs_app_sound //; simpl.
by rewrite right_id wand_elim_r.
Qed.
-Lemma tac_assert_pure Δ Δ' j P φ Q :
- envs_app false (Esnoc Enil j P) Δ = Some Δ' →
+Lemma tac_assert_pure Δ Δ' j P P' φ Q :
FromPure P φ →
+ FromBare P' P →
+ envs_app false (Esnoc Enil j P') Δ = Some Δ' →
φ → (Δ' ⊢ Q) → Δ ⊢ Q.
Proof.
- intros ??? <-. rewrite envs_app_sound //; simpl.
- by rewrite right_id -(from_pure P) pure_True // -impl_wand True_impl.
+ intros ???? <-. rewrite envs_app_sound //; simpl.
+ rewrite right_id -(from_bare P') -(from_pure P) pure_True //.
+ by rewrite bare_True_emp bare_emp emp_wand.
Qed.
Lemma tac_pose_proof Δ Δ' j P Q :
@@ -695,7 +719,7 @@ Lemma tac_pose_proof Δ Δ' j P Q :
(Δ' ⊢ Q) → Δ ⊢ Q.
Proof.
intros HP ? <-. rewrite envs_app_sound //; simpl.
- by rewrite right_id -HP persistently_pure wand_True.
+ by rewrite right_id -HP bare_persistently_emp emp_wand.
Qed.
Lemma tac_pose_proof_hyp Δ Δ' Δ'' i p j P Q :
@@ -711,75 +735,75 @@ Proof.
Qed.
Lemma tac_apply Δ Δ' i p R P1 P2 :
- envs_lookup_delete i Δ = Some (p, R, Δ') → IntoWand false R P1 P2 →
+ envs_lookup_delete i Δ = Some (p, R, Δ') →
+ IntoWand p false R P1 P2 →
(Δ' ⊢ P1) → Δ ⊢ P2.
Proof.
- intros ?? HP1. rewrite envs_lookup_delete_sound' //.
- by rewrite (into_wand _ R) HP1 wand_elim_l.
+ intros ?? HP1. rewrite envs_lookup_delete_sound //.
+ by rewrite into_wand /= HP1 wand_elim_l.
Qed.
(** * Rewriting *)
Lemma tac_rewrite Δ i p Pxy (lr : bool) Q :
envs_lookup i Δ = Some (p, Pxy) →
- ∀ {A : ofeT} (x y : A) (Φ : A → uPred M),
- (Pxy ⊢ x ≡ y) →
+ ∀ {A : ofeT} (x y : A) (Φ : A → PROP),
+ IntoInternalEq Pxy x y →
(Q ⊣⊢ Φ (if lr then y else x)) →
- (NonExpansive Φ) →
+ NonExpansive Φ →
(Δ ⊢ Φ (if lr then x else y)) → Δ ⊢ Q.
Proof.
- intros ? A x y ? HPxy -> ?; apply internal_eq_rewrite; auto.
- rewrite {1}envs_lookup_sound' //; rewrite sep_elim_l HPxy.
+ intros ? A x y ? HPxy -> ?; apply internal_eq_rewrite'; auto.
+ rewrite {1}envs_lookup_sound //.
+ rewrite HPxy bare_persistently_if_elim sep_elim_l.
destruct lr; auto using internal_eq_sym.
Qed.
Lemma tac_rewrite_in Δ i p Pxy j q P (lr : bool) Q :
envs_lookup i Δ = Some (p, Pxy) →
envs_lookup j Δ = Some (q, P) →
- ∀ {A : ofeT} Δ' x y (Φ : A → uPred M),
- (Pxy ⊢ x ≡ y) →
+ ∀ {A : ofeT} Δ' (x y : A) (Φ : A → PROP),
+ IntoInternalEq Pxy x y →
(P ⊣⊢ Φ (if lr then y else x)) →
- (NonExpansive Φ) →
+ NonExpansive Φ →
envs_simple_replace j q (Esnoc Enil j (Φ (if lr then x else y))) Δ = Some Δ' →
(Δ' ⊢ Q) → Δ ⊢ Q.
Proof.
intros ?? A Δ' x y Φ HPxy HP ?? <-.
- rewrite -(idemp uPred_and Δ) {2}(envs_lookup_sound' _ i) //.
- rewrite sep_elim_l HPxy and_sep_r.
+ rewrite -(idemp bi_and Δ) {2}(envs_lookup_sound _ i) //.
rewrite (envs_simple_replace_sound _ _ j) //; simpl.
- rewrite HP right_id -assoc; apply wand_elim_r'. destruct lr.
- - apply (internal_eq_rewrite x y (λ y, □?q Φ y -∗ Δ')%I);
- eauto with I. solve_proper.
- - apply (internal_eq_rewrite y x (λ y, □?q Φ y -∗ Δ')%I);
- eauto using internal_eq_sym with I.
- solve_proper.
+ rewrite HP right_id HPxy (bare_persistently_if_elim _ (_ ≡ _)%I) sep_elim_l.
+ rewrite persistent_and_bare_sep_r -assoc. apply wand_elim_r'.
+ rewrite -persistent_and_bare_sep_r. apply impl_elim_r'. destruct lr.
+ - apply (internal_eq_rewrite x y (λ y, ⬕?q Φ y -∗ Δ')%I). solve_proper.
+ - rewrite internal_eq_sym.
+ eapply (internal_eq_rewrite y x (λ y, ⬕?q Φ y -∗ Δ')%I). solve_proper.
Qed.
(** * Conjunction splitting *)
Lemma tac_and_split Δ P Q1 Q2 :
- FromAnd true P Q1 Q2 → (Δ ⊢ Q1) → (Δ ⊢ Q2) → Δ ⊢ P.
-Proof. intros. rewrite -(from_and true P). by apply and_intro. Qed.
+ FromAnd P Q1 Q2 → (Δ ⊢ Q1) → (Δ ⊢ Q2) → Δ ⊢ P.
+Proof. intros. rewrite -(from_and P). by apply and_intro. Qed.
(** * Separating conjunction splitting *)
Lemma tac_sep_split Δ Δ1 Δ2 lr js P Q1 Q2 :
- FromAnd false P Q1 Q2 →
+ FromSep P Q1 Q2 →
envs_split lr js Δ = Some (Δ1,Δ2) →
(Δ1 ⊢ Q1) → (Δ2 ⊢ Q2) → Δ ⊢ P.
-Proof.
- intros. rewrite envs_split_sound // -(from_and false P). by apply sep_mono.
-Qed.
+Proof. intros ?? HQ1 HQ2. rewrite envs_split_sound //. by rewrite HQ1 HQ2. Qed.
(** * Combining *)
-Class FromSeps {M} (P : uPred M) (Qs : list (uPred M)) :=
+Class FromSeps {PROP : bi} (P : PROP) (Qs : list PROP) :=
from_seps : [∗] Qs ⊢ P.
-Arguments from_seps {_} _ _ {_}.
+Arguments FromSeps {_} _%I _%I.
+Arguments from_seps {_} _%I _%I {_}.
-Global Instance from_seps_nil : @FromSeps M True [].
-Proof. done. Qed.
+Global Instance from_seps_nil : @FromSeps PROP emp [].
+Proof. by rewrite /FromSeps. Qed.
Global Instance from_seps_singleton P : FromSeps P [P] | 1.
Proof. by rewrite /FromSeps /= right_id. Qed.
Global Instance from_seps_cons P P' Q Qs :
- FromSeps P' Qs → FromAnd false P Q P' → FromSeps P (Q :: Qs) | 2.
-Proof. by rewrite /FromSeps /FromAnd /= => ->. Qed.
+ FromSeps P' Qs → FromSep P Q P' → FromSeps P (Q :: Qs) | 2.
+Proof. by rewrite /FromSeps /FromSep /= => ->. Qed.
Lemma tac_combine Δ1 Δ2 Δ3 js p Ps j P Q :
envs_lookup_delete_list js false Δ1 = Some (p, Ps, Δ2) →
@@ -794,37 +818,49 @@ Qed.
(** * Conjunction/separating conjunction elimination *)
Lemma tac_and_destruct Δ Δ' i p j1 j2 P P1 P2 Q :
- envs_lookup i Δ = Some (p, P) → IntoAnd p P P1 P2 →
+ envs_lookup i Δ = Some (p, P) → IntoSep p P P1 P2 →
envs_simple_replace i p (Esnoc (Esnoc Enil j1 P1) j2 P2) Δ = Some Δ' →
(Δ' ⊢ Q) → Δ ⊢ Q.
Proof.
- intros. rewrite envs_simple_replace_sound //; simpl. rewrite (into_and p P).
- by destruct p; rewrite /= ?right_id (comm _ P1) ?persistently_and_sep wand_elim_r.
+ intros. rewrite envs_simple_replace_sound //; simpl.
+ by rewrite (into_sep _ P) right_id -(comm _ P1) wand_elim_r.
Qed.
(* Using this tactic, one can destruct a (non-separating) conjunction in the
spatial context as long as one of the conjuncts is thrown away. It corresponds
to the principle of "external choice" in linear logic. *)
Lemma tac_and_destruct_choice Δ Δ' i p (lr : bool) j P P1 P2 Q :
- envs_lookup i Δ = Some (p, P) → IntoAnd true P P1 P2 →
+ envs_lookup i Δ = Some (p, P) →
+ TCOr (IntoAnd p P P1 P2) (TCAnd (IntoSep p P P1 P2)
+ (if p then TCTrue
+ else if lr then TCOr (Affine P2) (Absorbing Q)
+ else TCOr (Affine P1) (Absorbing Q))) →
envs_simple_replace i p (Esnoc Enil j (if lr then P1 else P2)) Δ = Some Δ' →
(Δ' ⊢ Q) → Δ ⊢ Q.
Proof.
- intros. rewrite envs_simple_replace_sound //; simpl.
- rewrite right_id (into_and true P). destruct lr.
- - by rewrite and_elim_l wand_elim_r.
- - by rewrite and_elim_r wand_elim_r.
+ intros ? HP ? HQ. rewrite envs_simple_replace_sound //; simpl.
+ destruct HP as [?|[??]].
+ - rewrite (into_and _ P) right_id HQ. destruct lr.
+ + by rewrite and_elim_l wand_elim_r.
+ + by rewrite and_elim_r wand_elim_r.
+ - rewrite (into_sep _ P) right_id HQ bare_persistently_if_sep. destruct p, lr; simpl.
+ + by rewrite (sep_elim_l (⬕ P1)%I) wand_elim_r.
+ + by rewrite (sep_elim_r (⬕ P1)%I) wand_elim_r.
+ + by rewrite (comm _ P1) -assoc wand_elim_r sep_elim_r.
+ + by rewrite -assoc wand_elim_r sep_elim_r.
Qed.
(** * Framing *)
Lemma tac_frame_pure Δ (φ : Prop) P Q :
φ → Frame true ⌜φ⌠P Q → (Δ ⊢ Q) → Δ ⊢ P.
Proof.
- intros ?? ->. by rewrite -(frame ⌜φ⌠P) /= persistently_pure pure_True // left_id.
+ intros ?? ->. rewrite -(frame ⌜φ⌠P) /=.
+ rewrite -persistently_and_bare_sep_l persistently_pure. auto using and_intro, pure_intro.
Qed.
Lemma tac_frame Δ Δ' i p R P Q :
- envs_lookup_delete i Δ = Some (p, R, Δ') → Frame p R P Q →
+ envs_lookup_delete i Δ = Some (p, R, Δ') →
+ Frame p R P Q →
((if p then Δ else Δ') ⊢ Q) → Δ ⊢ P.
Proof.
intros [? ->]%envs_lookup_delete_Some ? HQ. destruct p.
@@ -845,7 +881,7 @@ Lemma tac_or_destruct Δ Δ1 Δ2 i p j1 j2 P P1 P2 Q :
(Δ1 ⊢ Q) → (Δ2 ⊢ Q) → Δ ⊢ Q.
Proof.
intros ???? HP1 HP2. rewrite envs_lookup_sound //.
- rewrite (into_or P) persistently_if_or sep_or_r; apply or_elim.
+ rewrite (into_or P) bare_persistently_if_or sep_or_r; apply or_elim.
- rewrite (envs_simple_replace_sound' _ Δ1) //.
by rewrite /= right_id wand_elim_r.
- rewrite (envs_simple_replace_sound' _ Δ2) //.
@@ -853,13 +889,13 @@ Proof.
Qed.
(** * Forall *)
-Lemma tac_forall_intro {A} Δ (Φ : A → uPred M) Q :
+Lemma tac_forall_intro {A} Δ (Φ : A → PROP) Q :
FromForall Q Φ →
(∀ a, Δ ⊢ Φ a) →
Δ ⊢ Q.
Proof. rewrite /FromForall=> <-. apply forall_intro. Qed.
-Lemma tac_forall_specialize {A} Δ Δ' i p P (Φ : A → uPred M) Q :
+Lemma tac_forall_specialize {A} Δ Δ' i p P (Φ : A → PROP) Q :
envs_lookup i Δ = Some (p, P) → IntoForall P Φ →
(∃ x : A,
envs_simple_replace i p (Esnoc Enil i (Φ x)) Δ = Some Δ' ∧
@@ -870,23 +906,23 @@ Proof.
by rewrite right_id (into_forall P) (forall_elim x) wand_elim_r.
Qed.
-Lemma tac_forall_revert {A} Δ (Φ : A → uPred M) :
+Lemma tac_forall_revert {A} Δ (Φ : A → PROP) :
(Δ ⊢ ∀ a, Φ a) → ∀ a, Δ ⊢ Φ a.
Proof. intros HΔ a. by rewrite HΔ (forall_elim a). Qed.
(** * Existential *)
-Lemma tac_exist {A} Δ P (Φ : A → uPred M) :
+Lemma tac_exist {A} Δ P (Φ : A → PROP) :
FromExist P Φ → (∃ a, Δ ⊢ Φ a) → Δ ⊢ P.
Proof. intros ? [a ?]. rewrite -(from_exist P). eauto using exist_intro'. Qed.
-Lemma tac_exist_destruct {A} Δ i p j P (Φ : A → uPred M) Q :
+Lemma tac_exist_destruct {A} Δ i p j P (Φ : A → PROP) Q :
envs_lookup i Δ = Some (p, P) → IntoExist P Φ →
(∀ a, ∃ Δ',
envs_simple_replace i p (Esnoc Enil j (Φ a)) Δ = Some Δ' ∧ (Δ' ⊢ Q)) →
Δ ⊢ Q.
Proof.
intros ?? HΦ. rewrite envs_lookup_sound //.
- rewrite (into_exist P) persistently_if_exist sep_exist_r.
+ rewrite (into_exist P) bare_persistently_if_exist sep_exist_r.
apply exist_elim=> a; destruct (HΦ a) as (Δ'&?&?).
rewrite envs_simple_replace_sound' //; simpl. by rewrite right_id wand_elim_r.
Qed.
@@ -902,6 +938,63 @@ Lemma tac_modal_elim Δ Δ' i p P' P Q Q' :
(Δ' ⊢ Q') → Δ ⊢ Q.
Proof.
intros ??? HΔ. rewrite envs_replace_sound //; simpl.
- rewrite right_id HΔ persistently_if_elim. by apply elim_modal.
+ rewrite right_id HΔ bare_persistently_if_elim. by apply elim_modal.
+Qed.
+End bi_tactics.
+
+Section sbi_tactics.
+Context {PROP : sbi}.
+Implicit Types Γ : env PROP.
+Implicit Types Δ : envs PROP.
+Implicit Types P Q : PROP.
+
+(** * Later *)
+Class IntoLaterNEnv (n : nat) (Γ1 Γ2 : env PROP) :=
+ into_laterN_env : env_Forall2 (IntoLaterN n) Γ1 Γ2.
+Class IntoLaterNEnvs (n : nat) (Δ1 Δ2 : envs PROP) := {
+ into_later_persistent: IntoLaterNEnv n (env_persistent Δ1) (env_persistent Δ2);
+ into_later_spatial: IntoLaterNEnv n (env_spatial Δ1) (env_spatial Δ2)
+}.
+
+Global Instance into_laterN_env_nil n : IntoLaterNEnv n Enil Enil.
+Proof. constructor. Qed.
+Global Instance into_laterN_env_snoc n Γ1 Γ2 i P Q :
+ IntoLaterNEnv n Γ1 Γ2 → IntoLaterN n P Q →
+ IntoLaterNEnv n (Esnoc Γ1 i P) (Esnoc Γ2 i Q).
+Proof. by constructor. Qed.
+
+Global Instance into_laterN_envs n Γp1 Γp2 Γs1 Γs2 :
+ IntoLaterNEnv n Γp1 Γp2 → IntoLaterNEnv n Γs1 Γs2 →
+ IntoLaterNEnvs n (Envs Γp1 Γs1) (Envs Γp2 Γs2).
+Proof. by split. Qed.
+
+Lemma into_laterN_env_sound n Δ1 Δ2 :
+ IntoLaterNEnvs n Δ1 Δ2 → Δ1 ⊢ ▷^n (Δ2 : bi_car _).
+Proof.
+ intros [Hp Hs]; rewrite /of_envs /= !laterN_and !laterN_sep.
+ rewrite -{1}laterN_intro -bare_persistently_laterN.
+ apply and_mono, sep_mono.
+ - apply pure_mono; destruct 1; constructor;
+ naive_solver eauto using env_Forall2_wf, env_Forall2_fresh.
+ - apply bare_mono, persistently_mono.
+ induction Hp; rewrite /= ?laterN_sep. apply laterN_intro. by apply sep_mono.
+ - induction Hs; rewrite /= ?laterN_sep. apply laterN_intro. by apply sep_mono.
+Qed.
+
+Lemma tac_next Δ Δ' n Q Q' :
+ FromLaterN n Q Q' → IntoLaterNEnvs n Δ Δ' → (Δ' ⊢ Q') → Δ ⊢ Q.
+Proof. intros ?? HQ. by rewrite -(from_laterN n Q) into_laterN_env_sound HQ. Qed.
+
+Lemma tac_löb Δ Δ' i Q :
+ env_spatial_is_nil Δ = true →
+ envs_app true (Esnoc Enil i (▷ Q)%I) Δ = Some Δ' →
+ (Δ' ⊢ Q) → Δ ⊢ Q.
+Proof.
+ intros ?? HQ. rewrite (env_spatial_is_nil_bare_persistently Δ) //.
+ rewrite -(persistently_and_emp_elim Q). apply and_intro; first apply: affine.
+ rewrite -(löb (□ Q)%I) later_persistently. apply impl_intro_l.
+ rewrite envs_app_sound //; simpl; rewrite HQ right_id.
+ rewrite persistently_and_bare_sep_l -{1}bare_persistently_idemp -bare_persistently_sep.
+ by rewrite wand_elim_r bare_elim.
Qed.
-End tactics.
+End sbi_tactics.
diff --git a/theories/proofmode/environments.v b/theories/proofmode/environments.v
index 8ed1a9bf6..c2280ac28 100644
--- a/theories/proofmode/environments.v
+++ b/theories/proofmode/environments.v
@@ -73,6 +73,12 @@ Fixpoint env_lookup_delete {A} (i : string) (Γ : env A) : option (A * env A) :=
else '(y,Γ') ↠env_lookup_delete i Γ; Some (y, Esnoc Γ' j x)
end.
+Definition env_is_singleton {A} (Γ : env A) : bool :=
+ match Γ with
+ | Esnoc (Esnoc Enil _ _) _ _ => true
+ | _ => false
+ end.
+
Inductive env_Forall2 {A B} (P : A → B → Prop) : env A → env B → Prop :=
| env_Forall2_nil : env_Forall2 P Enil Enil
| env_Forall2_snoc Γ1 Γ2 i x y :
diff --git a/theories/proofmode/notation.v b/theories/proofmode/notation.v
index 8e34280a8..7e6798cbc 100644
--- a/theories/proofmode/notation.v
+++ b/theories/proofmode/notation.v
@@ -5,7 +5,7 @@ Set Default Proof Using "Type".
Delimit Scope proof_scope with env.
Arguments Envs _ _%proof_scope _%proof_scope.
Arguments Enil {_}.
-Arguments Esnoc {_} _%proof_scope _%string _%uPred_scope.
+Arguments Esnoc {_} _%proof_scope _%string _%I.
Notation "" := Enil (only printing) : proof_scope.
Notation "Γ H : P" := (Esnoc Γ H P)
diff --git a/theories/proofmode/tactics.v b/theories/proofmode/tactics.v
index cfc065826..311944a27 100644
--- a/theories/proofmode/tactics.v
+++ b/theories/proofmode/tactics.v
@@ -1,6 +1,6 @@
From iris.proofmode Require Import coq_tactics.
From iris.proofmode Require Import intro_patterns spec_patterns sel_patterns.
-From iris.base_logic Require Export base_logic.
+From iris.bi Require Export bi.
From iris.proofmode Require Export classes notation.
From iris.proofmode Require Import class_instances.
From stdpp Require Import stringmap hlist.
@@ -50,25 +50,26 @@ Tactic Notation "iMatchHyp" tactic1(tac) :=
| |- context[ environments.Esnoc _ ?x ?P ] => tac x P
end.
-Class AsValid {M} (φ : Prop) (P : uPred M) := as_entails : φ ↔ P.
+Class AsValid {PROP : bi} (φ : Prop) (P : PROP) := as_entails : φ ↔ P.
Arguments AsValid {_} _%type _%I.
-Instance as_valid_valid {M} (P : uPred M) : AsValid (uPred_valid P) P | 0.
+Instance as_valid_valid {PROP : bi} (P : PROP) : AsValid (bi_valid P) P | 0.
Proof. by rewrite /AsValid. Qed.
-Instance as_valid_entails {M} (P Q : uPred M) : AsValid (P ⊢ Q) (P -∗ Q) | 1.
-Proof. split. apply uPred.entails_wand. apply uPred.wand_entails. Qed.
+Instance as_valid_entails {PROP : bi} (P Q : PROP) : AsValid (P ⊢ Q) (P -∗ Q) | 1.
+Proof. split. apply bi.entails_wand. apply bi.wand_entails. Qed.
-Instance as_valid_equiv {M} (P Q : uPred M) : AsValid (P ≡ Q) (P ↔ Q).
-Proof. split. apply uPred.equiv_iff. apply uPred.iff_equiv. Qed.
+Instance as_valid_equiv {PROP : bi} (P Q : PROP) : AsValid (P ≡ Q) (P ∗-∗ Q).
+Proof. split. apply bi.equiv_wand_iff. apply bi.wand_iff_equiv. Qed.
(** * Start a proof *)
Ltac iStartProof :=
lazymatch goal with
| |- of_envs _ ⊢ _ => idtac
+ | |- let _ := _ in _ => fail
| |- ?P =>
apply (proj2 (_ : AsValid P _)), tac_adequate
- || fail "iStartProof: not a uPred"
+ || fail "iStartProof: not a BI entailment"
end.
(** * Context manipulation *)
@@ -112,7 +113,11 @@ Tactic Notation "iClear" constr(Hs) :=
| ESelPure :: ?Hs => clear; go Hs
| ESelName _ ?H :: ?Hs =>
eapply tac_clear with _ H _ _; (* (i:=H) *)
- [env_reflexivity || fail "iClear:" H "not found"|go Hs]
+ [env_reflexivity || fail "iClear:" H "not found"
+ |env_cbv; apply _ ||
+ let P := match goal with |- TCOr (Affine ?P) _ => P end in
+ fail "iClear:" H ":" P "not affine and the goal not absorbing"
+ |go Hs]
end in
let Hs := iElaborateSelPat Hs in go Hs.
@@ -121,16 +126,18 @@ Tactic Notation "iClear" "(" ident_list(xs) ")" constr(Hs) :=
(** * Assumptions *)
Tactic Notation "iExact" constr(H) :=
- eapply tac_assumption with H _ _; (* (i:=H) *)
+ eapply tac_assumption with _ H _ _; (* (i:=H) *)
[env_reflexivity || fail "iExact:" H "not found"
|apply _ ||
let P := match goal with |- FromAssumption _ ?P _ => P end in
- fail "iExact:" H ":" P "does not match goal"].
+ fail "iExact:" H ":" P "does not match goal"
+ |env_cbv; apply _ ||
+ fail "iExact:" H "not absorbing and the remaining hypotheses not affine"].
Tactic Notation "iAssumptionCore" :=
let rec find Γ i P :=
match Γ with
- | Esnoc ?Γ ?j ?Q => first [unify P Q; unify i j| find Γ i P]
+ | Esnoc ?Γ ?j ?Q => first [unify P Q; unify i j|find Γ i P]
end in
match goal with
| |- envs_lookup ?i (Envs ?Γp ?Γs) = Some (_, ?P) =>
@@ -149,7 +156,15 @@ Tactic Notation "iAssumption" :=
match Γ with
| Esnoc ?Γ ?j ?P => first
[pose proof (_ : FromAssumption p P Q) as Hass;
- apply (tac_assumption _ j p P); [env_reflexivity|apply Hass]
+ eapply (tac_assumption _ _ j p P);
+ [env_reflexivity
+ |apply Hass
+ |env_cbv; apply _ ||
+ fail 1 "iAssumption:" j "not absorbing and the remaining hypotheses not affine"]
+ |assert (P = False%I) as Hass by reflexivity;
+ apply (tac_false_destruct _ j p P);
+ [env_reflexivity
+ |exact Hass]
|find p Γ Q]
end in
match goal with
@@ -166,8 +181,11 @@ Local Tactic Notation "iPersistent" constr(H) :=
eapply tac_persistent with _ H _ _ _; (* (i:=H) *)
[env_reflexivity || fail "iPersistent:" H "not found"
|apply _ ||
- let Q := match goal with |- IntoPersistent _ ?Q _ => Q end in
- fail "iPersistent:" Q "not persistent"
+ let P := match goal with |- IntoPersistent _ ?P _ => P end in
+ fail "iPersistent:" P "not persistent"
+ |env_cbv; apply _ ||
+ let P := match goal with |- Affine ?P => P end in
+ fail "iPersistent:" P "not affine"
|env_reflexivity|].
Local Tactic Notation "iPure" constr(H) "as" simple_intropattern(pat) :=
@@ -176,8 +194,16 @@ Local Tactic Notation "iPure" constr(H) "as" simple_intropattern(pat) :=
|apply _ ||
let P := match goal with |- IntoPure ?P _ => P end in
fail "iPure:" P "not pure"
+ |env_cbv; apply _ ||
+ let P := match goal with |- Affine ?P => P end in
+ fail "iPure:" P "not affine"
|intros pat].
+Tactic Notation "iEmpIntro" :=
+ iStartProof;
+ eapply tac_emp_intro;
+ [env_reflexivity || fail "iEmpIntro: spatial context is non-empty"].
+
Tactic Notation "iPureIntro" :=
iStartProof;
eapply tac_pure_intro;
@@ -190,7 +216,8 @@ Tactic Notation "iPureIntro" :=
Local Ltac iFrameFinish :=
lazy iota beta;
try match goal with
- | |- _ ⊢ True => exact (uPred.pure_intro _ _ I)
+ | |- _ ⊢ True => exact (bi.pure_intro _ _ I)
+ | |- _ ⊢ emp => iEmpIntro
end.
Local Ltac iFramePure t :=
@@ -303,7 +330,7 @@ Local Tactic Notation "iIntro" constr(H) :=
let P := lazymatch goal with |- Persistent ?P => P end in
fail 1 "iIntro: introducing non-persistent" H ":" P
"into non-empty spatial context"
- |env_reflexivity || fail "iIntro:" H "not fresh"
+ |env_reflexivity || fail 1 "iIntro:" H "not fresh"
|]
| (* (_ -∗ _) *)
eapply tac_wand_intro with _ H; (* (i:=H) *)
@@ -316,16 +343,19 @@ Local Tactic Notation "iIntro" "#" constr(H) :=
first
[ (* (?P → _) *)
eapply tac_impl_intro_persistent with _ H _; (* (i:=H) *)
- [apply _ ||
+ [apply _ ||
let P := match goal with |- IntoPersistent _ ?P _ => P end in
- fail 1 "iIntro: " P " not persistent"
+ fail 1 "iIntro:" P "not persistent"
|env_reflexivity || fail 1 "iIntro:" H "not fresh"
|]
| (* (?P -∗ _) *)
eapply tac_wand_intro_persistent with _ H _; (* (i:=H) *)
- [apply _ ||
+ [apply _ ||
let P := match goal with |- IntoPersistent _ ?P _ => P end in
- fail 1 "iIntro: " P " not persistent"
+ fail 1 "iIntro:" P "not persistent"
+ |apply _ ||
+ let P := match goal with |- Affine ?P => P end in
+ fail 1 "iIntro:" P "not affine"
|env_reflexivity || fail 1 "iIntro:" H "not fresh"
|]
| fail 1 "iIntro: nothing to introduce" ].
@@ -334,14 +364,19 @@ Local Tactic Notation "iIntro" "_" :=
try iStartProof;
first
[ (* (?Q → _) *) apply tac_impl_intro_drop
- | (* (_ -∗ _) *) apply tac_wand_intro_drop
+ | (* (_ -∗ _) *)
+ apply tac_wand_intro_drop;
+ [apply _ ||
+ let P := match goal with |- TCOr (Affine ?P) _ => P end in
+ fail 1 "iIntro:" P "not affine and the goal not absorbing"
+ |]
| (* (∀ _, _) *) iIntro (_)
| fail 1 "iIntro: nothing to introduce" ].
Local Tactic Notation "iIntroForall" :=
try iStartProof;
lazymatch goal with
- | |- ∀ _, ?P => fail
+ | |- ∀ _, ?P => fail (* actually an →, this is handled by iIntro below *)
| |- ∀ _, _ => intro
| |- _ ⊢ (∀ x : _, _) => let x' := fresh x in iIntro (x')
end.
@@ -394,7 +429,7 @@ Local Tactic Notation "iSpecializeArgs" constr(H) open_constr(xs) :=
Local Tactic Notation "iSpecializePat" open_constr(H) constr(pat) :=
let solve_to_wand H1 :=
apply _ ||
- let P := match goal with |- IntoWand _ ?P _ _ => P end in
+ let P := match goal with |- IntoWand _ _ ?P _ _ => P end in
fail "iSpecialize:" P "not an implication/wand" in
let rec go H1 pats :=
lazymatch pats with
@@ -407,8 +442,8 @@ Local Tactic Notation "iSpecializePat" open_constr(H) constr(pat) :=
[env_reflexivity || fail "iSpecialize:" H2 "not found"
|env_reflexivity || fail "iSpecialize:" H1 "not found"
|apply _ ||
- let P := match goal with |- IntoWand _ ?P ?Q _ => P end in
- let Q := match goal with |- IntoWand _ ?P ?Q _ => Q end in
+ let P := match goal with |- IntoWand _ _ ?P ?Q _ => P end in
+ let Q := match goal with |- IntoWand _ _ ?P ?Q _ => Q end in
fail "iSpecialize: cannot instantiate" P "with" Q
|env_reflexivity|go H1 pats]
| SPureGoal ?d :: ?pats =>
@@ -485,7 +520,7 @@ Tactic Notation "iSpecializeCore" open_constr(t) "as" constr(p) :=
match type of t with string => constr:(ITrm t hnil "") | _ => t end in
lazymatch t with
| ITrm ?H ?xs ?pat =>
- let pat := spec_pat.parse pat in
+ iSpecializeArgs H xs;
lazymatch type of H with
| string =>
(* The lemma [tac_specialize_persistent_helper] allows one to use all
@@ -494,17 +529,22 @@ Tactic Notation "iSpecializeCore" open_constr(t) "as" constr(p) :=
the result of the specialization is persistent, and no modality is
eliminated. As an optimization, we do not use this when only universal
quantifiers are instantiated. *)
+ let pat := spec_pat.parse pat in
lazymatch eval compute in
(bool_decide (pat ≠[]) && p && negb (existsb spec_pat_modal pat)) with
| true =>
- eapply tac_specialize_persistent_helper with _ H _ _ _;
+ eapply tac_specialize_persistent_helper with _ H _ _ _ _;
[env_reflexivity || fail "iSpecialize:" H "not found"
- |iSpecializeArgs H xs; iSpecializePat H pat; last (iExact H)
+ |iSpecializePat H pat; last (iExact H)
|apply _ ||
- let Q := match goal with |- Persistent ?Q => Q end in
+ let Q := match goal with |- IntoPersistent _ ?Q _ => Q end in
fail "iSpecialize:" Q "not persistent"
- |env_reflexivity|(* goal *)]
- | false => iSpecializeArgs H xs; iSpecializePat H pat
+ |env_cbv; apply _ ||
+ let Q := match goal with |- Affine ?Q => Q end in
+ fail "iSpecialize:" Q "not affine"
+ |env_reflexivity
+ |(* goal *)]
+ | false => iSpecializePat H pat
end
| _ => fail "iSpecialize:" H "should be a hypothesis, use iPoseProof instead"
end
@@ -697,7 +737,7 @@ Tactic Notation "iSplit" :=
| |- _ ⊢ _ =>
eapply tac_and_split;
[apply _ ||
- let P := match goal with |- FromAnd _ ?P _ _ => P end in
+ let P := match goal with |- FromAnd ?P _ _ => P end in
fail "iSplit:" P "not a conjunction"| |]
end.
@@ -706,7 +746,7 @@ Tactic Notation "iSplitL" constr(Hs) :=
let Hs := words Hs in
eapply tac_sep_split with _ _ false Hs _ _; (* (js:=Hs) *)
[apply _ ||
- let P := match goal with |- FromAnd _ ?P _ _ => P end in
+ let P := match goal with |- FromSep _ ?P _ _ => P end in
fail "iSplitL:" P "not a separating conjunction"
|env_reflexivity ||
let Hs := iMissingHyps Hs in
@@ -718,7 +758,7 @@ Tactic Notation "iSplitR" constr(Hs) :=
let Hs := words Hs in
eapply tac_sep_split with _ _ true Hs _ _; (* (js:=Hs) *)
[apply _ ||
- let P := match goal with |- FromAnd _ ?P _ _ => P end in
+ let P := match goal with |- FromSep _ ?P _ _ => P end in
fail "iSplitR:" P "not a separating conjunction"
|env_reflexivity ||
let Hs := iMissingHyps Hs in
@@ -732,15 +772,15 @@ Local Tactic Notation "iAndDestruct" constr(H) "as" constr(H1) constr(H2) :=
eapply tac_and_destruct with _ H _ H1 H2 _ _ _; (* (i:=H) (j1:=H1) (j2:=H2) *)
[env_reflexivity || fail "iAndDestruct:" H "not found"
|apply _ ||
- let P := match goal with |- IntoAnd _ ?P _ _ => P end in
+ let P := match goal with |- IntoSep _ ?P _ _ => P end in
fail "iAndDestruct: cannot destruct" P
|env_reflexivity || fail "iAndDestruct:" H1 "or" H2 " not fresh"|].
Local Tactic Notation "iAndDestructChoice" constr(H) "as" constr(lr) constr(H') :=
eapply tac_and_destruct_choice with _ H _ lr H' _ _ _;
[env_reflexivity || fail "iAndDestructChoice:" H "not found"
- |apply _ ||
- let P := match goal with |- IntoAnd _ ?P _ _ => P end in
+ |env_cbv; apply _ ||
+ let P := match goal with |- TCOr (IntoAnd _ ?P _ _) _ => P end in
fail "iAndDestructChoice: cannot destruct" P
|env_reflexivity || fail "iAndDestructChoice:" H' " not fresh"|].
@@ -802,8 +842,9 @@ Local Tactic Notation "iExistDestruct" constr(H)
(** * Always *)
Tactic Notation "iAlways":=
iStartProof;
- apply tac_persistently_intro; env_cbv
- || fail "iAlways: the goal is not an persistently modality".
+ eapply tac_persistently_intro;
+ [apply _ || fail "iAlways: the goal is not a persistently modality"
+ |env_cbv].
(** * Later *)
Tactic Notation "iNext" open_constr(n) :=
@@ -1209,15 +1250,18 @@ Tactic Notation "iRevertIntros" "(" ident(x1) ident(x2) ident(x3) ident(x4)
iRevertIntros (x1 x2 x3 x4 x5 x6 x7 x8) "" with tac.
(** * Destruct tactic *)
-Class CopyDestruct {M} (P : uPred M).
+Class CopyDestruct {PROP : bi} (P : PROP).
+Arguments CopyDestruct {_} _%I.
Hint Mode CopyDestruct + ! : typeclass_instances.
-Instance copy_destruct_forall {M A} (Φ : A → uPred M) : CopyDestruct (∀ x, Φ x).
-Instance copy_destruct_impl {M} (P Q : uPred M) :
+Instance copy_destruct_forall {PROP : bi} {A} (Φ : A → PROP) : CopyDestruct (∀ x, Φ x).
+Instance copy_destruct_impl {PROP : bi} (P Q : PROP) :
CopyDestruct Q → CopyDestruct (P → Q).
-Instance copy_destruct_wand {M} (P Q : uPred M) :
+Instance copy_destruct_wand {PROP : bi} (P Q : PROP) :
CopyDestruct Q → CopyDestruct (P -∗ Q).
-Instance copy_destruct_persistently {M} (P : uPred M) :
+Instance copy_destruct_bare {PROP : bi} (P : PROP) :
+ CopyDestruct P → CopyDestruct (■P).
+Instance copy_destruct_persistently {PROP : bi} (P : PROP) :
CopyDestruct P → CopyDestruct (□ P).
Tactic Notation "iDestructCore" open_constr(lem) "as" constr(p) tactic(tac) :=
@@ -1526,13 +1570,15 @@ Tactic Notation "iAssertCore" open_constr(Q)
eapply tac_assert_pure with _ H Q _;
[env_reflexivity
|apply _ || fail "iAssert:" Q "not pure"
+ |apply _
|done_if d (*goal*)
|tac H]
| [SGoal (SpecGoal GPersistent _ ?Hs_frame [] ?d)] =>
- eapply tac_assert_persistent with _ _ _ true [] H Q;
+ eapply tac_assert_persistent with _ _ _ true [] H Q _;
[env_reflexivity
- |env_reflexivity
|apply _ || fail "iAssert:" Q "not persistent"
+ |apply _
+ |env_reflexivity
|iFrame Hs_frame; done_if d (*goal*)
|tac H]
| [SGoal (SpecGoal GPersistent false ?Hs_frame _ ?d)] =>
@@ -1554,12 +1600,13 @@ Tactic Notation "iAssertCore" open_constr(Q)
|iFrame Hs_frame; done_if d (*goal*)
|tac H]
| true =>
- eapply tac_assert_persistent with _ _ _ lr Hs' H Q;
+ eapply tac_assert_persistent with _ _ _ lr Hs' H Q _;
[env_reflexivity ||
let Hs' := iMissingHyps Hs' in
fail "iAssert: hypotheses" Hs' "not found"
- |env_reflexivity
|apply _ || fail "iAssert:" Q "not persistent"
+ |apply _
+ |env_reflexivity
|done_if d (*goal*)
|tac H]
end
@@ -1625,11 +1672,9 @@ Local Tactic Notation "iRewriteCore" constr(lr) open_constr(lem) :=
iPoseProofCore lem as true true (fun Heq =>
eapply (tac_rewrite _ Heq _ _ lr);
[env_reflexivity || fail "iRewrite:" Heq "not found"
- |let P := match goal with |- ?P ⊢ _ => P end in
- (* use ssreflect apply: which is better at dealing with unification
- involving canonical structures. This is useful for the COFE canonical
- structure in uPred_eq that it may have to infer. *)
- apply: reflexivity || fail "iRewrite:" P "not an equality"
+ |apply _ ||
+ let P := match goal with |- IntoInternalEq ?P _ _ ⊢ _ => P end in
+ fail "iRewrite:" P "not an equality"
|iRewriteFindPred
|intros ??? ->; reflexivity|lazy beta; iClear Heq]).
@@ -1641,8 +1686,8 @@ Local Tactic Notation "iRewriteCore" constr(lr) open_constr(lem) "in" constr(H)
eapply (tac_rewrite_in _ Heq _ _ H _ _ lr);
[env_reflexivity || fail "iRewrite:" Heq "not found"
|env_reflexivity || fail "iRewrite:" H "not found"
- |apply: reflexivity ||
- let P := match goal with |- ?P ⊢ _ => P end in
+ |apply _ ||
+ let P := match goal with |- IntoInternalEq ?P _ _ ⊢ _ => P end in
fail "iRewrite:" P "not an equality"
|iRewriteFindPred
|intros ??? ->; reflexivity
@@ -1705,7 +1750,8 @@ Tactic Notation "iMod" open_constr(lem) "as" "%" simple_intropattern(pat) :=
(* Make sure that by and done solve trivial things in proof mode *)
Hint Extern 0 (of_envs _ ⊢ _) => by iPureIntro.
Hint Extern 0 (of_envs _ ⊢ _) => iAssumption.
-Hint Resolve uPred.internal_eq_refl'. (* Maybe make an [iReflexivity] tactic *)
+Hint Extern 0 (of_envs _ ⊢ emp) => iEmpIntro.
+Hint Resolve bi.internal_eq_refl. (* Maybe make an [iReflexivity] tactic *)
(* For iIntros we do not check whether we are in proof mode because we actually
want it to enter proof mode when we are not already in it. *)
@@ -1716,7 +1762,6 @@ Hint Extern 1 (of_envs _ ⊢ _ ∗ _) => iSplit.
Hint Extern 1 (of_envs _ ⊢ ▷ _) => iNext.
Hint Extern 1 (of_envs _ ⊢ □ _) => iAlways.
Hint Extern 1 (of_envs _ ⊢ ∃ _, _) => iExists _.
-Hint Extern 1 (of_envs _ ⊢ |==> _) => iModIntro.
Hint Extern 1 (of_envs _ ⊢ ◇ _) => iModIntro.
Hint Extern 1 (of_envs _ ⊢ _ ∨ _) => iLeft.
Hint Extern 1 (of_envs _ ⊢ _ ∨ _) => iRight.
diff --git a/theories/tests/proofmode.v b/theories/tests/proofmode.v
index 71505deab..7d36c33c5 100644
--- a/theories/tests/proofmode.v
+++ b/theories/tests/proofmode.v
@@ -1,48 +1,22 @@
From iris.proofmode Require Import tactics.
-From iris.base_logic.lib Require Import invariants.
From stdpp Require Import gmap.
Set Default Proof Using "Type".
Section tests.
-Context {M : ucmraT}.
-Implicit Types P Q R : uPred M.
+Context {PROP : sbi}.
+Implicit Types P Q R : PROP.
-Lemma demo_0 P Q : â–¡ (P ∨ Q) -∗ (∀ x, ⌜x = 0⌠∨ ⌜x = 1âŒ) → (Q ∨ P).
+Lemma demo_0 P Q : ⬕ (P ∨ Q) -∗ (∀ x, ⌜x = 0⌠∨ ⌜x = 1âŒ) → (Q ∨ P).
Proof.
- iIntros "###H #H2".
+ iIntros "H #H2". iDestruct "H" as "###H".
(* should remove the disjunction "H" *)
iDestruct "H" as "[#?|#?]"; last by iLeft.
(* should keep the disjunction "H" because it is instantiated *)
iDestruct ("H2" $! 10) as "[%|%]". done. done.
Qed.
-Lemma demo_1 (P1 P2 P3 : nat → uPred M) :
- (∀ (x y : nat) a b,
- x ≡ y →
- □ (uPred_ownM (a ⋅ b) -∗
- (∃ y1 y2 c, P1 ((x + y1) + y2) ∧ True ∧ □ uPred_ownM c) -∗
- □ ▷ (∀ z, P2 z ∨ True → P2 z) -∗
- ▷ (∀ n m : nat, P1 n → □ ((True ∧ P2 n) → □ (⌜n = n⌠↔ P3 n))) -∗
- ▷ ⌜x = 0⌠∨ ∃ x z, ▷ P3 (x + z) ∗ uPred_ownM b ∗ uPred_ownM (core b)))%I.
-Proof.
- iIntros (i [|j] a b ?) "!# [Ha Hb] H1 #H2 H3"; setoid_subst.
- { iLeft. by iNext. }
- iRight.
- iDestruct "H1" as (z1 z2 c) "(H1&_&#Hc)".
- iPoseProof "Hc" as "foo".
- iRevert (a b) "Ha Hb". iIntros (b a) "Hb {foo} Ha".
- iAssert (uPred_ownM (a â‹… core a)) with "[Ha]" as "[Ha #Hac]".
- { by rewrite cmra_core_r. }
- iIntros "{$Hac $Ha}".
- iExists (S j + z1), z2.
- iNext.
- iApply ("H3" $! _ 0 with "[$]").
- - iSplit. done. iApply "H2". iLeft. iApply "H2". by iRight.
- - done.
-Qed.
-
-Lemma demo_2 P1 P2 P3 P4 Q (P5 : nat → uPredC M):
- P2 ∗ (P3 ∗ Q) ∗ True ∗ P1 ∗ P2 ∗ (P4 ∗ (∃ x:nat, P5 x ∨ P3)) ∗ True -∗
+Lemma demo_2 P1 P2 P3 P4 Q (P5 : nat → PROP) `{!Affine P4, !Absorbing P2} :
+ P2 ∗ (P3 ∗ Q) ∗ True ∗ P1 ∗ P2 ∗ (P4 ∗ (∃ x:nat, P5 x ∨ P3)) ∗ emp -∗
P1 -∗ (True ∗ True) -∗
(((P2 ∧ False ∨ P2 ∧ ⌜0 = 0âŒ) ∗ P3) ∗ Q ∗ P1 ∗ True) ∧
(P2 ∨ False) ∧ (False → P5 0).
@@ -55,27 +29,27 @@ Proof.
iFrame "H2".
(* split takes a list of hypotheses just for the LHS *)
iSplitL "H3".
- * iFrame "H3". by iRight.
- * iSplitL "HQ". iAssumption. by iSplitL "H1".
+ - iFrame "H3". iRight. auto.
+ - iSplitL "HQ". iAssumption. by iSplitL "H1".
Qed.
Lemma demo_3 P1 P2 P3 :
- P1 ∗ P2 ∗ P3 -∗ â–· P1 ∗ â–· (P2 ∗ ∃ x, (P3 ∧ ⌜x = 0âŒ) ∨ P3).
-Proof. iIntros "($ & $ & H)". iFrame "H". iNext. by iExists 0. Qed.
+ P1 ∗ P2 ∗ P3 -∗ P1 ∗ â–· (P2 ∗ ∃ x, (P3 ∧ ⌜x = 0âŒ) ∨ P3).
+Proof. iIntros "($ & $ & $)". iNext. by iExists 0. Qed.
-Definition foo (P : uPred M) := (P → P)%I.
-Definition bar : uPred M := (∀ P, foo P)%I.
+Definition foo (P : PROP) := (P -∗ P)%I.
+Definition bar : PROP := (∀ P, foo P)%I.
-Lemma test_unfold_constants : True -∗ bar.
-Proof. iIntros. iIntros (P) "HP //". Qed.
+Lemma test_unfold_constants : bar.
+Proof. iIntros (P) "HP //". Qed.
-Lemma test_iRewrite (x y : M) P :
- (∀ z, P → z ≡ y) -∗ (P -∗ (x,x) ≡ (y,x)).
+Lemma test_iRewrite {A : ofeT} (x y : A) P :
+ (∀ z, P -∗ ■(z ≡ y)) -∗ (P -∗ P ∧ (x,x) ≡ (y,x)).
Proof.
iIntros "H1 H2".
- iRewrite (uPred.internal_eq_sym x x with "[# //]").
+ iRewrite (bi.internal_eq_sym x x with "[# //]").
iRewrite -("H1" $! _ with "[- //]").
- done.
+ auto.
Qed.
Lemma test_iIntros_persistent P Q `{!Persistent Q} : (P → Q → P ∗ Q)%I.
@@ -90,19 +64,15 @@ Lemma test_fast_iIntros P Q :
Proof.
iIntros (a) "*".
iIntros "#Hfoo **".
- iIntros "# _ //".
+ iIntros "_ //".
Qed.
Lemma test_very_fast_iIntros P :
- ∀ x y : nat, ⌜ x = y ⌠-∗ P -∗ P.
+ ∀ x y : nat, (⌜ x = y ⌠→ P -∗ P)%I.
Proof. by iIntros. Qed.
Lemma test_iDestruct_spatial_and P Q1 Q2 : P ∗ (Q1 ∧ Q2) -∗ P ∗ Q1.
-Proof. iIntros "[H1 [H2 _]]". by iFrame. Qed.
-
-Lemma test_iFrame_pure (x y z : M) :
- ✓ x → ⌜y ≡ z⌠-∗ (✓ x ∧ ✓ x ∧ y ≡ z : uPred M).
-Proof. iIntros (Hv) "Hxy". by iFrame (Hv Hv) "Hxy". Qed.
+Proof. iIntros "[H1 [H2 _]]". iFrame. Qed.
Lemma test_iAssert_persistent P Q : P -∗ Q -∗ True.
Proof.
@@ -119,7 +89,7 @@ Lemma test_iSpecialize_auto_frame P Q R :
Proof. iIntros "H HP HQ". by iApply ("H" with "[$]"). Qed.
(* Check coercions *)
-Lemma test_iExist_coercion (P : Z → uPred M) : (∀ x, P x) -∗ ∃ x, P x.
+Lemma test_iExist_coercion (P : Z → PROP) : (∀ x, P x) -∗ ∃ x, P x.
Proof. iIntros "HP". iExists (0:nat). iApply ("HP" $! (0:nat)). Qed.
Lemma test_iExist_tc `{Collection A C} P : (∃ x1 x2 : gset positive, P -∗ P)%I.
@@ -128,26 +98,34 @@ Proof. iExists {[ 1%positive ]}, ∅. auto. Qed.
Lemma test_iSpecialize_tc P : (∀ x y z : gset positive, P) -∗ P.
Proof. iIntros "H". iSpecialize ("H" $! ∅ {[ 1%positive ]} ∅). done. Qed.
-Lemma test_iAssert_modality P : (|==> False) -∗ |==> P.
-Proof. iIntros. iAssert False%I with "[> - //]" as %[]. Qed.
+Lemma test_iFrame_pure {A : ofeT} (φ : Prop) (y z : A) :
+ φ → ■⌜y ≡ z⌠-∗ (⌜ φ ⌠∧ ⌜ φ ⌠∧ y ≡ z : PROP).
+Proof. iIntros (Hv) "#Hxy". iFrame (Hv) "Hxy". Qed.
+
+Lemma test_iAssert_modality P : ◇ False -∗ ▷ P.
+Proof.
+ iIntros "HF".
+ iAssert (â– False)%I with "[> -]" as %[].
+ by iMod "HF".
+Qed.
Lemma test_iAssumption_False P : False -∗ P.
Proof. iIntros "H". done. Qed.
(* Check instantiation and dependent types *)
-Lemma test_iSpecialize_dependent_type (P : ∀ n, vec nat n → uPred M) :
+Lemma test_iSpecialize_dependent_type (P : ∀ n, vec nat n → PROP) :
(∀ n v, P n v) -∗ ∃ n v, P n v.
Proof.
iIntros "H". iExists _, [#10].
iSpecialize ("H" $! _ [#10]). done.
Qed.
-Lemma test_eauto_iFramE P Q R `{!Persistent R} :
- P -∗ Q -∗ R -∗ R ∗ Q ∗ P ∗ R ∨ False.
+Lemma test_eauto_iFrame P Q R `{!Persistent R} :
+ P -∗ Q -∗ R → R ∗ Q ∗ P ∗ R ∨ False.
Proof. eauto with iFrame. Qed.
Lemma test_iCombine_persistent P Q R `{!Persistent R} :
- P -∗ Q -∗ R -∗ R ∗ Q ∗ P ∗ R ∨ False.
+ P -∗ Q -∗ R → R ∗ Q ∗ P ∗ R ∨ False.
Proof. iIntros "HP HQ #HR". iCombine "HR HQ HP HR" as "H". auto. Qed.
Lemma test_iNext_evar P : P -∗ True.
@@ -169,19 +147,18 @@ Proof.
iIntros "H". iNext. iExact "H". (* Check that the laters are all gone. *)
Qed.
-Lemma test_iNext_quantifier (Φ : M → M → uPred M) :
+Lemma test_iNext_quantifier {A} (Φ : A → A → PROP) :
(∀ y, ∃ x, ▷ Φ x y) -∗ ▷ (∀ y, ∃ x, Φ x y).
Proof. iIntros "H". iNext. done. Qed.
-Lemma test_iFrame_persistent (P Q : uPred M) :
- □ P -∗ Q -∗ □ (P ∗ P) ∗ (P ∧ Q ∨ Q).
+Lemma test_iFrame_persistent (P Q : PROP) :
+ ⬕ P -∗ Q -∗ □ (P ∗ P) ∗ (P ∗ Q ∨ Q).
Proof. iIntros "#HP". iFrame "HP". iIntros "$". Qed.
-Lemma test_iSplit_persistently P Q : □ P -∗ □ (P ∗ P).
+Lemma test_iSplit_persistently P Q : ⬕ P -∗ □ (P ∗ P).
Proof. iIntros "#?". by iSplit. Qed.
-Lemma test_iSpecialize_persistent P Q :
- □ P -∗ (□ P -∗ Q) -∗ Q.
+Lemma test_iSpecialize_persistent P Q : ⬕ P -∗ (□ P → Q) -∗ Q.
Proof. iIntros "#HP HPQ". by iSpecialize ("HPQ" with "HP"). Qed.
Lemma test_iLöb P : (∃ n, ▷^n P)%I.
@@ -191,7 +168,7 @@ Proof.
Qed.
Lemma test_iInduction_wf (x : nat) P Q :
- â–¡ P -∗ Q -∗ ⌜ (x + 0 = x)%nat âŒ.
+ ⬕ P -∗ Q -∗ ⌜ (x + 0 = x)%nat âŒ.
Proof.
iIntros "#HP HQ".
iInduction (lt_wf x) as [[|x] _] "IH"; simpl; first done.
@@ -199,13 +176,13 @@ Proof.
Qed.
Lemma test_iIntros_start_proof :
- (True : uPred M)%I.
+ (True : PROP)%I.
Proof.
(* Make sure iIntros actually makes progress and enters the proofmode. *)
progress iIntros. done.
Qed.
-Lemma test_True_intros : (True : uPred M) -∗ True.
+Lemma test_True_intros : (True : PROP) -∗ True.
Proof.
iIntros "?". done.
Qed.
@@ -219,28 +196,14 @@ Proof.
Qed.
Lemma test_iIntros_let P :
- ∀ Q, let R := True%I in P -∗ R -∗ Q -∗ P ∗ Q.
-Proof. iIntros (Q R) "$ HR $". Qed.
+ ∀ Q, let R := emp%I in P -∗ R -∗ Q -∗ P ∗ Q.
+Proof. iIntros (Q R) "$ _ $". Qed.
-Lemma test_iIntros_modalities P :
- (□ ▷ ∀ x : nat, ⌜ x = 0 ⌠-∗ ⌜ x = 0 ⌠→ False -∗ P -∗ P)%I.
+Lemma test_iIntros_modalities `(!Absorbing P) :
+ (□ ▷ ∀ x : nat, ⌜ x = 0 ⌠→ ⌜ x = 0 ⌠-∗ False -∗ P -∗ P)%I.
Proof.
iIntros (x ??).
iIntros "* **". (* Test that fast intros do not work under modalities *)
iIntros ([]).
Qed.
End tests.
-
-Section more_tests.
- Context `{invG Σ}.
- Implicit Types P Q R : iProp Σ.
-
- Lemma test_masks N E P Q R :
- ↑N ⊆ E →
- (True -∗ P -∗ inv N Q -∗ True -∗ R) -∗ P -∗ ▷ Q ={E}=∗ R.
- Proof.
- iIntros (?) "H HP HQ".
- iApply ("H" with "[% //] [$] [> HQ] [> //]").
- by iApply inv_alloc.
- Qed.
-End more_tests.
diff --git a/theories/tests/proofmode_iris.v b/theories/tests/proofmode_iris.v
new file mode 100644
index 000000000..bcae3c9be
--- /dev/null
+++ b/theories/tests/proofmode_iris.v
@@ -0,0 +1,52 @@
+From iris.proofmode Require Import tactics.
+From iris.base_logic Require Import proofmode lib.invariants.
+
+Section base_logic_tests.
+ Context {M : ucmraT}.
+ Implicit Types P Q R : uPred M.
+
+ Lemma test_random_stuff (P1 P2 P3 : nat → uPred M) :
+ (∀ (x y : nat) a b,
+ x ≡ y →
+ □ (uPred_ownM (a ⋅ b) -∗
+ (∃ y1 y2 c, P1 ((x + y1) + y2) ∧ True ∧ □ uPred_ownM c) -∗
+ □ ▷ (∀ z, P2 z ∨ True → P2 z) -∗
+ ▷ (∀ n m : nat, P1 n → □ ((True ∧ P2 n) → □ (⌜n = n⌠↔ P3 n))) -∗
+ ▷ ⌜x = 0⌠∨ ∃ x z, ▷ P3 (x + z) ∗ uPred_ownM b ∗ uPred_ownM (core b)))%I.
+ Proof.
+ iIntros (i [|j] a b ?) "!# [Ha Hb] H1 #H2 H3"; setoid_subst.
+ { iLeft. by iNext. }
+ iRight.
+ iDestruct "H1" as (z1 z2 c) "(H1&_&#Hc)".
+ iPoseProof "Hc" as "foo".
+ iRevert (a b) "Ha Hb". iIntros (b a) "Hb {foo} Ha".
+ iAssert (uPred_ownM (a â‹… core a)) with "[Ha]" as "[Ha #Hac]".
+ { by rewrite cmra_core_r. }
+ iIntros "{$Hac $Ha}".
+ iExists (S j + z1), z2.
+ iNext.
+ iApply ("H3" $! _ 0 with "[$]").
+ - iSplit. done. iApply "H2". iLeft. iApply "H2". by iRight.
+ - done.
+ Qed.
+
+ Lemma test_iFrame_pure (x y z : M) :
+ ✓ x → ⌜y ≡ z⌠-∗ (✓ x ∧ ✓ x ∧ y ≡ z : uPred M).
+ Proof. iIntros (Hv) "Hxy". by iFrame (Hv) "Hxy". Qed.
+
+ Lemma test_iAssert_modality P : (|==> False) -∗ |==> P.
+ Proof. iIntros. iAssert False%I with "[> - //]" as %[]. Qed.
+End base_logic_tests.
+
+Section iris_tests.
+ Context `{invG Σ}.
+
+ Lemma test_masks N E P Q R :
+ ↑N ⊆ E →
+ (True -∗ P -∗ inv N Q -∗ True -∗ R) -∗ P -∗ ▷ Q ={E}=∗ R.
+ Proof.
+ iIntros (?) "H HP HQ".
+ iApply ("H" with "[% //] [$] [> HQ] [> //]").
+ by iApply inv_alloc.
+ Qed.
+End iris_tests.
--
GitLab