diff --git a/.gitignore b/.gitignore
index cf812bbd629202b64163a970891246754b57cc41..71079837bdf3ace1bd11cbeab6e54351eae63dc9 100644
--- a/.gitignore
+++ b/.gitignore
@@ -9,6 +9,7 @@
.\#*
*~
*.bak
+.coqdeps.d
.coq-native/
build-dep/
Makefile.coq
diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index ee27a34b32b9684758fa1d018dd809efc95f1564..2cc2051fafc66d413ab07409d755512daa5dfde5 100644
--- a/.gitlab-ci.yml
+++ b/.gitlab-ci.yml
@@ -18,7 +18,7 @@ variables:
paths:
- opamroot/
only:
- - master
+ - gen_proofmode
- /^ci/
except:
- triggers
@@ -32,36 +32,28 @@ build-coq.dev:
OPAM_PINS: "coq version dev"
VALIDATE: "1"
-build-coq.8.8.0:
+build-coq.8.8.dev:
<<: *template
variables:
- OPAM_PINS: "coq version 8.8.0"
+ OPAM_PINS: "coq version 8.8.dev"
-build-coq.8.7.2:
+build-coq.8.8.0:
<<: *template
variables:
- OPAM_PINS: "coq version 8.7.2"
+ OPAM_PINS: "coq version 8.8.0"
OPAM_PKG: "coq-iris"
+ OPAM_PKG_BRANCH: "gen_proofmode"
TIMING_PROJECT: "iris"
- TIMING_CONF: "coq-8.7.2"
+ TIMING_CONF: "coq-8.8.0"
tags:
- fp-timing
-build-coq.8.7.1:
- <<: *template
- variables:
- OPAM_PINS: "coq version 8.7.1"
-
-build-coq.8.7.0:
+build-coq.8.7.2:
<<: *template
variables:
- OPAM_PINS: "coq version 8.7.0"
+ OPAM_PINS: "coq version 8.7.2"
-build-stdpp.dev:
+build-coq.8.7.1:
<<: *template
variables:
- OPAM_PINS: "coq version 8.7.2 coq-stdpp.dev git https://gitlab.mpi-sws.org/robbertkrebbers/coq-stdpp/#$STDPP_REV"
- except:
- only:
- - triggers
- - schedules
+ OPAM_PINS: "coq version 8.7.1"
diff --git a/CHANGELOG.md b/CHANGELOG.md
index bcf5ff865d0172c8e00b7de3cf4bce6c3e134d8b..23cd9f4b3a88664500314619675d8478316c3b55 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -7,12 +7,54 @@ Coq development, but not every API-breaking change is listed. Changes marked
Changes in and extensions of the theory:
+* [#] Change in the definition of WP, so that there is a fancy update between
+ the quantification over the next states and the later modality. This makes it
+ possible to prove more powerful lifting lemmas: The new versions feature an
+ "update that takes a step".
+* [#] Weaken the semantics of CAS in heap_lang to be efficiently implementable:
+ CAS may only be used to compare "unboxed" values that can be represented in a
+ single machine word.
* [#] Add weakest preconditions for total program correctness.
* [#] "(Potentially) stuck" weakest preconditions are no longer considered
experimental.
+* [#] The Löb rule is now a derived rule; it follows from later-intro, later
+ being contractive and the fact that we can take fixpoints of contractive
+ functions.
Changes in Coq:
+* An all-new generalized proof mode that abstracts away from Iris! See
+ <http://iris-project.org/mosel/> for the corresponding paper. Major new
+ features:
+ - The proof mode can now be used with logics derived from Iris (like iGPS),
+ with non-step-indexed logics and even with non-affine (i.e., linear) logics.
+ - `iModIntro` is more flexible and more powerful, it now also subsumes
+ `iNext` and `iAlways`.
+ - General infrastructure for deriving a logic for monotone predicates over
+ an existing logic (see the paper for more details).
+
+ Developments instantiating the proof mode typeclasses may need significant
+ changes. For developments just using the proof mode tactics, porting should
+ not be too much effort. Notable things to port are:
+ - All the BI laws moved from the `uPred` module to the `bi` module. For
+ example, `uPred.later_equivI` became `bi.later_equivI`.
+ - Big-ops are automatically imported, imports of `iris.base_logic.big_op` have
+ to be removed.
+ - The ⊢ notation can sometimes infer different (but convertible) terms when
+ seraching for the BI to use, which (due to Coq limitations) can lead to
+ failing rewrites, in particular when rewriting at function types.
+* The `iInv` tactic can now be used without the second argument (the name for
+ the closing update). It will then instead add the obligation to close the
+ invariant to the goal.
+* Added support for defining derived connectives involving n-ary binders using
+ telescopes.
+* The proof mode now more consistently "prettifies" the goal after each tactic.
+ Prettification also simplifies some BI connectives, like conditional
+ modalities and telescope quantifiers.
+* Improved pretty-printing of Iris connectives (in particular WP and fancy
+ updates) when Coq has to line-wrap the output. This goes hand-in-hand with an
+ improved test suite that also tests pretty-printing.
+* Added a `gmultiset` RA.
* Rename `timelessP` -> `timeless` (projection of the `Timeless` class)
* The CMRA axiom `cmra_extend` is now stated in `Type`, using `sigT` instead of
in `Prop` using `exists`. This makes it possible to define the function space
@@ -28,6 +70,8 @@ Changes in Coq:
- `cmra_opM_assoc_L` → `cmra_op_opM_assoc_L`
- `cmra_opM_assoc'` → `cmra_opM_opM_assoc`
* `namespaces` has been moved to std++.
+* Changed `IntoVal` to be directly usable for rewriting `e` into `of_val v`, and
+ changed `AsVal` to be usable for rewriting via the `[v <-]` destruct pattern.
## Iris 3.1.0 (released 2017-12-19)
diff --git a/Makefile.coq.local b/Makefile.coq.local
new file mode 100644
index 0000000000000000000000000000000000000000..7e0566de3807f4b7071e529323dd35075d91da19
--- /dev/null
+++ b/Makefile.coq.local
@@ -0,0 +1,37 @@
+# run tests with main build
+real-all: test
+
+# the test suite
+TESTFILES=$(wildcard tests/*.v)
+
+test: $(TESTFILES:.v=.vo)
+.PHONY: test
+
+COQ_TEST=$(COQTOP) $(COQDEBUG) -batch -test-mode
+COQ_BROKEN=$(shell echo "$(COQ_VERSION)" | egrep "^8\.9" > /dev/null && echo 1)
+
+# Can't use pipes because that discards error codes and dash provides no way to control that.
+# Also egrep errors if it doesn't match anything, we have to ignore that.
+# Oh Unix...
+REF_FILTER=egrep -v '(^Welcome to Coq|^Skipping rcfile loading.$$)'
+
+tests/.coqdeps.d: $(TESTFILES)
+ $(SHOW)'COQDEP TESTFILES'
+ $(HIDE)$(COQDEP) -dyndep var $(COQMF_COQLIBS_NOML) $^ $(redir_if_ok)
+-include tests/.coqdeps.d
+
+$(TESTFILES:.v=.vo): %.vo: %.v $(if $(MAKE_REF),,%.ref)
+ $(SHOW)$(if $(MAKE_REF),COQTEST [ref],$(if $(COQ_BROKEN),COQTEST [ignored],COQTEST)) $<
+ $(HIDE)TEST="$$(basename -s .v $<)" && \
+ TMPFILE="$$(mktemp)" && \
+ $(TIMER) $(COQ_TEST) $(TIMING_ARG) $(COQFLAGS) $(COQLIBS) -load-vernac-source $< $(TIMING_EXTRA) > "$$TMPFILE" && \
+ ($(REF_FILTER) < "$$TMPFILE" > "$$TMPFILE.filtered" || true) && \
+ $(if $(MAKE_REF), \
+ mv "$$TMPFILE.filtered" "tests/$$TEST.ref", \
+ $(if $(COQ_BROKEN), \
+ true, \
+ diff -u "tests/$$TEST.ref" "$$TMPFILE.filtered" \
+ ) \
+ ) && \
+ rm -f "$$TMPFILE" "$$TMPFILE.filtered" && \
+ touch $@
diff --git a/Naming.md b/Naming.md
index 955061f3362bad1b5057efa65ce1ac25f8d24148..b330260a8b9d0fab6136a6aed3d8edafb83c7188 100644
--- a/Naming.md
+++ b/Naming.md
@@ -15,6 +15,7 @@
* k
* l
* m : iGst = ghost state
+* m* = prefix for option
* n
* o
* p
diff --git a/ProofMode.md b/ProofMode.md
index 4911c0c699a8115e1cf4f4f59750b8b694df1e4d..4fb2039588578bd6d916357d324d55f103313bc4 100644
--- a/ProofMode.md
+++ b/ProofMode.md
@@ -41,8 +41,8 @@ Context management
the resulting goal.
- `iPoseProof pm_trm as (x1 ... xn) "ipat"` : put `pm_trm` into the context and
eliminates it. This tactic is essentially the same as `iDestruct` with the
- difference that when `pm_trm` is a non-univerisally quantified persistent
- hypothesis, it will not throw away the hypothesis.
+ difference that when `pm_trm` is a non-universally quantified intuitionistic
+ hypothesis, it will not throw the hypothesis away.
- `iAssert P with "spat" as "ipat"` : generates a new subgoal `P` and adds the
hypothesis `P` to the current goal. The specialization pattern `spat`
specifies which hypotheses will be consumed by proving `P`. The introduction
@@ -108,41 +108,32 @@ Separating logic specific tactics
This tactic finishes the goal in case everything in the conclusion has been
framed.
-- `iCombine "H1" "H2" as "H"` : turns `H1 : P1` and `H2 : P2` into
- `H : P1 ∗ P2`.
+- `iCombine "H1" "H2" as "pat"` : turns `H1 : P1` and `H2 : P2` into
+ `P1 ∗ P2`, on which `iDetruct ... as pat` is called.
Modalities
----------
-- `iModIntro` : introduction of a modality that is an instance of the
- `FromModal` type class. Instances include: later, except 0, basic update and
- fancy update.
+- `iModIntro mod` : introduction of a modality. The type class `FromModal` is
+ used to specify which modalities this tactic should introduce. Instances of
+ that type class include: later, except 0, basic update and fancy update,
+ persistently, affinely, plainly, absorbingly, objectively, and subjectively.
+ The optional argument `mod` can be used to specify what modality to introduce
+ in case of ambiguity, e.g. `⎡|==> P⎤`.
+- `iAlways` : a deprecated alias of `iModIntro`.
+- `iNext n` : an alias of `iModIntro (â–·^n P)`.
+- `iNext` : an alias of `iModIntro (â–·^1 P)`.
- `iMod pm_trm as (x1 ... xn) "ipat"` : eliminate a modality `pm_trm` that is
an instance of the `ElimModal` type class. Instances include: later, except 0,
basic update and fancy update.
-The persistence and plainness modalities
-----------------------------------------
-
-- `iAlways` : introduce a persistence or plainness modality and the spatial
- context. In case of a plainness modality, the tactic will prune all persistent
- hypotheses that are not plain.
-
-The later modality
-------------------
+Induction
+---------
-- `iNext n` : introduce `n` laters by stripping that number of laters from all
- hypotheses. If the argument `n` is not given, it strips one later if the
- leftmost conjunct is of the shape `â–· P`, or `n` laters if the leftmost
- conjunct is of the shape `â–·^n P`.
- `iLöb as "IH" forall (x1 ... xn) "selpat"` : perform Löb induction by
generating a hypothesis `IH : â–· goal`. The tactic generalizes over the Coq
level variables `x1 ... xn`, the hypotheses given by the selection pattern
`selpat`, and the spatial context.
-
-Induction
----------
-
- `iInduction x as cpat "IH" forall (x1 ... xn) "selpat"` : perform induction on
the Coq term `x`. The Coq introduction pattern is used to name the introduced
variables. The induction hypotheses are inserted into the persistent context
@@ -170,8 +161,11 @@ Rewriting / simplification
Iris
----
-- `iInv N as (x1 ... xn) "ipat" "Hclose"` : open the invariant `N`, the update
- for closing the invariant is put in a hypothesis named `Hclose`.
+- `iInv S with "selpat" as (x1 ... xn) "ipat" "Hclose"` : where `S` is either
+ a namespace N or an identifier "H". Open the invariant indicated by S. The
+ selection pattern `selpat` is used for any auxiliary assertions needed to
+ open the invariant (e.g. for cancelable or non-atomic invariants). The update
+ for closing the invariant is put in a hypothesis named `Hclose`.
Miscellaneous
-------------
@@ -226,8 +220,8 @@ appear at the top level:
Items of the selection pattern can be prefixed with `$`, which cause them to
be framed instead of cleared.
- `!%` : introduce a pure goal (and leave the proof mode).
-- `!#` : introduce an persistence or plainness modality (by calling `iAlways`).
-- `!>` : introduce a modality (by calling `iModIntro`).
+- `!>` : introduce a modality by calling `iModIntro`.
+- `!#` : introduce a modality by calling `iModIntro` (deprecated).
- `/=` : perform `simpl`.
- `//` : perform `try done` on all goals.
- `//=` : syntactic sugar for `/= //`
diff --git a/README.md b/README.md
index 09dafca6b1a65fc44fdd04afddcd462548087e8a..2aaedbe39c1cd52a17d764f74245aa1fc2830f2c 100644
--- a/README.md
+++ b/README.md
@@ -2,11 +2,17 @@
This is the Coq development of the [Iris Project](http://iris-project.org).
-## Prerequisites
+A LaTeX version of the core logic definitions and some derived forms is
+available in [docs/iris.tex](docs/iris.tex). A compiled PDF version of this
+document is [available online](http://plv.mpi-sws.org/iris/appendix-3.1.pdf).
+
+## Building Iris
+
+### Prerequisites
This version is known to compile with:
- - Coq 8.7.0 / 8.7.1 / 8.7.2 / 8.8.0
+ - Coq 8.7.1 / 8.7.2 / 8.8.0
- A development version of [std++](https://gitlab.mpi-sws.org/robbertkrebbers/coq-stdpp)
For a version compatible with Coq 8.6, have a look at the
@@ -14,7 +20,7 @@ For a version compatible with Coq 8.6, have a look at the
If you need to work with Coq 8.5, please check out the
[iris-3.0 branch](https://gitlab.mpi-sws.org/FP/iris-coq/tree/iris-3.0).
-## Working *with* Iris
+### Working *with* Iris
To use Iris in your own proofs, we recommend you install Iris via opam (1.2.2 or
newer). To obtain the latest stable release, you have to add the Coq opam
@@ -31,7 +37,7 @@ Either way, you can now do `opam install coq-iris`. To fetch updates later, run
backwards-compatibility, so upgrading Iris may break your Iris-using
developments.
-## Working *on* Iris
+### Working *on* Iris
To work on Iris itself, you need to install its build-dependencies. Again we
recommend you do that with opam (1.2.2 or newer). This requires the following
@@ -65,9 +71,12 @@ followed by `make build-dep`.
to build Iris, the program logic. This includes weakest preconditions that
are defined for any language satisfying some generic axioms, and some derived
constructions that work for any such language.
-* The folder [proofmode](theories/proofmode) contains the Iris proof mode, which
- extends Coq with contexts for persistent and spatial Iris assertions. It also
- contains tactics for interactive proofs in Iris. Documentation can be found in
+* The folder [bi](theories/bi) contains the BI++ laws, as well as derived
+ connectives, laws and constructions that are applicable for general BIS.
+* The folder [proofmode](theories/proofmode) contains
+ [MoSeL](http://iris-project.org/mosel/), which extends Coq with contexts for
+ intuitionistic and spatial BI++ assertions. It also contains tactics for
+ interactive proofs. Documentation can be found in
[ProofMode.md](ProofMode.md).
* The folder [heap_lang](theories/heap_lang) defines the ML-like concurrent heap
language
@@ -79,16 +88,6 @@ followed by `make build-dep`.
infrastructure. Users of the Iris Coq library should *not* depend on these
modules; they may change or disappear without any notice.
-## Further Documentation
-
-* A LaTeX version of the core logic definitions and some derived forms is
- available in [docs/iris.tex](docs/iris.tex). A compiled PDF version of this
- document is [available online](http://plv.mpi-sws.org/iris/appendix-3.1.pdf).
-* Information on how to set up your editor for unicode input and output is
- collected in [Editor.md](Editor.md).
-* The Iris Proof Mode (IPM) is documented at [ProofMode.md](ProofMode.md).
-* Naming conventions are documented at [Naming.md](Naming.md).
-
## Case Studies
The following is a (probably incomplete) list of case studies that use Iris, and
@@ -101,7 +100,14 @@ that should be compatible with this version:
* [Iris Atomic](https://gitlab.mpi-sws.org/FP/iris-atomic/) is an experimental
formalization of logically atomic triples in Iris.
-## For Developers: How to update the std++ dependency
+## Notes for Iris Developers
+
+* Information on how to set up your editor for unicode input and output is
+ collected in [Editor.md](Editor.md).
+* The Iris Proof Mode (IPM) is documented at [ProofMode.md](ProofMode.md).
+* Naming conventions are documented at [Naming.md](Naming.md).
+
+### How to update the std++ dependency
* Do the change in std++, push it.
* Wait for CI to publish a new std++ version on the opam archive, then run
@@ -110,3 +116,13 @@ that should be compatible with this version:
* Run `make build-dep` (in Iris) to install the new version of std++.
You may have to do `make clean` as Coq will likely complain about .vo file
mismatches.
+
+### How to write/update test cases
+
+The files in `tests/` are test cases. Each of the `.v` files comes with a
+matching `.ref` file containing the expected output of `coqc`. Adding `Show.`
+in selected places in the proofs makes `coqc` print the current goal state.
+This is used to make sure the proof mode prints goals and reduces terms the way
+we expect it to. You can run `MAKE_REF=1 make` to re-generate all the `.ref` files;
+this is useful after adding or removing `Show.` from a test. If you do this,
+make sure to check the diff for any unexpected changes in the output!
diff --git a/_CoqProject b/_CoqProject
index 737e8bf3d09ea5aa0fe547669955c8a84632b779..92fc6bd868e7653ba9dcbda026a271ce755ef9f5 100644
--- a/_CoqProject
+++ b/_CoqProject
@@ -25,17 +25,33 @@ theories/algebra/gset.v
theories/algebra/gmultiset.v
theories/algebra/coPset.v
theories/algebra/deprecated.v
+theories/algebra/proofmode_classes.v
+theories/bi/notation.v
+theories/bi/interface.v
+theories/bi/derived_connectives.v
+theories/bi/derived_laws_bi.v
+theories/bi/derived_laws_sbi.v
+theories/bi/plainly.v
+theories/bi/big_op.v
+theories/bi/updates.v
+theories/bi/bi.v
+theories/bi/tactics.v
+theories/bi/monpred.v
+theories/bi/embedding.v
+theories/bi/weakestpre.v
+theories/bi/telescopes.v
+theories/bi/lib/counter_examples.v
+theories/bi/lib/fixpoint.v
+theories/bi/lib/fractional.v
+theories/bi/lib/laterable.v
+theories/bi/lib/atomic.v
+theories/bi/lib/core.v
theories/base_logic/upred.v
-theories/base_logic/primitive.v
+theories/base_logic/bi.v
theories/base_logic/derived.v
+theories/base_logic/proofmode.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/lib/iprop.v
theories/base_logic/lib/own.v
theories/base_logic/lib/saved_prop.v
@@ -48,10 +64,7 @@ theories/base_logic/lib/sts.v
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
theories/program_logic/adequacy.v
theories/program_logic/lifting.v
@@ -66,10 +79,14 @@ theories/program_logic/ectx_lifting.v
theories/program_logic/ownp.v
theories/program_logic/total_lifting.v
theories/program_logic/total_ectx_lifting.v
+theories/program_logic/atomic.v
theories/heap_lang/lang.v
theories/heap_lang/tactics.v
theories/heap_lang/lifting.v
theories/heap_lang/notation.v
+theories/heap_lang/proofmode.v
+theories/heap_lang/adequacy.v
+theories/heap_lang/total_adequacy.v
theories/heap_lang/lib/spawn.v
theories/heap_lang/lib/par.v
theories/heap_lang/lib/assert.v
@@ -77,24 +94,23 @@ theories/heap_lang/lib/lock.v
theories/heap_lang/lib/spin_lock.v
theories/heap_lang/lib/ticket_lock.v
theories/heap_lang/lib/counter.v
-theories/heap_lang/proofmode.v
-theories/heap_lang/adequacy.v
-theories/heap_lang/total_adequacy.v
+theories/heap_lang/lib/atomic_heap.v
+theories/heap_lang/lib/increment.v
theories/proofmode/base.v
theories/proofmode/tokens.v
theories/proofmode/coq_tactics.v
+theories/proofmode/ltac_tactics.v
theories/proofmode/environments.v
+theories/proofmode/reduction.v
theories/proofmode/intro_patterns.v
theories/proofmode/spec_patterns.v
theories/proofmode/sel_patterns.v
theories/proofmode/tactics.v
theories/proofmode/notation.v
theories/proofmode/classes.v
-theories/proofmode/class_instances.v
-theories/tests/heap_lang.v
-theories/tests/one_shot.v
-theories/tests/proofmode.v
-theories/tests/list_reverse.v
-theories/tests/tree_sum.v
-theories/tests/ipm_paper.v
-theories/tests/algebra.v
+theories/proofmode/class_instances_bi.v
+theories/proofmode/class_instances_sbi.v
+theories/proofmode/frame_instances.v
+theories/proofmode/monpred.v
+theories/proofmode/modalities.v
+theories/proofmode/modality_instances.v
diff --git a/opam b/opam
index 54ce50321d4553dc05779eeb793c08a3b8a9d9c1..5799c2c0d4dc7331d26152270723be9ff0ed8536 100644
--- a/opam
+++ b/opam
@@ -10,6 +10,6 @@ build: [make "-j%{jobs}%"]
install: [make "install"]
remove: ["rm" "-rf" "%{lib}%/coq/user-contrib/iris"]
depends: [
- "coq" { (>= "8.7.0" & < "8.9~") | (= "dev") }
- "coq-stdpp" { (= "dev.2018-06-25.1.0eb9a89b") | (= "dev") }
+ "coq" { (>= "8.7.1" & < "8.9~") | (= "dev") }
+ "coq-stdpp" { (= "dev.2018-06-30.1.1a21e908") | (= "dev") }
]
diff --git a/tests/algebra.ref b/tests/algebra.ref
new file mode 100644
index 0000000000000000000000000000000000000000..e69de29bb2d1d6434b8b29ae775ad8c2e48c5391
diff --git a/tests/algebra.v b/tests/algebra.v
new file mode 100644
index 0000000000000000000000000000000000000000..0ec719eac82be93cfeecc39573369c566b27bfd5
--- /dev/null
+++ b/tests/algebra.v
@@ -0,0 +1,26 @@
+From iris.base_logic.lib Require Import invariants.
+
+Section tests.
+ Context `{invG Σ}.
+
+ Program Definition test : (iProp Σ -n> iProp Σ) -n> (iProp Σ -n> iProp Σ) :=
+ λne P v, (▷ (P v))%I.
+ Solve Obligations with solve_proper.
+
+End tests.
+
+(** Check that [@Reflexive Prop ?r] picks the instance setoid_rewrite needs.
+ Really, we want to set [Hint Mode Reflexive] in a way that this fails, but
+ we cannot [1]. So at least we try to make sure the first solution found
+ is the right one, to not pay performance in the success case [2].
+
+ [1] https://github.com/coq/coq/issues/7916
+ [2] https://gitlab.mpi-sws.org/robbertkrebbers/coq-stdpp/merge_requests/38
+*)
+Lemma test_setoid_rewrite :
+ exists R, @Reflexive Prop R /\ R = iff.
+Proof.
+ eexists. split.
+ - apply _.
+ - reflexivity.
+Qed.
diff --git a/tests/heap_lang.ref b/tests/heap_lang.ref
new file mode 100644
index 0000000000000000000000000000000000000000..b4ac2c10a5b6822a67b8883062addc91665b61a3
--- /dev/null
+++ b/tests/heap_lang.ref
@@ -0,0 +1,107 @@
+1 subgoal
+
+ Σ : gFunctors
+ H : heapG Σ
+ E : coPset
+ ============================
+ --------------------------------------∗
+ WP let: "x" := ref #1 in "x" <- ! "x" + #1;; ! "x" @ E {{ v, ⌜v = #2⌠}}
+
+1 subgoal
+
+ Σ : gFunctors
+ H : heapG Σ
+ E : coPset
+ l : loc
+ ============================
+ _ : l ↦ #1
+ --------------------------------------∗
+ WP #l <- #1 + #1;; ! #l @ E {{ v, ⌜v = #2⌠}}
+
+1 subgoal
+
+ Σ : gFunctors
+ H : heapG Σ
+ E : coPset
+ l : loc
+ ============================
+ "Hl" : l ↦ #1
+ --------------------------------------∗
+ WP let: "x" := #l in let: "y" := ref #1 in "x" <- ! "x" + #1;; ! "x"
+ @ E [{ v, ⌜v = #2⌠}]
+
+1 subgoal
+
+ Σ : gFunctors
+ H : heapG Σ
+ l : loc
+ ============================
+ "Hl1" : l ↦{1 / 2} #0
+ "Hl2" : l ↦{1 / 2} #0
+ --------------------------------------∗
+ True
+
+1 subgoal
+
+ Σ : gFunctors
+ H : heapG Σ
+ l : loc
+ ============================
+ --------------------------------------∗
+ True
+
+1 subgoal
+
+ Σ : gFunctors
+ H : heapG Σ
+ fun1, fun2, fun3 : expr
+ ============================
+ --------------------------------------∗
+ WP let: "val1" := fun1 #() in
+ let: "val2" := fun2 "val1" in
+ let: "val3" := fun3 "val2" in if: "val1" = "val2" then "val" else "val3"
+ {{ _, True }}
+
+1 subgoal
+
+ Σ : gFunctors
+ H : heapG Σ
+ fun1, fun2, fun3 : expr
+ Φ : language.val heap_lang → iPropI Σ
+ ============================
+ --------------------------------------∗
+ WP let: "val1" := fun1 #() in
+ let: "val2" := fun2 "val1" in
+ let: "v" := fun3 "v" in if: "v" = "v" then "v" else "v"
+ {{ v, Φ v }}
+
+1 subgoal
+
+ Σ : gFunctors
+ H : heapG Σ
+ fun1, fun2, fun3 : expr
+ Φ : language.val heap_lang → iPropI Σ
+ E : coPset
+ ============================
+ --------------------------------------∗
+ WP let: "val1" := fun1 #() in
+ let: "val2" := fun2 "val1" in
+ let: "v" := fun3 "v" in if: "v" = "v" then "v" else "v"
+ @ E {{ v, Φ v }}
+
+1 subgoal
+
+ Σ : gFunctors
+ H : heapG Σ
+ fun1, fun2, fun3 : expr
+ ============================
+ {{{ True }}}
+ let: "val1" := fun1 #() in
+ let: "val2" := fun2 "val1" in
+ let: "val3" := fun3 "val2" in if: "val1" = "val2" then "val" else "val3"
+ {{{ (x y : val) (z : Z), RET (x, y, #z); True }}}
+"not_cas"
+ : string
+The command has indeed failed with message:
+Ltac call to "wp_cas_suc" failed.
+Tactic failure: wp_cas_suc: cannot find 'CAS' in (#())%E.
diff --git a/theories/tests/heap_lang.v b/tests/heap_lang.v
similarity index 58%
rename from theories/tests/heap_lang.v
rename to tests/heap_lang.v
index 62b74b5e0a6ce9ae1648016cec06161d8219d96e..dd4a53e4e7a1d1f5488298966329db92fbad2d13 100644
--- a/theories/tests/heap_lang.v
+++ b/tests/heap_lang.v
@@ -1,11 +1,10 @@
-(** This file is essentially a bunch of testcases. *)
From iris.program_logic Require Export weakestpre total_weakestpre.
-From iris.heap_lang Require Export lang.
-From iris.heap_lang Require Import adequacy.
-From iris.heap_lang Require Import proofmode notation.
+From iris.heap_lang Require Import lang adequacy proofmode notation.
+(* Import lang *again*. This used to break notation. *)
+From iris.heap_lang Require Import lang.
Set Default Proof Using "Type".
-Section LiftingTests.
+Section tests.
Context `{heapG Σ}.
Implicit Types P Q : iProp Σ.
Implicit Types Φ : val → iProp Σ.
@@ -20,13 +19,16 @@ Section LiftingTests.
end.
Qed.
+ Definition val_scope_test_1 := SOMEV (#(), #()).
+
Definition heap_e : expr :=
let: "x" := ref #1 in "x" <- !"x" + #1 ;; !"x".
Lemma heap_e_spec E : WP heap_e @ E {{ v, ⌜v = #2⌠}}%I.
Proof.
- iIntros "". rewrite /heap_e.
- wp_alloc l. wp_let. wp_load. wp_op. wp_store. by wp_load.
+ iIntros "". rewrite /heap_e. Show.
+ wp_alloc l as "?". wp_let. wp_load. Show.
+ wp_op. wp_store. by wp_load.
Qed.
Definition heap_e2 : expr :=
@@ -37,7 +39,7 @@ Section LiftingTests.
Lemma heap_e2_spec E : WP heap_e2 @ E [{ v, ⌜v = #2⌠}]%I.
Proof.
iIntros "". rewrite /heap_e2.
- wp_alloc l. wp_let. wp_alloc l'. wp_let.
+ wp_alloc l as "Hl". Show. wp_let. wp_alloc l'. wp_let.
wp_load. wp_op. wp_store. wp_load. done.
Qed.
@@ -114,7 +116,78 @@ Section LiftingTests.
P -∗ (∀ Q Φ, Q -∗ WP e {{ Φ }}) -∗ WP e {{ _, True }}.
Proof. iIntros "HP HW". wp_apply "HW". iExact "HP". Qed.
-End LiftingTests.
+ Lemma wp_cas l v :
+ val_is_unboxed v →
+ l ↦ v -∗ WP CAS #l v v {{ _, True }}.
+ Proof.
+ iIntros (?) "?". wp_cas as ? | ?. done. done.
+ Qed.
+
+ Lemma wp_alloc_split :
+ WP Alloc #0 {{ _, True }}%I.
+ Proof. wp_alloc l as "[Hl1 Hl2]". Show. done. Qed.
+
+ Lemma wp_alloc_drop :
+ WP Alloc #0 {{ _, True }}%I.
+ Proof. wp_alloc l as "_". Show. done. Qed.
+
+End tests.
+
+Section printing_tests.
+ Context `{heapG Σ}.
+
+ (* These terms aren't even closed, but that's not what this is about. The
+ length of the variable names etc. has been carefully chosen to trigger
+ particular behavior of the Coq pretty printer. *)
+
+ Lemma wp_print_long_expr (fun1 fun2 fun3 : expr) :
+ True -∗ WP let: "val1" := fun1 #() in
+ let: "val2" := fun2 "val1" in
+ let: "val3" := fun3 "val2" in
+ if: "val1" = "val2" then "val" else "val3" {{ _, True }}.
+ Proof.
+ iIntros "_". Show.
+ Abort.
+
+ Lemma wp_print_long_expr (fun1 fun2 fun3 : expr) Φ :
+ True -∗ WP let: "val1" := fun1 #() in
+ let: "val2" := fun2 "val1" in
+ let: "v" := fun3 "v" in
+ if: "v" = "v" then "v" else "v" {{ Φ }}.
+ Proof.
+ iIntros "_". Show.
+ Abort.
+
+ Lemma wp_print_long_expr (fun1 fun2 fun3 : expr) Φ E :
+ True -∗ WP let: "val1" := fun1 #() in
+ let: "val2" := fun2 "val1" in
+ let: "v" := fun3 "v" in
+ if: "v" = "v" then "v" else "v" @ E {{ Φ }}.
+ Proof.
+ iIntros "_". Show.
+ Abort.
+
+ Lemma texan_triple_long_expr (fun1 fun2 fun3 : expr) :
+ {{{ True }}}
+ let: "val1" := fun1 #() in
+ let: "val2" := fun2 "val1" in
+ let: "val3" := fun3 "val2" in
+ if: "val1" = "val2" then "val" else "val3"
+ {{{ (x y : val) (z : Z), RET (x, y, #z); True }}}.
+ Proof. Show. Abort.
+
+End printing_tests.
+
+Section error_tests.
+ Context `{heapG Σ}.
+
+ Check "not_cas".
+ Lemma not_cas :
+ (WP #() {{ _, True }})%I.
+ Proof.
+ Fail wp_cas_suc.
+ Abort.
+End error_tests.
Lemma heap_e_adequate σ : adequate NotStuck heap_e σ (= #2).
Proof. eapply (heap_adequacy heapΣ)=> ?. by apply heap_e_spec. Qed.
diff --git a/tests/heap_lang2.ref b/tests/heap_lang2.ref
new file mode 100644
index 0000000000000000000000000000000000000000..eb393dc0109ff2fbbf477951c30394bcf4b64a39
--- /dev/null
+++ b/tests/heap_lang2.ref
@@ -0,0 +1,12 @@
+1 subgoal
+
+ Σ : gFunctors
+ H : heapG Σ
+ fun1, fun2, fun3 : expr
+ ============================
+ --------------------------------------∗
+ WP let: "val1" := fun1 #() in
+ let: "val2" := fun2 "val1" in
+ let: "val3" := fun3 "val2" in if: "val1" = "val2" then "val" else "val3"
+ {{ _, True }}
+
diff --git a/tests/heap_lang2.v b/tests/heap_lang2.v
new file mode 100644
index 0000000000000000000000000000000000000000..cada4949b06fb7ee6b4cf5af28a33d273660c745
--- /dev/null
+++ b/tests/heap_lang2.v
@@ -0,0 +1,20 @@
+(* Test yet another way of importing heap_lang modules that used to break
+printing *)
+From iris.heap_lang Require Export lifting notation.
+From iris.proofmode Require Import tactics.
+From iris.heap_lang Require Import proofmode notation.
+Set Default Proof Using "Type".
+
+Section printing_tests.
+ Context `{heapG Σ}.
+
+ Lemma wp_print_long_expr (fun1 fun2 fun3 : expr) :
+ True -∗ WP let: "val1" := fun1 #() in
+ let: "val2" := fun2 "val1" in
+ let: "val3" := fun3 "val2" in
+ if: "val1" = "val2" then "val" else "val3" {{ _, True }}.
+ Proof.
+ iIntros "_". Show.
+ Abort.
+
+End printing_tests.
diff --git a/tests/ipm_paper.ref b/tests/ipm_paper.ref
new file mode 100644
index 0000000000000000000000000000000000000000..9bcb74f82069801b5c48be7eae96fc66eb070ff9
--- /dev/null
+++ b/tests/ipm_paper.ref
@@ -0,0 +1,100 @@
+"sep_exist"
+ : string
+1 subgoal
+
+ M : ucmraT
+ A : Type
+ P, R : iProp
+ Ψ : A → iProp
+ x : A
+ ============================
+ "HP" : P
+ "HΨ" : Ψ x
+ "HR" : R
+ --------------------------------------∗
+ Ψ x ∗ P
+
+2 subgoals
+
+ M : ucmraT
+ A : Type
+ P, R : iProp
+ Ψ : A → iProp
+ x : A
+ ============================
+ "HΨ" : Ψ x
+ --------------------------------------∗
+ Ψ x
+
+
+subgoal 2 is:
+ "HP" : P
+"HR" : R
+--------------------------------------∗
+P
+
+1 subgoal
+
+ M : ucmraT
+ A : Type
+ P, R : iProp
+ Ψ : A → iProp
+ x : A
+ ============================
+ "HP" : P
+ "HR" : R
+ --------------------------------------∗
+ P
+
+"sep_exist_short"
+ : string
+1 subgoal
+
+ M : ucmraT
+ A : Type
+ P, R : iProp
+ Ψ : A → iProp
+ ============================
+ "HP" : P
+ "HΨ" : ∃ a : A, Ψ a
+ "HR" : R
+ --------------------------------------∗
+ ∃ a : A, Ψ a ∗ P
+
+"read_spec"
+ : string
+1 subgoal
+
+ Σ : gFunctors
+ heapG0 : heapG Σ
+ counterG0 : counterG Σ
+ l : loc
+ n : nat
+ N : namespace
+ γ : gname
+ ============================
+ "Hinv" : inv N (I γ l)
+ --------------------------------------â–¡
+ "Hγf" : own γ (Frag n)
+ --------------------------------------∗
+ WP ! #l {{ v, ∃ m : nat, ⌜v = #m ∧ n ≤ m⌠∧ C l m }}
+
+1 subgoal
+
+ Σ : gFunctors
+ heapG0 : heapG Σ
+ counterG0 : counterG Σ
+ l : loc
+ n : nat
+ N : namespace
+ γ : gname
+ c : nat
+ ============================
+ "Hinv" : inv N (I γ l)
+ --------------------------------------â–¡
+ "Hγf" : own γ (Frag n)
+ "Hl" : l ↦ #c
+ "Hγ" : own γ (Auth c)
+ --------------------------------------∗
+ ▷ I γ l ∗ (∃ m : nat, ⌜#c = #m ∧ n ≤ m⌠∧ C l m)
+
diff --git a/theories/tests/ipm_paper.v b/tests/ipm_paper.v
similarity index 94%
rename from theories/tests/ipm_paper.v
rename to tests/ipm_paper.v
index 38ad33dc6008a9b944c4cbde62ae79efa1be00d9..179183d14cd686bbed77dae492e17c53db0b7c40 100644
--- a/theories/tests/ipm_paper.v
+++ b/tests/ipm_paper.v
@@ -1,3 +1,8 @@
+(** This file contains the examples from the paper:
+
+Interactive Proofs in Higher-Order Concurrent Separation Logic
+Robbert Krebbers, Amin Timany and Lars Birkedal
+POPL 2017 *)
From iris.base_logic Require Import base_logic.
From iris.proofmode Require Import tactics.
From iris.program_logic Require Export hoare.
@@ -20,19 +25,21 @@ Section demo.
Qed.
(* The version in IPM *)
+ Check "sep_exist".
Lemma sep_exist A (P R: iProp) (Ψ: A → iProp) :
P ∗ (∃ a, Ψ a) ∗ R ⊢ ∃ a, Ψ a ∗ P.
Proof.
iIntros "[HP [HΨ HR]]".
iDestruct "HΨ" as (x) "HΨ".
- iExists x.
- iSplitL "HΨ". iAssumption. iAssumption.
+ iExists x. Show.
+ iSplitL "HΨ". Show. iAssumption. Show. iAssumption.
Qed.
(* The short version in IPM, as in the paper *)
+ Check "sep_exist_short".
Lemma sep_exist_short A (P R: iProp) (Ψ: A → iProp) :
P ∗ (∃ a, Ψ a) ∗ R ⊢ ∃ a, Ψ a ∗ P.
- Proof. iIntros "[HP [HΨ HR]]". iFrame "HP". iAssumption. Qed.
+ Proof. iIntros "[HP [HΨ HR]]". Show. iFrame "HP". iAssumption. Qed.
(* An even shorter version in IPM, using the frame introduction pattern `$` *)
Lemma sep_exist_shorter A (P R: iProp) (Ψ: A → iProp) :
@@ -230,12 +237,13 @@ Section counter_proof.
wp_if. iApply ("IH" with "[Hγf]"). rewrite {3}/C; eauto 10.
Qed.
+ Check "read_spec".
Lemma read_spec l n :
{{ C l n }} read #l {{ v, ∃ m : nat, ⌜v = #m ∧ n ≤ m⌠∧ C l m }}.
Proof.
iIntros "!# Hl /=". iDestruct "Hl" as (N γ) "[#Hinv Hγf]".
- rewrite /read /=. wp_let. iApply wp_inv_open; last iFrame "Hinv"; auto.
- iDestruct 1 as (c) "[Hl Hγ]". wp_load.
+ rewrite /read /=. wp_let. Show. iApply wp_inv_open; last iFrame "Hinv"; auto.
+ iDestruct 1 as (c) "[Hl Hγ]". wp_load. Show.
iDestruct (own_valid γ (Frag n ⋅ Auth c) with "[-]") as % ?%auth_frag_valid.
{ iApply own_op. by iFrame. }
rewrite (auth_frag_op c c); last lia; iDestruct "Hγ" as "[Hγ Hγf']".
diff --git a/tests/list_reverse.ref b/tests/list_reverse.ref
new file mode 100644
index 0000000000000000000000000000000000000000..baa2732685cdddb4b868065a8973d881f6dddc52
--- /dev/null
+++ b/tests/list_reverse.ref
@@ -0,0 +1,33 @@
+1 subgoal
+
+ Σ : gFunctors
+ heapG0 : heapG Σ
+ hd, acc : val
+ xs, ys : list val
+ Φ : val → iPropI Σ
+ ============================
+ "Hxs" : is_list hd xs
+ "Hys" : is_list acc ys
+ "HΦ" : ∀ w : val, is_list w (reverse xs ++ ys) -∗ Φ w
+ --------------------------------------∗
+ WP (rev hd) acc [{ v, Φ v }]
+
+1 subgoal
+
+ Σ : gFunctors
+ heapG0 : heapG Σ
+ acc : val
+ ys : list val
+ Φ : val → iPropI Σ
+ ============================
+ "Hys" : is_list acc ys
+ "HΦ" : ∀ w : val, is_list w ys -∗ Φ w
+ --------------------------------------∗
+ WP match: InjL #() with
+ InjL <> => acc
+ | InjR "l" =>
+ let: "tmp1" := Fst ! "l" in
+ let: "tmp2" := Snd ! "l" in
+ "l" <- ("tmp1", acc);; (rev "tmp2") (InjL #())
+ end [{ v, Φ v }]
+
diff --git a/theories/tests/list_reverse.v b/tests/list_reverse.v
similarity index 95%
rename from theories/tests/list_reverse.v
rename to tests/list_reverse.v
index d5388c0e156e86b880197c0b57ad24addb2f9c75..89b5963bba51711f4faf3223472f10b1c35e5f5f 100644
--- a/theories/tests/list_reverse.v
+++ b/tests/list_reverse.v
@@ -31,10 +31,10 @@ Lemma rev_acc_wp hd acc xs ys :
rev hd acc
[[{ w, RET w; is_list w (reverse xs ++ ys) }]].
Proof.
- iIntros (Φ) "[Hxs Hys] HΦ".
+ iIntros (Φ) "[Hxs Hys] HΦ". Show.
iInduction xs as [|x xs] "IH" forall (hd acc ys Φ);
iSimplifyEq; wp_rec; wp_let.
- - wp_match. by iApply "HΦ".
+ - Show. wp_match. by iApply "HΦ".
- iDestruct "Hxs" as (l hd' ->) "[Hx Hxs]".
wp_match. wp_load. wp_proj. wp_let. wp_load. wp_proj. wp_let. wp_store.
iApply ("IH" $! hd' (SOMEV #l) (x :: ys) with "Hxs [Hx Hys]"); simpl.
diff --git a/tests/mosel_paper.ref b/tests/mosel_paper.ref
new file mode 100644
index 0000000000000000000000000000000000000000..700e1159a429303df2d04f7dd27d6ef515796122
--- /dev/null
+++ b/tests/mosel_paper.ref
@@ -0,0 +1,173 @@
+1 subgoal
+
+ PROP : bi
+ A : Type
+ P : PROP
+ Φ, Ψ : A → PROP
+ ============================
+ "HP" : P
+ "H" : ∃ a : A, Φ a ∨ Ψ a
+ --------------------------------------∗
+ ∃ a : A, P ∗ Φ a ∨ P ∗ Ψ a
+
+1 subgoal
+
+ PROP : bi
+ A : Type
+ P : PROP
+ Φ, Ψ : A → PROP
+ x : A
+ ============================
+ "HP" : P
+ "H1" : Φ x
+ --------------------------------------∗
+ ∃ a : A, P ∗ Φ a ∨ P ∗ Ψ a
+
+1 subgoal
+
+ PROP : bi
+ A : Type
+ P : PROP
+ Φ, Ψ : A → PROP
+ x : A
+ ============================
+ "HP" : P
+ "H2" : Ψ x
+ --------------------------------------∗
+ ∃ a : A, P ∗ Φ a ∨ P ∗ Ψ a
+
+1 subgoal
+
+ PROP : bi
+ A : Type
+ P : PROP
+ Φ, Ψ : A → PROP
+ ============================
+ "HP" : P
+ "H" : ∃ a : A, Φ a ∨ Ψ a
+ --------------------------------------∗
+ ∃ a : A, P ∗ Φ a ∨ P ∗ Ψ a
+
+1 subgoal
+
+ PROP : bi
+ A : Type
+ P : PROP
+ Φ, Ψ : A → PROP
+ ============================
+ "H" : ∃ a : A, Φ a ∨ Ψ a
+ --------------------------------------∗
+ ∃ x : A, Φ x ∨ Ψ x
+
+1 subgoal
+
+ PROP : bi
+ A : Type
+ P : PROP
+ Φ, Ψ : A → PROP
+ x : A
+ ============================
+ "HP" : <affine> P
+ "H1" : Φ x
+ --------------------------------------∗
+ Φ x
+
+1 subgoal
+
+ PROP : bi
+ A : Type
+ P : PROP
+ Φ, Ψ : A → PROP
+ x : A
+ ============================
+ "HP" : <affine> P
+ "H2" : Ψ x
+ --------------------------------------∗
+ P ∗ Ψ x
+
+1 subgoal
+
+ PROP : bi
+ A : Type
+ P : PROP
+ Φ, Ψ : A → PROP
+ ============================
+ "HP" : P
+ --------------------------------------â–¡
+ "H" : ∃ a : A, Φ a ∨ Ψ a
+ --------------------------------------∗
+ ∃ a : A, Φ a ∨ P ∗ P ∗ Ψ a
+
+1 subgoal
+
+ PROP : bi
+ A : Type
+ P : PROP
+ Φ, Ψ : A → PROP
+ x : A
+ ============================
+ "HP" : P
+ --------------------------------------â–¡
+ "H2" : Ψ x
+ --------------------------------------∗
+ P ∗ P ∗ Ψ x
+
+1 subgoal
+
+ PROP : bi
+ A : Type
+ P, Q : PROP
+ ============================
+ "HP" : P
+ "HQ" : Q
+ --------------------------------------â–¡
+ □ (P ∗ Q)
+
+1 subgoal
+
+ I : biIndex
+ PROP : bi
+ Φ, Ψ : monPred I PROP
+ ============================
+ "H1" : Φ
+ "H2" : Φ -∗ Ψ
+ --------------------------------------∗
+ Ψ
+
+1 subgoal
+
+ I : biIndex
+ PROP : bi
+ Φ, Ψ : monPred I PROP
+ ============================
+ --------------------------------------∗
+ ∀ i : I, Φ i ∗ (Φ -∗ Ψ) i -∗ Ψ i
+
+1 subgoal
+
+ I : biIndex
+ PROP : bi
+ Φ : monPred I PROP
+ P, Q : PROP
+ ============================
+ "H2" : ⎡ P ⎤
+ --------------------------------------â–¡
+ "H1" : ⎡ P -∗ Q ⎤
+ "H3" : <affine> Φ
+ --------------------------------------∗
+ ⎡ P ∗ Q ⎤
+
+1 subgoal
+
+ I : biIndex
+ PROP : bi
+ Φ : monPred I PROP
+ P, Q : PROP
+ ============================
+ "H2" : ⎡ P ⎤
+ --------------------------------------â–¡
+ "H1" : ⎡ P -∗ Q ⎤
+ "H3" : <affine> Φ
+ --------------------------------------∗
+ ⎡ Q ⎤
+
diff --git a/tests/mosel_paper.v b/tests/mosel_paper.v
new file mode 100644
index 0000000000000000000000000000000000000000..25211740a8f9c6cf244641c542422e59dbe31abe
--- /dev/null
+++ b/tests/mosel_paper.v
@@ -0,0 +1,53 @@
+(** This file contains the examples from the paper:
+
+MoSeL: A General, Extensible Modal Framework for Interactive Proofs in
+Separation Logic
+Robbert Krebbers, Jacques-Henri Jourdan, Ralf Jung, Joseph Tassarotti,
+Jan-Oliver Kaiser, Amin Timany, Arthur Charguéraud, Derek Dreyer
+ICFP 2018 *)
+From iris.proofmode Require Import tactics monpred.
+From iris.bi Require Import monpred.
+
+Lemma example_1 {PROP : bi} {A : Type} (P : PROP) (Φ Ψ : A → PROP) :
+ P ∗ (∃ a, Φ a ∨ Ψ a) -∗ ∃ a, (P ∗ Φ a) ∨ (P ∗ Ψ a).
+Proof.
+ iIntros "[HP H]". Show.
+ iDestruct "H" as (x) "[H1|H2]".
+ - Show. iExists x. iLeft. iSplitL "HP"; iAssumption.
+ - Show. iExists x. iRight. iSplitL "HP"; iAssumption.
+Qed.
+Lemma example {PROP : bi} {A : Type} (P : PROP) (Φ Ψ : A → PROP) :
+P ∗ (∃ a, Φ a ∨ Ψ a) -∗ ∃ a, (P ∗ Φ a) ∨ (P ∗ Ψ a).
+Proof.
+ iIntros "[HP H]". Show.
+ iFrame "HP". Show.
+ iAssumption.
+Qed.
+
+Lemma example_2 {PROP : bi} {A : Type} (P : PROP) (Φ Ψ : A → PROP) :
+ <affine> P ∗ (∃ a, Φ a ∨ Ψ a) -∗ ∃ a, Φ a ∨ (P ∗ Ψ a).
+Proof.
+ iIntros "[HP H]". iDestruct "H" as (x) "[H1|H2]".
+ - iExists x. iLeft. Show. iAssumption.
+ - iExists x. iRight. Show. iSplitL "HP"; iAssumption.
+Qed.
+
+Lemma example_3 {PROP : bi} {A : Type} (P : PROP) (Φ Ψ : A → PROP) :
+ □ P ∗ (∃ a, Φ a ∨ Ψ a) -∗ ∃ a, Φ a ∨ (P ∗ P ∗ Ψ a).
+Proof.
+ iIntros "[#HP H]". Show. iDestruct "H" as (x) "[H1|H2]".
+ - iExists x. iLeft. iAssumption.
+ - iExists x. iRight. Show. iSplitR; [|iSplitR]; iAssumption.
+Qed.
+Lemma example_4 {PROP : bi} {A : Type} (P Q : PROP) : □ P ∧ □ Q -∗ □ (P ∗ Q).
+Proof. iIntros "[#HP #HQ]". Show. iModIntro. iSplitL; iAssumption. Qed.
+
+Lemma example_monpred {I PROP} (Φ Ψ : monPred I PROP) : Φ ∗ (Φ -∗ Ψ) ⊢ Ψ.
+Proof. iIntros "[H1 H2]". Show. iApply "H2". iAssumption. Qed.
+
+Lemma example_monpred_model {I PROP} (Φ Ψ : monPred I PROP) : Φ ∗ (Φ -∗ Ψ) ⊢ Ψ.
+Proof. iStartProof PROP. Show. iIntros (i) "[H1 H2]". iApply "H2". iAssumption. Qed.
+
+Lemma example_monpred_2 {I PROP} (Φ : monPred I PROP) (P Q : PROP) :
+ ⎡ P -∗ Q ⎤ -∗ ⎡ □ P ⎤ -∗ <affine> Φ -∗ ⎡ P ∗ Q ⎤.
+Proof. iIntros "H1 #H2 H3". Show. iFrame "H2". Show. iApply "H1". iAssumption. Qed.
diff --git a/tests/one_shot.ref b/tests/one_shot.ref
new file mode 100644
index 0000000000000000000000000000000000000000..a64d6fb6cb8b67a93f76fc9b6cd42a6ee8490614
--- /dev/null
+++ b/tests/one_shot.ref
@@ -0,0 +1,42 @@
+1 subgoal
+
+ Σ : gFunctors
+ heapG0 : heapG Σ
+ one_shotG0 : one_shotG Σ
+ Φ : val → iProp Σ
+ N : namespace
+ l : loc
+ γ : gname
+ ============================
+ "HN" : inv N (one_shot_inv γ l)
+ --------------------------------------â–¡
+ "Hl" : l ↦ InjLV #()
+ _ : own γ Pending
+ --------------------------------------∗
+ one_shot_inv γ l
+ ∗ (⌜InjLV #() = InjLV #()âŒ
+ ∨ (∃ n : Z, ⌜InjLV #() = InjRV #n⌠∗ own γ (Shot n)))
+
+1 subgoal
+
+ Σ : gFunctors
+ heapG0 : heapG Σ
+ one_shotG0 : one_shotG Σ
+ Φ : val → iProp Σ
+ N : namespace
+ l : loc
+ γ : gname
+ m, m' : Z
+ ============================
+ "HN" : inv N (one_shot_inv γ l)
+ "Hγ'" : own γ (Shot m)
+ --------------------------------------â–¡
+ "Hl" : l ↦ InjRV #m'
+ "Hγ" : own γ (Shot m')
+ --------------------------------------∗
+ |={⊤ ∖ ↑N}=> ▷ one_shot_inv γ l
+ ∗ WP match: InjR #m' with
+ InjL <> => assert: #false
+ | InjR "m" => assert: #m = "m"
+ end {{ _, True }}
+
diff --git a/theories/tests/one_shot.v b/tests/one_shot.v
similarity index 84%
rename from theories/tests/one_shot.v
rename to tests/one_shot.v
index 566f525801ab8e67eacf332228bbd2fb34ca33e2..79faa4fd39c5d4c55f2f0b1a82d9743133437877 100644
--- a/theories/tests/one_shot.v
+++ b/tests/one_shot.v
@@ -49,15 +49,15 @@ Proof.
{ iNext. iLeft. by iSplitL "Hl". }
iModIntro. iApply "Hf"; iSplit.
- iIntros (n) "!#". wp_let.
- iInv N as ">[[Hl Hγ]|H]" "Hclose"; last iDestruct "H" as (m) "[Hl Hγ]".
- + wp_cas_suc. iMod (own_update with "Hγ") as "Hγ".
+ iInv N as ">[[Hl Hγ]|H]"; last iDestruct "H" as (m) "[Hl Hγ]".
+ + iMod (own_update with "Hγ") as "Hγ".
{ by apply cmra_update_exclusive with (y:=Shot n). }
- iMod ("Hclose" with "[-]"); last eauto.
- iNext; iRight; iExists n; by iFrame.
- + wp_cas_fail. iMod ("Hclose" with "[-]"); last eauto.
+ wp_cas_suc. iSplitL; last eauto.
+ iModIntro. iNext; iRight; iExists n; by iFrame.
+ + wp_cas_fail. iSplitL; last eauto.
rewrite /one_shot_inv; eauto 10.
- iIntros "!# /=". wp_seq. wp_bind (! _)%E.
- iInv N as ">Hγ" "Hclose".
+ iInv N as ">Hγ".
iAssert (∃ v, l ↦ v ∗ ((⌜v = NONEV⌠∗ own γ Pending) ∨
∃ n : Z, ⌜v = SOMEV #n⌠∗ own γ (Shot n)))%I with "[Hγ]" as "Hv".
{ iDestruct "Hγ" as "[[Hl Hγ]|Hl]"; last iDestruct "Hl" as (m) "[Hl Hγ]".
@@ -67,20 +67,20 @@ Proof.
iAssert (one_shot_inv γ l ∗ (⌜v = NONEV⌠∨ ∃ n : Z,
⌜v = SOMEV #n⌠∗ own γ (Shot n)))%I with "[Hl Hv]" as "[Hinv #Hv]".
{ iDestruct "Hv" as "[[% ?]|Hv]"; last iDestruct "Hv" as (m) "[% ?]"; subst.
- + iSplit. iLeft; by iSplitL "Hl". eauto.
+ + Show. iSplit. iLeft; by iSplitL "Hl". eauto.
+ iSplit. iRight; iExists m; by iSplitL "Hl". eauto. }
- iMod ("Hclose" with "[Hinv]") as "_"; eauto; iModIntro.
- wp_let. iIntros "!#". wp_seq.
+ iSplitL "Hinv"; first by eauto.
+ iModIntro. wp_let. iIntros "!#". wp_seq.
iDestruct "Hv" as "[%|Hv]"; last iDestruct "Hv" as (m) "[% Hγ']"; subst.
{ by wp_match. }
wp_match. wp_bind (! _)%E.
- iInv N as ">[[Hl Hγ]|H]" "Hclose"; last iDestruct "H" as (m') "[Hl Hγ]".
+ iInv N as "[[Hl >Hγ]|H]"; last iDestruct "H" as (m') "[Hl Hγ]".
{ by iDestruct (own_valid_2 with "Hγ Hγ'") as %?. }
- wp_load.
+ wp_load. Show.
iDestruct (own_valid_2 with "Hγ Hγ'") as %?%agree_op_invL'; subst.
- iMod ("Hclose" with "[Hl]") as "_".
+ iModIntro. iSplitL "Hl".
{ iNext; iRight; by eauto. }
- iModIntro. wp_match. iApply wp_assert.
+ wp_match. iApply wp_assert.
wp_op. by case_bool_decide.
Qed.
diff --git a/tests/proofmode.ref b/tests/proofmode.ref
new file mode 100644
index 0000000000000000000000000000000000000000..61197930c830bbb5941f78dea7fd448dd8ede82d
--- /dev/null
+++ b/tests/proofmode.ref
@@ -0,0 +1,500 @@
+"demo_0"
+ : string
+1 subgoal
+
+ PROP : sbi
+ P, Q : PROP
+ ============================
+ "H2" : ∀ x : nat, ⌜x = 0⌠∨ ⌜x = 1âŒ
+ --------------------------------------â–¡
+ "H" : □ (P ∨ Q)
+ --------------------------------------∗
+ Q ∨ P
+
+1 subgoal
+
+ PROP : sbi
+ P, Q : PROP
+ ============================
+ "H2" : ∀ x : nat, ⌜x = 0⌠∨ ⌜x = 1âŒ
+ _ : P
+ --------------------------------------â–¡
+ Q ∨ P
+
+"test_iDestruct_and_emp"
+ : string
+1 subgoal
+
+ PROP : sbi
+ P, Q : PROP
+ Persistent0 : Persistent P
+ Persistent1 : Persistent Q
+ ============================
+ _ : P
+ _ : Q
+ --------------------------------------â–¡
+ <affine> (P ∗ Q)
+
+The command has indeed failed with message:
+Ltac call to "done" failed.
+No applicable tactic.
+The command has indeed failed with message:
+In nested Ltac calls to "iClear (constr)", "iElaborateSelPat" and
+"<iris.proofmode.ltac_tactics.iElaborateSelPat_go>", last call failed.
+Tactic failure: iElaborateSelPat: "HQ" not found.
+The command has indeed failed with message:
+In nested Ltac calls to "iClear (constr)", "iElaborateSelPat" and
+"<iris.proofmode.ltac_tactics.iElaborateSelPat_go>", last call failed.
+Tactic failure: iElaborateSelPat: "HQ" not found.
+The command has indeed failed with message:
+In nested Ltac calls to "iSpecialize (open_constr)",
+"iSpecializeCore (open_constr) as (constr)",
+"iSpecializeCore (open_constr) as (constr)",
+"iSpecializeCore (open_constr) with (open_constr) (open_constr) as (constr)",
+"iSpecializePat (open_constr) (constr)" and "iSpecializePat_go", last call
+failed.
+Tactic failure: iSpecialize: cannot instantiate (∀ _ : φ, P -∗ False)%I with
+P.
+The command has indeed failed with message:
+In nested Ltac calls to "iSpecialize (open_constr)",
+"iSpecializeCore (open_constr) as (constr)",
+"iSpecializeCore (open_constr) as (constr)",
+"iSpecializeCore (open_constr) with (open_constr) (open_constr) as (constr)",
+"iSpecializePat (open_constr) (constr)" and "iSpecializePat_go", last call
+failed.
+Tactic failure: iSpecialize: cannot instantiate (⌜φ⌠→ P -∗ False)%I with P.
+"test_iNext_plus_3"
+ : string
+1 subgoal
+
+ PROP : sbi
+ P, Q : PROP
+ n, m, k : nat
+ ============================
+ --------------------------------------∗
+ â–·^(S n + S m) emp
+
+"test_iFrame_later_1"
+ : string
+1 subgoal
+
+ PROP : sbi
+ P, Q : PROP
+ ============================
+ --------------------------------------∗
+ â–· emp
+
+"test_iFrame_later_2"
+ : string
+1 subgoal
+
+ PROP : sbi
+ P, Q : PROP
+ ============================
+ --------------------------------------∗
+ â–· emp
+
+The command has indeed failed with message:
+In nested Ltac calls to "iFrame (constr)",
+"<iris.proofmode.ltac_tactics.iFrame_go>" and
+"<iris.proofmode.ltac_tactics.iFrameHyp>", last call failed.
+Tactic failure: iFrame: cannot frame Q.
+"test_and_sep_affine_bi"
+ : string
+1 subgoal
+
+ PROP : sbi
+ H : BiAffine PROP
+ P, Q : PROP
+ ============================
+ _ : â–¡ P
+ _ : Q
+ --------------------------------------∗
+ â–¡ P
+
+"test_big_sepL_simpl"
+ : string
+1 subgoal
+
+ PROP : sbi
+ x : nat
+ l : list nat
+ P : PROP
+ ============================
+ "HP" : P
+ _ : [∗ list] y ∈ l, <affine> ⌜y = yâŒ
+ _ : [∗ list] y ∈ (x :: l), <affine> ⌜y = yâŒ
+ --------------------------------------∗
+ P
+
+1 subgoal
+
+ PROP : sbi
+ x : nat
+ l : list nat
+ P : PROP
+ ============================
+ "HP" : P
+ _ : [∗ list] y ∈ l, <affine> ⌜y = yâŒ
+ _ : <affine> ⌜x = x⌠∗ ([∗ list] y ∈ l, <affine> ⌜y = yâŒ)
+ --------------------------------------∗
+ P
+
+"test_big_sepL2_simpl"
+ : string
+1 subgoal
+
+ PROP : sbi
+ x1, x2 : nat
+ l1, l2 : list nat
+ P : PROP
+ ============================
+ "HP" : P
+ _ : [∗ list] y1;y2 ∈ [];l2, <affine> ⌜y1 = y2âŒ
+ _ : [∗ list] y1;y2 ∈ (x1 :: l1);((x2 :: l2) ++ l2), <affine> ⌜y1 = y2âŒ
+ --------------------------------------∗
+ P ∨ ([∗ list] _;_ ∈ (x1 :: l1);(x2 :: l2), True)
+
+1 subgoal
+
+ PROP : sbi
+ x1, x2 : nat
+ l1, l2 : list nat
+ P : PROP
+ ============================
+ "HP" : P
+ _ : [∗ list] y1;y2 ∈ [];l2, <affine> ⌜y1 = y2âŒ
+ _ : <affine> ⌜x1 = x2âŒ
+ ∗ ([∗ list] y1;y2 ∈ l1;(l2 ++ l2), <affine> ⌜y1 = y2âŒ)
+ --------------------------------------∗
+ P ∨ True ∗ ([∗ list] _;_ ∈ l1;l2, True)
+
+"test_big_sepL2_iDestruct"
+ : string
+1 subgoal
+
+ PROP : sbi
+ Φ : nat → nat → PROP
+ x1, x2 : nat
+ l1, l2 : list nat
+ ============================
+ _ : Φ x1 x2
+ _ : [∗ list] y1;y2 ∈ l1;l2, Φ y1 y2
+ --------------------------------------∗
+ <absorb> Φ x1 x2
+
+"test_reducing_after_iDestruct"
+ : string
+1 subgoal
+
+ PROP : sbi
+ ============================
+ "H" : â–¡ True
+ --------------------------------------∗
+ True
+
+"test_reducing_after_iApply"
+ : string
+1 subgoal
+
+ PROP : sbi
+ ============================
+ "H" : emp
+ --------------------------------------â–¡
+ â–¡ emp
+
+"test_reducing_after_iApply_late_evar"
+ : string
+1 subgoal
+
+ PROP : sbi
+ ============================
+ "H" : emp
+ --------------------------------------â–¡
+ â–¡ emp
+
+"test_wandM"
+ : string
+1 subgoal
+
+ PROP : sbi
+ mP : option PROP
+ Q, R : PROP
+ ============================
+ "HPQ" : mP -∗? Q
+ "HQR" : Q -∗ R
+ "HP" : default emp mP
+ --------------------------------------∗
+ R
+
+1 subgoal
+
+ PROP : sbi
+ mP : option PROP
+ Q, R : PROP
+ ============================
+ "HP" : default emp mP
+ --------------------------------------∗
+ default emp mP
+
+"elim_mod_accessor"
+ : string
+1 subgoal
+
+ PROP : sbi
+ BiFUpd0 : BiFUpd PROP
+ X : Type
+ E1, E2 : coPset.coPset
+ α : X → PROP
+ β : X → PROP
+ γ : X → option PROP
+ ============================
+ "Hacc" : ∃ x : X, α x ∗ (β x ={E2,E1}=∗ default emp (γ x))
+ --------------------------------------∗
+ |={E2,E1}=> True
+
+"print_long_line_1"
+ : string
+1 subgoal
+
+ PROP : sbi
+ BiFUpd0 : BiFUpd PROP
+ P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P : PROP
+ ============================
+ "HP" : P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P
+ ∗ P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P
+ --------------------------------------∗
+ True
+
+1 subgoal
+
+ PROP : sbi
+ BiFUpd0 : BiFUpd PROP
+ P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P : PROP
+ ============================
+ _ : P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P
+ ∗ P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P
+ --------------------------------------∗
+ True
+
+"print_long_line_2"
+ : string
+1 subgoal
+
+ PROP : sbi
+ BiFUpd0 : BiFUpd PROP
+ P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P : PROP
+ ============================
+ "HP" : TESTNOTATION {{ P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P |
+ P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P }}
+ --------------------------------------∗
+ True
+
+1 subgoal
+
+ PROP : sbi
+ BiFUpd0 : BiFUpd PROP
+ P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P : PROP
+ ============================
+ _ : TESTNOTATION {{ P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P |
+ P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P }}
+ --------------------------------------∗
+ True
+
+"long_impl"
+ : string
+1 subgoal
+
+ PROP : sbi
+ BiFUpd0 : BiFUpd PROP
+ PPPPPPPPPPPPPPPPP, QQQQQQQQQQQQQQQQQQ : PROP
+ ============================
+ --------------------------------------∗
+ PPPPPPPPPPPPPPPPP
+ → QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ
+
+"long_impl_nested"
+ : string
+1 subgoal
+
+ PROP : sbi
+ BiFUpd0 : BiFUpd PROP
+ PPPPPPPPPPPPPPPPP, QQQQQQQQQQQQQQQQQQ : PROP
+ ============================
+ --------------------------------------∗
+ PPPPPPPPPPPPPPPPP
+ → QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ
+ → QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ
+
+"long_wand"
+ : string
+1 subgoal
+
+ PROP : sbi
+ BiFUpd0 : BiFUpd PROP
+ PPPPPPPPPPPPPPPPP, QQQQQQQQQQQQQQQQQQ : PROP
+ ============================
+ --------------------------------------∗
+ PPPPPPPPPPPPPPPPP
+ -∗ QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ
+
+"long_wand_nested"
+ : string
+1 subgoal
+
+ PROP : sbi
+ BiFUpd0 : BiFUpd PROP
+ PPPPPPPPPPPPPPPPP, QQQQQQQQQQQQQQQQQQ : PROP
+ ============================
+ --------------------------------------∗
+ PPPPPPPPPPPPPPPPP
+ -∗ QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ
+ -∗ QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ
+
+"long_fupd"
+ : string
+1 subgoal
+
+ PROP : sbi
+ BiFUpd0 : BiFUpd PROP
+ E : coPset.coPset
+ PPPPPPPPPPPPPPPPP, QQQQQQQQQQQQQQQQQQ : PROP
+ ============================
+ --------------------------------------∗
+ PPPPPPPPPPPPPPPPP
+ ={E}=∗ QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ
+
+"long_fupd_nested"
+ : string
+1 subgoal
+
+ PROP : sbi
+ BiFUpd0 : BiFUpd PROP
+ E1, E2 : coPset.coPset
+ PPPPPPPPPPPPPPPPP, QQQQQQQQQQQQQQQQQQ : PROP
+ ============================
+ --------------------------------------∗
+ PPPPPPPPPPPPPPPPP
+ ={E1,E2}=∗ QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ
+ ={E1,E2}=∗ QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ
+
+"iAlways_spatial_non_empty"
+ : string
+The command has indeed failed with message:
+In nested Ltac calls to "iAlways", "iModIntro" and
+"iModIntro (uconstr)", last call failed.
+Tactic failure: iModIntro: spatial context is non-empty.
+"iDestruct_bad_name"
+ : string
+The command has indeed failed with message:
+In nested Ltac calls to "iDestruct (open_constr) as (constr)",
+"iDestructCore (open_constr) as (constr) (tactic)" and
+"iDestructCore (open_constr) as (constr) (tactic)", last call failed.
+Tactic failure: iDestruct: "HQ" not found.
+"iIntros_dup_name"
+ : string
+The command has indeed failed with message:
+In nested Ltac calls to "iIntros (constr)", "iIntros_go" and
+"iIntro (constr)", last call failed.
+Tactic failure: iIntro: "HP" not fresh.
+The command has indeed failed with message:
+In nested Ltac calls to "iIntros ( (intropattern) )",
+"iIntro ( (intropattern) )" and "intros x", last call failed.
+x is already used.
+"iSplit_one_of_many"
+ : string
+The command has indeed failed with message:
+Ltac call to "iSplitL (constr)" failed.
+Tactic failure: iSplitL: hypotheses ["HPx"] not found.
+The command has indeed failed with message:
+Ltac call to "iSplitL (constr)" failed.
+Tactic failure: iSplitL: hypotheses ["HPx"] not found.
+"iExact_fail"
+ : string
+The command has indeed failed with message:
+Ltac call to "iExact (constr)" failed.
+Tactic failure: iExact: "HQ" not found.
+The command has indeed failed with message:
+Ltac call to "iExact (constr)" failed.
+Tactic failure: iExact: "HQ" : Q does not match goal.
+The command has indeed failed with message:
+Ltac call to "iExact (constr)" failed.
+Tactic failure: iExact: "HP"
+not absorbing and the remaining hypotheses not affine.
+"iClear_fail"
+ : string
+The command has indeed failed with message:
+In nested Ltac calls to "iClear (constr)", "iElaborateSelPat" and
+"<iris.proofmode.ltac_tactics.iElaborateSelPat_go>", last call failed.
+Tactic failure: iElaborateSelPat: "HP" not found.
+The command has indeed failed with message:
+In nested Ltac calls to "iClear (constr)",
+"<iris.proofmode.ltac_tactics.iClear_go>" and
+"<iris.proofmode.ltac_tactics.iClearHyp>", last call failed.
+Tactic failure: iClear: "HP" : P not affine and the goal not absorbing.
+"iSpecializeArgs_fail"
+ : string
+The command has indeed failed with message:
+In nested Ltac calls to "iSpecialize (open_constr)",
+"iSpecializeCore (open_constr) as (constr)",
+"iSpecializeCore (open_constr) as (constr)",
+"iSpecializeCore (open_constr) with (open_constr) (open_constr) as (constr)",
+"iSpecializeArgs (constr) (open_constr)",
+"<iris.proofmode.ltac_tactics.iSpecializeArgs_go>" and
+"notypeclasses refine (uconstr)", last call failed.
+In environment
+PROP : sbi
+P : PROP
+The term "true" has type "bool" while it is expected to have type "nat".
+"iStartProof_fail"
+ : string
+The command has indeed failed with message:
+In nested Ltac calls to "iStartProof" and "iStartProof", last call failed.
+Tactic failure: iStartProof: not a BI assertion.
+"iPoseProof_fail"
+ : string
+The command has indeed failed with message:
+In nested Ltac calls to "iPoseProof (open_constr) as (constr)" and
+"iPoseProofCore (open_constr) as (constr) (constr) (tactic)", last call
+failed.
+Tactic failure: iPoseProof: not a BI assertion.
+The command has indeed failed with message:
+In nested Ltac calls to "iPoseProof (open_constr) as (constr)" and
+"iPoseProofCore (open_constr) as (constr) (constr) (tactic)", last call
+failed.
+Tactic failure: iRename: "H" not fresh.
+"iRevert_fail"
+ : string
+The command has indeed failed with message:
+In nested Ltac calls to "iRevert (constr)", "iElaborateSelPat" and
+"<iris.proofmode.ltac_tactics.iElaborateSelPat_go>", last call failed.
+Tactic failure: iElaborateSelPat: "H" not found.
+"iDestruct_fail"
+ : string
+The command has indeed failed with message:
+In nested Ltac calls to "iDestruct (open_constr) as (constr)",
+"iDestructCore (open_constr) as (constr) (tactic)",
+"iDestructCore (open_constr) as (constr) (tactic)" and
+"iDestructCore (open_constr) as (constr) (tactic)", last call failed.
+Tactic failure: iDestruct: "{HP}"
+should contain exactly one proper introduction pattern.
+The command has indeed failed with message:
+In nested Ltac calls to "iDestruct (open_constr) as (constr)",
+"iDestructCore (open_constr) as (constr) (tactic)",
+"iDestructCore (open_constr) as (constr) (tactic)" and
+"iDestructCore (open_constr) as (constr) (tactic)", last call failed.
+Tactic failure: iDestruct: (IList [[IClear (sel_patterns.SelIdent "HP")]])
+invalid.
+"iApply_fail"
+ : string
+The command has indeed failed with message:
+In nested Ltac calls to "iApply (open_constr)",
+"iPoseProofCore (open_constr) as (constr) (constr) (tactic)",
+"<iris.proofmode.ltac_tactics.iPoseProofCore_go>",
+"<iris.proofmode.ltac_tactics.iPoseProofCore_go>",
+"<iris.proofmode.ltac_tactics.iPoseProofCore_go>",
+"goal_tac" (bound to
+fun _ => <ssreflect_plugin::ssrtclseq@0> spec_tac ltac:(()) ; last tac Htmp) and
+"<ssreflect_plugin::ssrtclseq@0> spec_tac ltac:(()) ; last tac Htmp", last
+call failed.
+Tactic failure: iApply: cannot apply P.
diff --git a/tests/proofmode.v b/tests/proofmode.v
new file mode 100644
index 0000000000000000000000000000000000000000..462866768bc8e1251b85212b4bd8dccdd2707953
--- /dev/null
+++ b/tests/proofmode.v
@@ -0,0 +1,726 @@
+From iris.proofmode Require Import tactics intro_patterns.
+From stdpp Require Import gmap hlist.
+Set Default Proof Using "Type".
+
+Section tests.
+Context {PROP : sbi}.
+Implicit Types P Q R : PROP.
+
+Check "demo_0".
+Lemma demo_0 P Q : â–¡ (P ∨ Q) -∗ (∀ x, ⌜x = 0⌠∨ ⌜x = 1âŒ) → (Q ∨ P).
+Proof.
+ iIntros "H #H2". Show. iDestruct "H" as "###H".
+ (* should remove the disjunction "H" *)
+ iDestruct "H" as "[#?|#?]"; last by iLeft. Show.
+ (* should keep the disjunction "H" because it is instantiated *)
+ iDestruct ("H2" $! 10) as "[%|%]". done. done.
+Qed.
+
+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).
+Proof.
+ (* Intro-patterns do something :) *)
+ iIntros "[H2 ([H3 HQ]&?&H1&H2'&foo&_)] ? [??]".
+ (* To test destruct: can also be part of the intro-pattern *)
+ iDestruct "foo" as "[_ meh]".
+ repeat iSplit; [|by iLeft|iIntros "#[]"].
+ iFrame "H2".
+ (* split takes a list of hypotheses just for the LHS *)
+ iSplitL "H3".
+ - 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 "($ & $ & $)". iNext. by iExists 0. Qed.
+
+Definition foo (P : PROP) := (P -∗ P)%I.
+Definition bar : PROP := (∀ P, foo P)%I.
+
+Lemma test_unfold_constants : bar.
+Proof. iIntros (P) "HP //". Qed.
+
+Lemma test_iRewrite {A : ofeT} (x y : A) P :
+ □ (∀ z, P -∗ <affine> (z ≡ y)) -∗ (P -∗ P ∧ (x,x) ≡ (y,x)).
+Proof.
+ iIntros "#H1 H2".
+ iRewrite (bi.internal_eq_sym x x with "[# //]").
+ iRewrite -("H1" $! _ with "[- //]").
+ auto.
+Qed.
+
+Check "test_iDestruct_and_emp".
+Lemma test_iDestruct_and_emp P Q `{!Persistent P, !Persistent Q} :
+ P ∧ emp -∗ emp ∧ Q -∗ <affine> (P ∗ Q).
+Proof. iIntros "[#? _] [_ #?]". Show. auto. Qed.
+
+Lemma test_iIntros_persistent P Q `{!Persistent Q} : (P → Q → P ∧ Q)%I.
+Proof. iIntros "H1 #H2". by iFrame "∗#". Qed.
+
+Lemma test_iIntros_pure (ψ φ : Prop) P : ψ → (⌜ φ ⌠→ P → ⌜ φ ∧ ψ ⌠∧ P)%I.
+Proof. iIntros (??) "H". auto. Qed.
+
+Lemma test_iIntros_pure_not : (⌜ ¬False ⌠: PROP)%I.
+Proof. by iIntros (?). Qed.
+
+Lemma test_fast_iIntros P Q :
+ (∀ x y z : nat,
+ ⌜x = plus 0 x⌠→ ⌜y = 0⌠→ ⌜z = 0⌠→ P → □ Q → foo (x ≡ x))%I.
+Proof.
+ iIntros (a) "*".
+ iIntros "#Hfoo **".
+ iIntros "_ //".
+Qed.
+
+Lemma test_very_fast_iIntros P :
+ ∀ x y : nat, (⌜ x = y ⌠→ P -∗ P)%I.
+Proof. by iIntros. Qed.
+
+(** Prior to 0b84351c this used to loop, now `iAssumption` instantiates `R` with
+`False` and performs false elimination. *)
+Lemma test_iAssumption_evar_ex_false : ∃ R, R ⊢ ∀ P, P.
+Proof. eexists. iIntros "?" (P). iAssumption. Qed.
+
+Lemma test_iAssumption_affine P Q R `{!Affine P, !Affine R} : P -∗ Q -∗ R -∗ Q.
+Proof. iIntros "H1 H2 H3". iAssumption. Qed.
+
+Lemma test_done_goal_evar Q : ∃ P, Q ⊢ P.
+Proof. eexists. iIntros "H". Fail done. iAssumption. Qed.
+
+Lemma test_iDestruct_spatial_and P Q1 Q2 : P ∗ (Q1 ∧ Q2) -∗ P ∗ Q1.
+Proof. iIntros "[H [? _]]". by iFrame. Qed.
+
+Lemma test_iAssert_persistent P Q : P -∗ Q -∗ True.
+Proof.
+ iIntros "HP HQ".
+ iAssert True%I as "#_". { by iClear "HP HQ". }
+ iAssert True%I with "[HP]" as "#_". { Fail iClear "HQ". by iClear "HP". }
+ iAssert True%I as %_. { by iClear "HP HQ". }
+ iAssert True%I with "[HP]" as %_. { Fail iClear "HQ". by iClear "HP". }
+ done.
+Qed.
+
+Lemma test_iAssert_persistently P : □ P -∗ True.
+Proof.
+ iIntros "HP". iAssert (â–¡ P)%I with "[# //]" as "#H". done.
+Qed.
+
+Lemma test_iSpecialize_auto_frame P Q R :
+ (P -∗ True -∗ True -∗ Q -∗ R) -∗ P -∗ Q -∗ R.
+Proof. iIntros "H ? HQ". by iApply ("H" with "[$]"). Qed.
+
+Lemma test_iSpecialize_pure (φ : Prop) Q R:
+ φ → (⌜φ⌠-∗ Q) → Q.
+Proof. iIntros (HP HPQ). iDestruct (HPQ $! HP) as "?". done. Qed.
+
+Lemma test_iSpecialize_Coq_entailment P Q R :
+ P → (P -∗ Q) → Q.
+Proof. iIntros (HP HPQ). iDestruct (HPQ $! HP) as "?". done. Qed.
+
+Lemma test_iEmp_intro P Q R `{!Affine P, !Persistent Q, !Affine R} :
+ P -∗ Q → R -∗ emp.
+Proof. iIntros "HP #HQ HR". iEmpIntro. Qed.
+
+Lemma test_fresh P Q:
+ (P ∗ Q) -∗ (P ∗ Q).
+Proof.
+ iIntros "H".
+ let H1 := iFresh in
+ let H2 := iFresh in
+ let pat :=constr:(IList [cons (IIdent H1) (cons (IIdent H2) nil)]) in
+ iDestruct "H" as pat.
+ iFrame.
+Qed.
+
+(* Check coercions *)
+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.
+Proof. iExists {[ 1%positive ]}, ∅. auto. Qed.
+
+Lemma test_iSpecialize_tc P : (∀ x y z : gset positive, P) -∗ P.
+Proof.
+ iIntros "H".
+ (* FIXME: this [unshelve] and [apply _] should not be needed. *)
+ unshelve iSpecialize ("H" $! ∅ {[ 1%positive ]} ∅); try apply _. done.
+Qed.
+
+Lemma test_iFrame_pure {A : ofeT} (φ : Prop) (y z : A) :
+ φ → <affine> ⌜y ≡ z⌠-∗ (⌜ φ ⌠∧ ⌜ φ ⌠∧ y ≡ z : PROP).
+Proof. iIntros (Hv) "#Hxy". iFrame (Hv) "Hxy". Qed.
+
+Lemma test_iFrame_disjunction_1 P1 P2 Q1 Q2 :
+ BiAffine PROP →
+ □ P1 -∗ Q2 -∗ P2 -∗ (P1 ∗ P2 ∗ False ∨ P2) ∗ (Q1 ∨ Q2).
+Proof. intros ?. iIntros "#HP1 HQ2 HP2". iFrame "HP1 HQ2 HP2". Qed.
+Lemma test_iFrame_disjunction_2 P : P -∗ (True ∨ True) ∗ P.
+Proof. iIntros "HP". iFrame "HP". auto. Qed.
+
+Lemma test_iFrame_conjunction_1 P Q :
+ P -∗ Q -∗ (P ∗ Q) ∧ (P ∗ Q).
+Proof. iIntros "HP HQ". iFrame "HP HQ". Qed.
+Lemma test_iFrame_conjunction_2 P Q :
+ P -∗ Q -∗ (P ∧ P) ∗ (Q ∧ Q).
+Proof. iIntros "HP HQ". iFrame "HP HQ". Qed.
+
+Lemma test_iFrame_later `{BiAffine PROP} P Q : P -∗ Q -∗ ▷ P ∗ Q.
+Proof. iIntros "H1 H2". by iFrame "H1". Qed.
+
+Lemma test_iAssert_modality P : ◇ False -∗ ▷ P.
+Proof.
+ iIntros "HF".
+ iAssert (<affine> False)%I with "[> -]" as %[].
+ by iMod "HF".
+Qed.
+
+Lemma test_iMod_affinely_timeless P `{!Timeless P} :
+ <affine> ▷ P -∗ ◇ <affine> P.
+Proof. iIntros "H". iMod "H". done. 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 → PROP) :
+ (∀ n v, P n v) -∗ ∃ n v, P n v.
+Proof.
+ iIntros "H". iExists _, [#10].
+ iSpecialize ("H" $! _ [#10]). done.
+Qed.
+
+(* Check that typeclasses are not resolved too early *)
+Lemma test_TC_resolution `{!BiAffine PROP} (Φ : nat → PROP) l x :
+ x ∈ l → ([∗ list] y ∈ l, Φ y) -∗ Φ x.
+Proof.
+ iIntros (Hp) "HT".
+ iDestruct (big_sepL_elem_of _ _ _ Hp with "HT") as "Hp".
+ done.
+Qed.
+
+Lemma test_eauto_iFrame P Q R `{!Persistent R} :
+ P -∗ Q -∗ R → R ∗ Q ∗ P ∗ R ∨ False.
+Proof. eauto 10 with iFrame. Qed.
+
+Lemma test_iCombine_persistent P Q R `{!Persistent R} :
+ P -∗ Q -∗ R → R ∗ Q ∗ P ∗ R ∨ False.
+Proof. iIntros "HP HQ #HR". iCombine "HR HQ HP HR" as "H". auto. Qed.
+
+Lemma test_iCombine_frame P Q R `{!Persistent R} :
+ P -∗ Q -∗ R → R ∗ Q ∗ P ∗ R.
+Proof. iIntros "HP HQ #HR". iCombine "HQ HP HR" as "$". by iFrame. Qed.
+
+Lemma test_iNext_evar P : P -∗ True.
+Proof.
+ iIntros "HP". iAssert (▷ _ -∗ ▷ P)%I as "?"; last done.
+ iIntros "?". iNext. iAssumption.
+Qed.
+
+Lemma test_iNext_sep1 P Q (R1 := (P ∗ Q)%I) :
+ (▷ P ∗ ▷ Q) ∗ R1 -∗ ▷ ((P ∗ Q) ∗ R1).
+Proof.
+ iIntros "H". iNext.
+ rewrite {1 2}(lock R1). (* check whether R1 has not been unfolded *) done.
+Qed.
+
+Lemma test_iNext_sep2 P Q : ▷ P ∗ ▷ Q -∗ ▷ (P ∗ Q).
+Proof.
+ iIntros "H". iNext. iExact "H". (* Check that the laters are all gone. *)
+Qed.
+
+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 : PROP) :
+ □ P -∗ Q -∗ <pers> (P ∗ P) ∗ (P ∗ Q ∨ Q).
+Proof. iIntros "#HP". iFrame "HP". iIntros "$". Qed.
+
+Lemma test_iSplit_persistently P Q : □ P -∗ <pers> (P ∗ P).
+Proof. iIntros "#?". by iSplit. Qed.
+
+Lemma test_iSpecialize_persistent P Q : □ P -∗ (<pers> P → Q) -∗ Q.
+Proof. iIntros "#HP HPQ". by iSpecialize ("HPQ" with "HP"). Qed.
+
+Lemma test_iDestruct_persistent P (Φ : nat → PROP) `{!∀ x, Persistent (Φ x)}:
+ □ (P -∗ ∃ x, Φ x) -∗
+ P -∗ ∃ x, Φ x ∗ P.
+Proof.
+ iIntros "#H HP". iDestruct ("H" with "HP") as (x) "#H2". eauto with iFrame.
+Qed.
+
+Lemma test_iLöb P : (∃ n, ▷^n P)%I.
+Proof.
+ iLöb as "IH". iDestruct "IH" as (n) "IH".
+ by iExists (S n).
+Qed.
+
+Lemma test_iInduction_wf (x : nat) P Q :
+ â–¡ P -∗ Q -∗ ⌜ (x + 0 = x)%nat âŒ.
+Proof.
+ iIntros "#HP HQ".
+ iInduction (lt_wf x) as [[|x] _] "IH"; simpl; first done.
+ rewrite (inj_iff S). by iApply ("IH" with "[%]"); first omega.
+Qed.
+
+Lemma test_iIntros_start_proof :
+ (True : PROP)%I.
+Proof.
+ (* Make sure iIntros actually makes progress and enters the proofmode. *)
+ progress iIntros. done.
+Qed.
+
+Lemma test_True_intros : (True : PROP) -∗ True.
+Proof.
+ iIntros "?". done.
+Qed.
+
+Lemma test_iPoseProof_let P Q :
+ (let R := True%I in R ∗ P ⊢ Q) →
+ P ⊢ Q.
+Proof.
+ iIntros (help) "HP".
+ iPoseProof (help with "[$HP]") as "?". done.
+Qed.
+
+Lemma test_iIntros_let P :
+ ∀ Q, let R := emp%I in P -∗ R -∗ Q -∗ P ∗ Q.
+Proof. iIntros (Q R) "$ _ $". Qed.
+
+Lemma test_foo P Q : <affine> ▷ (Q ≡ P) -∗ <affine> ▷ Q -∗ <affine> ▷ P.
+Proof.
+ iIntros "#HPQ HQ !#". iNext. by iRewrite "HPQ" in "HQ".
+Qed.
+
+Lemma test_iIntros_modalities `(!Absorbing P) :
+ (<pers> (▷ ∀ 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.
+
+Lemma test_iIntros_rewrite P (x1 x2 x3 x4 : nat) :
+ x1 = x2 → (⌜ x2 = x3 ⌠∗ ⌜ x3 ≡ x4 ⌠∗ P) -∗ ⌜ x1 = x4 ⌠∗ P.
+Proof. iIntros (?) "(-> & -> & $)"; auto. Qed.
+
+Lemma test_iNext_affine P Q : <affine> ▷ (Q ≡ P) -∗ <affine> ▷ Q -∗ <affine> ▷ P.
+Proof. iIntros "#HPQ HQ !#". iNext. by iRewrite "HPQ" in "HQ". Qed.
+
+Lemma test_iAlways P Q R :
+ □ P -∗ <pers> Q → R -∗ <pers> <affine> <affine> P ∗ □ Q.
+Proof. iIntros "#HP #HQ HR". iSplitL. iAlways. done. iAlways. done. Qed.
+
+(* A bunch of test cases from #127 to establish that tactics behave the same on
+`⌜ φ ⌠→ P` and `∀ _ : φ, P` *)
+Lemma test_forall_nondep_1 (φ : Prop) :
+ φ → (∀ _ : φ, False : PROP) -∗ False.
+Proof. iIntros (Hφ) "Hφ". by iApply "Hφ". Qed.
+Lemma test_forall_nondep_2 (φ : Prop) :
+ φ → (∀ _ : φ, False : PROP) -∗ False.
+Proof. iIntros (Hφ) "Hφ". iSpecialize ("Hφ" with "[% //]"). done. Qed.
+Lemma test_forall_nondep_3 (φ : Prop) :
+ φ → (∀ _ : φ, False : PROP) -∗ False.
+Proof. iIntros (Hφ) "Hφ". unshelve iSpecialize ("Hφ" $! _). done. done. Qed.
+Lemma test_forall_nondep_4 (φ : Prop) :
+ φ → (∀ _ : φ, False : PROP) -∗ False.
+Proof. iIntros (Hφ) "Hφ". iSpecialize ("Hφ" $! Hφ); done. Qed.
+
+Lemma test_pure_impl_1 (φ : Prop) :
+ φ → (⌜φ⌠→ False : PROP) -∗ False.
+Proof. iIntros (Hφ) "Hφ". by iApply "Hφ". Qed.
+Lemma test_pure_impl_2 (φ : Prop) :
+ φ → (⌜φ⌠→ False : PROP) -∗ False.
+Proof. iIntros (Hφ) "Hφ". iSpecialize ("Hφ" with "[% //]"). done. Qed.
+Lemma test_pure_impl_3 (φ : Prop) :
+ φ → (⌜φ⌠→ False : PROP) -∗ False.
+Proof. iIntros (Hφ) "Hφ". unshelve iSpecialize ("Hφ" $! _). done. done. Qed.
+Lemma test_pure_impl_4 (φ : Prop) :
+ φ → (⌜φ⌠→ False : PROP) -∗ False.
+Proof. iIntros (Hφ) "Hφ". iSpecialize ("Hφ" $! Hφ). done. Qed.
+
+Lemma test_forall_nondep_impl2 (φ : Prop) P :
+ φ → P -∗ (∀ _ : φ, P -∗ False : PROP) -∗ False.
+Proof.
+ iIntros (Hφ) "HP Hφ".
+ Fail iSpecialize ("Hφ" with "HP").
+ iSpecialize ("Hφ" with "[% //] HP"). done.
+Qed.
+
+Lemma test_pure_impl2 (φ : Prop) P :
+ φ → P -∗ (⌜φ⌠→ P -∗ False : PROP) -∗ False.
+Proof.
+ iIntros (Hφ) "HP Hφ".
+ Fail iSpecialize ("Hφ" with "HP").
+ iSpecialize ("Hφ" with "[% //] HP"). done.
+Qed.
+
+Lemma test_iNext_laterN_later P n : ▷ ▷^n P -∗ ▷^n ▷ P.
+Proof. iIntros "H". iNext. by iNext. Qed.
+Lemma test_iNext_later_laterN P n : ▷^n ▷ P -∗ ▷ ▷^n P.
+Proof. iIntros "H". iNext. by iNext. Qed.
+Lemma test_iNext_plus_1 P n1 n2 : ▷ ▷^n1 ▷^n2 P -∗ ▷^n1 ▷^n2 ▷ P.
+Proof. iIntros "H". iNext. iNext. by iNext. Qed.
+Lemma test_iNext_plus_2 P n m : ▷^n ▷^m P -∗ ▷^(n+m) P.
+Proof. iIntros "H". iNext. done. Qed.
+Check "test_iNext_plus_3".
+Lemma test_iNext_plus_3 P Q n m k :
+ ▷^m ▷^(2 + S n + k) P -∗ ▷^m ▷ ▷^(2 + S n) Q -∗ ▷^k ▷ ▷^(S (S n + S m)) (P ∗ Q).
+Proof. iIntros "H1 H2". iNext. iNext. iNext. iFrame. Show. iModIntro. done. Qed.
+
+Lemma test_iNext_unfold P Q n m (R := (â–·^n P)%I) :
+ R ⊢ ▷^m True.
+Proof.
+ iIntros "HR". iNext.
+ match goal with |- context [ R ] => idtac | |- _ => fail end.
+ done.
+Qed.
+
+Lemma test_iNext_fail P Q a b c d e f g h i j:
+ ▷^(a + b) ▷^(c + d + e) P -∗ ▷^(f + g + h + i + j) True.
+Proof. iIntros "H". iNext. done. Qed.
+
+Lemma test_specialize_affine_pure (φ : Prop) P :
+ φ → (<affine> ⌜φ⌠-∗ P) ⊢ P.
+Proof.
+ iIntros (Hφ) "H". by iSpecialize ("H" with "[% //]").
+Qed.
+
+Lemma test_assert_affine_pure (φ : Prop) P :
+ φ → P ⊢ P ∗ <affine> ⌜φâŒ.
+Proof. iIntros (Hφ). iAssert (<affine> ⌜φâŒ)%I with "[%]" as "$"; auto. Qed.
+Lemma test_assert_pure (φ : Prop) P :
+ φ → P ⊢ P ∗ ⌜φâŒ.
+Proof. iIntros (Hφ). iAssert ⌜φâŒ%I with "[%]" as "$"; auto with iFrame. Qed.
+
+Lemma test_iEval x y : ⌜ (y + x)%nat = 1 ⌠-∗ ⌜ S (x + y) = 2%nat ⌠: PROP.
+Proof.
+ iIntros (H).
+ iEval (rewrite (Nat.add_comm x y) // H).
+ done.
+Qed.
+
+Lemma test_iIntros_pure_neg : (⌜ ¬False ⌠: PROP)%I.
+Proof. by iIntros (?). Qed.
+
+Lemma test_iPureIntro_absorbing (φ : Prop) :
+ φ → sbi_emp_valid (PROP:=PROP) (<absorb> ⌜φâŒ)%I.
+Proof. intros ?. iPureIntro. done. Qed.
+
+Check "test_iFrame_later_1".
+Lemma test_iFrame_later_1 P Q : P ∗ ▷ Q -∗ ▷ (P ∗ ▷ Q).
+Proof. iIntros "H". iFrame "H". Show. auto. Qed.
+
+Check "test_iFrame_later_2".
+Lemma test_iFrame_later_2 P Q : ▷ P ∗ ▷ Q -∗ ▷ (▷ P ∗ ▷ Q).
+Proof. iIntros "H". iFrame "H". Show. auto. Qed.
+
+Lemma test_with_ident P Q R : P -∗ Q -∗ (P -∗ Q -∗ R) -∗ R.
+Proof.
+ iIntros "? HQ H".
+ iMatchHyp (fun H _ =>
+ iApply ("H" with [spec_patterns.SIdent H; spec_patterns.SIdent "HQ"])).
+Qed.
+
+Lemma iFrame_with_evar_r P Q :
+ ∃ R, (P -∗ Q -∗ P ∗ R) ∧ R = Q.
+Proof.
+ eexists. split. iIntros "HP HQ". iFrame. iApply "HQ". done.
+Qed.
+Lemma iFrame_with_evar_l P Q :
+ ∃ R, (P -∗ Q -∗ R ∗ P) ∧ R = Q.
+Proof.
+ eexists. split. iIntros "HP HQ". Fail iFrame "HQ".
+ iSplitR "HP"; iAssumption. done.
+Qed.
+Lemma iFrame_with_evar_persistent P Q :
+ ∃ R, (P -∗ □ Q -∗ P ∗ R ∗ Q) ∧ R = emp%I.
+Proof.
+ eexists. split. iIntros "HP #HQ". iFrame "HQ HP". iEmpIntro. done.
+Qed.
+
+Lemma test_iAccu P Q R S :
+ ∃ PP, (□P -∗ Q -∗ R -∗ S -∗ PP) ∧ PP = (Q ∗ R ∗ S)%I.
+Proof.
+ eexists. split. iIntros "#? ? ? ?". iAccu. done.
+Qed.
+
+Lemma test_iAssumption_evar P : ∃ R, (R ⊢ P) ∧ R = P.
+Proof.
+ eexists. split.
+ - iIntros "H". iAssumption.
+ (* Now verify that the evar was chosen as desired (i.e., it should not pick False). *)
+ - reflexivity.
+Qed.
+
+Lemma test_iAssumption_False_no_loop : ∃ R, R ⊢ ∀ P, P.
+Proof. eexists. iIntros "?" (P). done. Qed.
+
+Lemma test_apply_affine_impl `{!BiPlainly PROP} (P : PROP) :
+ P -∗ (∀ Q : PROP, ■(Q -∗ <pers> Q) → ■(P -∗ Q) → Q).
+Proof. iIntros "HP" (Q) "_ #HPQ". by iApply "HPQ". Qed.
+
+Lemma test_apply_affine_wand `{!BiPlainly PROP} (P : PROP) :
+ P -∗ (∀ Q : PROP, <affine> ■(Q -∗ <pers> Q) -∗ <affine> ■(P -∗ Q) -∗ Q).
+Proof. iIntros "HP" (Q) "_ #HPQ". by iApply "HPQ". Qed.
+
+Lemma test_and_sep (P Q R : PROP) : P ∧ (Q ∗ □ R) ⊢ (P ∧ Q) ∗ □ R.
+Proof.
+ iIntros "H". repeat iSplit.
+ - iDestruct "H" as "[$ _]".
+ - iDestruct "H" as "[_ [$ _]]".
+ - iDestruct "H" as "[_ [_ #$]]".
+Qed.
+
+Lemma test_and_sep_2 (P Q R : PROP) `{!Persistent R, !Affine R} :
+ P ∧ (Q ∗ R) ⊢ (P ∧ Q) ∗ R.
+Proof.
+ iIntros "H". repeat iSplit.
+ - iDestruct "H" as "[$ _]".
+ - iDestruct "H" as "[_ [$ _]]".
+ - iDestruct "H" as "[_ [_ #$]]".
+Qed.
+
+Check "test_and_sep_affine_bi".
+Lemma test_and_sep_affine_bi `{BiAffine PROP} P Q : □ P ∧ Q ⊢ □ P ∗ Q.
+Proof.
+ iIntros "[??]". iSplit; last done. Show. done.
+Qed.
+
+Check "test_big_sepL_simpl".
+Lemma test_big_sepL_simpl x (l : list nat) P :
+ P -∗
+ ([∗ list] k↦y ∈ l, <affine> ⌜ y = y âŒ) -∗
+ ([∗ list] y ∈ x :: l, <affine> ⌜ y = y âŒ) -∗
+ P.
+Proof. iIntros "HP ??". Show. simpl. Show. done. Qed.
+
+Check "test_big_sepL2_simpl".
+Lemma test_big_sepL2_simpl x1 x2 (l1 l2 : list nat) P :
+ P -∗
+ ([∗ list] k↦y1;y2 ∈ []; l2, <affine> ⌜ y1 = y2 âŒ) -∗
+ ([∗ list] y1;y2 ∈ x1 :: l1; (x2 :: l2) ++ l2, <affine> ⌜ y1 = y2 âŒ) -∗
+ P ∨ ([∗ list] y1;y2 ∈ x1 :: l1; x2 :: l2, True).
+Proof. iIntros "HP ??". Show. simpl. Show. by iLeft. Qed.
+
+Check "test_big_sepL2_iDestruct".
+Lemma test_big_sepL2_iDestruct (Φ : nat → nat → PROP) x1 x2 (l1 l2 : list nat) :
+ ([∗ list] y1;y2 ∈ x1 :: l1; x2 :: l2, Φ y1 y2) -∗
+ <absorb> Φ x1 x2.
+Proof. iIntros "[??]". Show. iFrame. Qed.
+
+Lemma test_big_sepL2_iFrame (Φ : nat → nat → PROP) (l1 l2 : list nat) P :
+ Φ 0 10 -∗ ([∗ list] y1;y2 ∈ l1;l2, Φ y1 y2) -∗
+ ([∗ list] y1;y2 ∈ (0 :: l1);(10 :: l2), Φ y1 y2).
+Proof. iIntros "$ ?". iFrame. Qed.
+
+Lemma test_lemma_1 (b : bool) :
+ emp ⊢@{PROP} □?b True.
+Proof. destruct b; simpl; eauto. Qed.
+Check "test_reducing_after_iDestruct".
+Lemma test_reducing_after_iDestruct : emp ⊢@{PROP} True.
+Proof.
+ iIntros "H". iDestruct (test_lemma_1 true with "H") as "H". Show. done.
+Qed.
+
+Lemma test_lemma_2 (b : bool) :
+ □?b emp ⊢@{PROP} emp.
+Proof. destruct b; simpl; eauto. Qed.
+Check "test_reducing_after_iApply".
+Lemma test_reducing_after_iApply : emp ⊢@{PROP} emp.
+Proof.
+ iIntros "#H". iApply (test_lemma_2 true). Show. auto.
+Qed.
+
+Lemma test_lemma_3 (b : bool) :
+ â–¡?b emp ⊢@{PROP} ⌜b = bâŒ.
+Proof. destruct b; simpl; eauto. Qed.
+Check "test_reducing_after_iApply_late_evar".
+Lemma test_reducing_after_iApply_late_evar : emp ⊢@{PROP} ⌜true = trueâŒ.
+Proof.
+ iIntros "#H". iApply (test_lemma_3). Show. auto.
+Qed.
+
+Section wandM.
+ Import proofmode.base.
+ Check "test_wandM".
+ Lemma test_wandM mP Q R :
+ (mP -∗? Q) -∗ (Q -∗ R) -∗ (mP -∗? R).
+ Proof.
+ iIntros "HPQ HQR HP". Show.
+ iApply "HQR". iApply "HPQ". Show.
+ done.
+ Qed.
+End wandM.
+
+Definition modal_if_def b (P : PROP) :=
+ (â–¡?b P)%I.
+Lemma modal_if_lemma1 b P :
+ False -∗ □?b P.
+Proof. iIntros "?". by iExFalso. Qed.
+Lemma test_iApply_prettification1 (P : PROP) :
+ False -∗ modal_if_def true P.
+Proof.
+ (* Make sure the goal is not prettified before [iApply] unifies. *)
+ iIntros "?". rewrite /modal_if_def. iApply modal_if_lemma1. iAssumption.
+Qed.
+Lemma modal_if_lemma2 P :
+ False -∗ □?false P.
+Proof. iIntros "?". by iExFalso. Qed.
+Lemma test_iApply_prettification2 (P : PROP) :
+ False -∗ ∃ b, □?b P.
+Proof.
+ (* Make sure the conclusion of the lemma is not prettified too early. *)
+ iIntros "?". iExists _. iApply modal_if_lemma2. done.
+Qed.
+
+End tests.
+
+(** Test specifically if certain things print correctly. *)
+Section printing_tests.
+Context {PROP : sbi} `{!BiFUpd PROP}.
+Implicit Types P Q R : PROP.
+
+Check "elim_mod_accessor".
+Lemma elim_mod_accessor {X : Type} E1 E2 α (β : X → PROP) γ :
+ accessor (fupd E1 E2) (fupd E2 E1) α β γ -∗ |={E1}=> True.
+Proof. iIntros ">Hacc". Show. Abort.
+
+(* Test line breaking of long assumptions. *)
+Section linebreaks.
+Check "print_long_line_1".
+Lemma print_long_line_1 (P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P : PROP) :
+ P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P ∗
+ P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P
+ -∗ True.
+Proof.
+ iIntros "HP". Show. Undo. iIntros "?". Show.
+Abort.
+
+(* This is specifically crafted such that not having the printing box in
+ the proofmode notation breaks the output. *)
+Local Notation "'TESTNOTATION' '{{' P '|' Q '}' '}'" := (P ∧ Q)%I
+ (format "'TESTNOTATION' '{{' P '|' '/' Q '}' '}'") : bi_scope.
+Check "print_long_line_2".
+Lemma print_long_line_2 (P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P : PROP) :
+ TESTNOTATION {{ P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P | P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P_P }}
+ -∗ True.
+Proof.
+ iIntros "HP". Show. Undo. iIntros "?". Show.
+Abort.
+
+Check "long_impl".
+Lemma long_impl (PPPPPPPPPPPPPPPPP QQQQQQQQQQQQQQQQQQ : PROP) :
+ (PPPPPPPPPPPPPPPPP → (QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ))%I.
+Proof.
+ iStartProof. Show.
+Abort.
+Check "long_impl_nested".
+Lemma long_impl_nested (PPPPPPPPPPPPPPPPP QQQQQQQQQQQQQQQQQQ : PROP) :
+ (PPPPPPPPPPPPPPPPP → (QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ) → (QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ))%I.
+Proof.
+ iStartProof. Show.
+Abort.
+Check "long_wand".
+Lemma long_wand (PPPPPPPPPPPPPPPPP QQQQQQQQQQQQQQQQQQ : PROP) :
+ (PPPPPPPPPPPPPPPPP -∗ (QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ))%I.
+Proof.
+ iStartProof. Show.
+Abort.
+Check "long_wand_nested".
+Lemma long_wand_nested (PPPPPPPPPPPPPPPPP QQQQQQQQQQQQQQQQQQ : PROP) :
+ (PPPPPPPPPPPPPPPPP -∗ (QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ) -∗ (QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ))%I.
+Proof.
+ iStartProof. Show.
+Abort.
+Check "long_fupd".
+Lemma long_fupd E (PPPPPPPPPPPPPPPPP QQQQQQQQQQQQQQQQQQ : PROP) :
+ PPPPPPPPPPPPPPPPP ={E}=∗ QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ.
+Proof.
+ iStartProof. Show.
+Abort.
+Check "long_fupd_nested".
+Lemma long_fupd_nested E1 E2 (PPPPPPPPPPPPPPPPP QQQQQQQQQQQQQQQQQQ : PROP) :
+ PPPPPPPPPPPPPPPPP ={E1,E2}=∗ QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ
+ ={E1,E2}=∗ QQQQQQQQQQQQQQQQQQ ∗ QQQQQQQQQQQQQQQQQQ.
+Proof.
+ iStartProof. Show.
+Abort.
+End linebreaks.
+
+End printing_tests.
+
+(** Test error messages *)
+Section error_tests.
+Context {PROP : sbi}.
+Implicit Types P Q R : PROP.
+
+Check "iAlways_spatial_non_empty".
+Lemma iAlways_spatial_non_empty P :
+ P -∗ □ emp.
+Proof. iIntros "HP". Fail iAlways. Abort.
+
+Check "iDestruct_bad_name".
+Lemma iDestruct_bad_name P :
+ P -∗ P.
+Proof. iIntros "HP". Fail iDestruct "HQ" as "HP". Abort.
+
+Check "iIntros_dup_name".
+Lemma iIntros_dup_name P Q :
+ P -∗ Q -∗ ∀ x y : (), P.
+Proof.
+ iIntros "HP". Fail iIntros "HP".
+ iIntros "HQ" (x). Fail iIntros (x).
+Abort.
+
+Check "iSplit_one_of_many".
+Lemma iSplit_one_of_many P :
+ P -∗ P -∗ P ∗ P.
+Proof.
+ iIntros "HP1 HP2". Fail iSplitL "HP1 HPx". Fail iSplitL "HPx HP1".
+Abort.
+
+Check "iExact_fail".
+Lemma iExact_fail P Q :
+ <affine> P -∗ Q -∗ <affine> P.
+Proof.
+ iIntros "HP". Fail iExact "HQ". iIntros "HQ". Fail iExact "HQ". Fail iExact "HP".
+Abort.
+
+Check "iClear_fail".
+Lemma iClear_fail P : P -∗ P.
+Proof. Fail iClear "HP". iIntros "HP". Fail iClear "HP". Abort.
+
+Check "iSpecializeArgs_fail".
+Lemma iSpecializeArgs_fail P :
+ (∀ x : nat, P) -∗ P.
+Proof. iIntros "HP". Fail iSpecialize ("HP" $! true). Abort.
+
+Check "iStartProof_fail".
+Lemma iStartProof_fail : 0 = 0.
+Proof. Fail iStartProof. Abort.
+
+Check "iPoseProof_fail".
+Lemma iPoseProof_fail P : P -∗ P.
+Proof.
+ Fail iPoseProof (eq_refl 0) as "H".
+ iIntros "H". Fail iPoseProof bi.and_intro as "H".
+Abort.
+
+Check "iRevert_fail".
+Lemma iRevert_fail P : P -∗ P.
+Proof. Fail iRevert "H". Abort.
+
+Check "iDestruct_fail".
+Lemma iDestruct_fail P : P -∗ <absorb> P.
+Proof. iIntros "HP". Fail iDestruct "HP" as "{HP}". Fail iDestruct "HP" as "[{HP}]". Abort.
+
+Check "iApply_fail".
+Lemma iApply_fail P Q : P -∗ Q.
+Proof. iIntros "HP". Fail iApply "HP". Abort.
+
+End error_tests.
diff --git a/tests/proofmode_iris.ref b/tests/proofmode_iris.ref
new file mode 100644
index 0000000000000000000000000000000000000000..f2fe3bd8e51d6798425ae34d1357eedad94011de
--- /dev/null
+++ b/tests/proofmode_iris.ref
@@ -0,0 +1,156 @@
+1 subgoal
+
+ Σ : gFunctors
+ H : invG Σ
+ H0 : cinvG Σ
+ H1 : na_invG Σ
+ N : namespace
+ P : iProp Σ
+ ============================
+ "H" : inv N (<pers> P)
+ "H2" : â–· <pers> P
+ --------------------------------------â–¡
+ |={⊤ ∖ ↑N}=> ▷ <pers> P ∗ (|={⊤}=> ▷ P)
+
+1 subgoal
+
+ Σ : gFunctors
+ H : invG Σ
+ H0 : cinvG Σ
+ H1 : na_invG Σ
+ N : namespace
+ P : iProp Σ
+ ============================
+ "H" : inv N (<pers> P)
+ "H2" : â–· <pers> P
+ --------------------------------------â–¡
+ "Hclose" : ▷ <pers> P ={⊤ ∖ ↑N,⊤}=∗ emp
+ --------------------------------------∗
+ |={⊤ ∖ ↑N,⊤}=> ▷ P
+
+1 subgoal
+
+ Σ : gFunctors
+ H : invG Σ
+ H0 : cinvG Σ
+ H1 : na_invG Σ
+ γ : gname
+ p : Qp
+ N : namespace
+ P : iProp Σ
+ ============================
+ _ : cinv N γ (<pers> P)
+ "HP" : â–· <pers> P
+ --------------------------------------â–¡
+ "Hown" : cinv_own γ p
+ --------------------------------------∗
+ |={⊤ ∖ ↑N}=> ▷ <pers> P ∗ (|={⊤}=> cinv_own γ p ∗ ▷ P)
+
+1 subgoal
+
+ Σ : gFunctors
+ H : invG Σ
+ H0 : cinvG Σ
+ H1 : na_invG Σ
+ γ : gname
+ p : Qp
+ N : namespace
+ P : iProp Σ
+ ============================
+ _ : cinv N γ (<pers> P)
+ "HP" : â–· <pers> P
+ --------------------------------------â–¡
+ "Hown" : cinv_own γ p
+ "Hclose" : ▷ <pers> P ={⊤ ∖ ↑N,⊤}=∗ emp
+ --------------------------------------∗
+ |={⊤ ∖ ↑N,⊤}=> cinv_own γ p ∗ ▷ P
+
+1 subgoal
+
+ Σ : gFunctors
+ H : invG Σ
+ H0 : cinvG Σ
+ H1 : na_invG Σ
+ t : na_inv_pool_name
+ N : namespace
+ E1, E2 : coPset
+ P : iProp Σ
+ H2 : ↑N ⊆ E2
+ ============================
+ _ : na_inv t N (<pers> P)
+ "HP" : â–· <pers> P
+ --------------------------------------â–¡
+ "Hown1" : na_own t E1
+ "Hown2" : na_own t (E2 ∖ ↑N)
+ --------------------------------------∗
+ |={⊤}=> (▷ <pers> P ∗ na_own t (E2 ∖ ↑N))
+ ∗ (na_own t E2 ={⊤}=∗ na_own t E1 ∗ na_own t E2 ∗ ▷ P)
+
+1 subgoal
+
+ Σ : gFunctors
+ H : invG Σ
+ H0 : cinvG Σ
+ H1 : na_invG Σ
+ t : na_inv_pool_name
+ N : namespace
+ E1, E2 : coPset
+ P : iProp Σ
+ H2 : ↑N ⊆ E2
+ ============================
+ _ : na_inv t N (<pers> P)
+ "HP" : â–· <pers> P
+ --------------------------------------â–¡
+ "Hown1" : na_own t E1
+ "Hown2" : na_own t (E2 ∖ ↑N)
+ "Hclose" : ▷ <pers> P ∗ na_own t (E2 ∖ ↑N) ={⊤}=∗ na_own t E2
+ --------------------------------------∗
+ |={⊤}=> na_own t E1 ∗ na_own t E2 ∗ ▷ P
+
+The command has indeed failed with message:
+In nested Ltac calls to "iInv (constr) as (constr)",
+"iInvCore (constr) in (tactic)" and
+"iInvCore (constr) with (constr) as (open_constr) in (tactic)", last call
+failed.
+Tactic failure: iInv: selector 34 is not of the right type .
+The command has indeed failed with message:
+In nested Ltac calls to "iInv (constr) as (constr)",
+"iInvCore (constr) in (tactic)" and
+"iInvCore (constr) with (constr) as (open_constr) in (tactic)", last call
+failed.
+Tactic failure: iInv: invariant nroot not found.
+The command has indeed failed with message:
+In nested Ltac calls to "iInv (constr) as (constr)",
+"iInvCore (constr) in (tactic)" and
+"iInvCore (constr) with (constr) as (open_constr) in (tactic)", last call
+failed.
+Tactic failure: iInv: invariant "H2" not found.
+1 subgoal
+
+ Σ : gFunctors
+ H : invG Σ
+ I : biIndex
+ N : namespace
+ E : coPset
+ 𓟠: iProp Σ
+ H0 : ↑N ⊆ E
+ ============================
+ "HP" : ⎡ ▷ 𓟠⎤
+ --------------------------------------∗
+ |={E ∖ ↑N}=> ⎡ ▷ 𓟠⎤ ∗ (|={E}=> emp)
+
+1 subgoal
+
+ Σ : gFunctors
+ H : invG Σ
+ I : biIndex
+ N : namespace
+ E : coPset
+ 𓟠: iProp Σ
+ H0 : ↑N ⊆ E
+ ============================
+ "HP" : ⎡ ▷ 𓟠⎤
+ "Hclose" : ⎡ ▷ 𓟠={E ∖ ↑N,E}=∗ emp ⎤
+ --------------------------------------∗
+ |={E ∖ ↑N,E}=> emp
+
diff --git a/tests/proofmode_iris.v b/tests/proofmode_iris.v
new file mode 100644
index 0000000000000000000000000000000000000000..1cfc957441c25bf90b0c8eff4b390026ae44b5ee
--- /dev/null
+++ b/tests/proofmode_iris.v
@@ -0,0 +1,250 @@
+From iris.proofmode Require Import tactics monpred.
+From iris.base_logic Require Import base_logic.
+From iris.base_logic.lib Require Import invariants cancelable_invariants na_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.
+
+ Lemma test_iStartProof_1 P : P -∗ P.
+ Proof. iStartProof. iStartProof. iIntros "$". Qed.
+ Lemma test_iStartProof_2 P : P -∗ P.
+ Proof. iStartProof (uPred _). iStartProof (uPredI _). iIntros "$". Qed.
+ Lemma test_iStartProof_3 P : P -∗ P.
+ Proof. iStartProof (uPredI _). iStartProof (uPredSI _). iIntros "$". Qed.
+ Lemma test_iStartProof_4 P : P -∗ P.
+ Proof. iStartProof (uPredSI _). iStartProof (uPred _). iIntros "$". Qed.
+End base_logic_tests.
+
+Section iris_tests.
+ Context `{invG Σ, cinvG Σ, na_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.
+
+ Lemma test_iInv_0 N P: inv N (<pers> P) ={⊤}=∗ ▷ P.
+ Proof.
+ iIntros "#H".
+ iInv N as "#H2". Show.
+ iModIntro. iSplit; auto.
+ Qed.
+
+ Lemma test_iInv_0_with_close N P: inv N (<pers> P) ={⊤}=∗ ▷ P.
+ Proof.
+ iIntros "#H".
+ iInv N as "#H2" "Hclose". Show.
+ iMod ("Hclose" with "H2").
+ iModIntro. by iNext.
+ Qed.
+
+ Lemma test_iInv_1 N E P:
+ ↑N ⊆ E →
+ inv N (<pers> P) ={E}=∗ ▷ P.
+ Proof.
+ iIntros (?) "#H".
+ iInv N as "#H2".
+ iModIntro. iSplit; auto.
+ Qed.
+
+ Lemma test_iInv_2 γ p N P:
+ cinv N γ (<pers> P) ∗ cinv_own γ p ={⊤}=∗ cinv_own γ p ∗ ▷ P.
+ Proof.
+ iIntros "(#?&?)".
+ iInv N as "(#HP&Hown)". Show.
+ iModIntro. iSplit; auto with iFrame.
+ Qed.
+
+ Lemma test_iInv_2_with_close γ p N P:
+ cinv N γ (<pers> P) ∗ cinv_own γ p ={⊤}=∗ cinv_own γ p ∗ ▷ P.
+ Proof.
+ iIntros "(#?&?)".
+ iInv N as "(#HP&Hown)" "Hclose". Show.
+ iMod ("Hclose" with "HP").
+ iModIntro. iFrame. by iNext.
+ Qed.
+
+ Lemma test_iInv_3 γ p1 p2 N P:
+ cinv N γ (<pers> P) ∗ cinv_own γ p1 ∗ cinv_own γ p2
+ ={⊤}=∗ cinv_own γ p1 ∗ cinv_own γ p2 ∗ ▷ P.
+ Proof.
+ iIntros "(#?&Hown1&Hown2)".
+ iInv N with "[Hown2 //]" as "(#HP&Hown2)".
+ iModIntro. iSplit; auto with iFrame.
+ Qed.
+
+ Lemma test_iInv_4 t N E1 E2 P:
+ ↑N ⊆ E2 →
+ na_inv t N (<pers> P) ∗ na_own t E1 ∗ na_own t E2
+ ⊢ |={⊤}=> na_own t E1 ∗ na_own t E2 ∗ ▷ P.
+ Proof.
+ iIntros (?) "(#?&Hown1&Hown2)".
+ iInv N as "(#HP&Hown2)". Show.
+ iModIntro. iSplitL "Hown2"; auto with iFrame.
+ Qed.
+
+ Lemma test_iInv_4_with_close t N E1 E2 P:
+ ↑N ⊆ E2 →
+ na_inv t N (<pers> P) ∗ na_own t E1 ∗ na_own t E2
+ ⊢ |={⊤}=> na_own t E1 ∗ na_own t E2 ∗ ▷ P.
+ Proof.
+ iIntros (?) "(#?&Hown1&Hown2)".
+ iInv N as "(#HP&Hown2)" "Hclose". Show.
+ iMod ("Hclose" with "[HP Hown2]").
+ { iFrame. done. }
+ iModIntro. iFrame. by iNext.
+ Qed.
+
+ (* test named selection of which na_own to use *)
+ Lemma test_iInv_5 t N E1 E2 P:
+ ↑N ⊆ E2 →
+ na_inv t N (<pers> P) ∗ na_own t E1 ∗ na_own t E2
+ ={⊤}=∗ na_own t E1 ∗ na_own t E2 ∗ ▷ P.
+ Proof.
+ iIntros (?) "(#?&Hown1&Hown2)".
+ iInv N with "Hown2" as "(#HP&Hown2)".
+ iModIntro. iSplitL "Hown2"; auto with iFrame.
+ Qed.
+
+ Lemma test_iInv_6 t N E1 E2 P:
+ ↑N ⊆ E1 →
+ na_inv t N (<pers> P) ∗ na_own t E1 ∗ na_own t E2
+ ={⊤}=∗ na_own t E1 ∗ na_own t E2 ∗ ▷ P.
+ Proof.
+ iIntros (?) "(#?&Hown1&Hown2)".
+ iInv N with "Hown1" as "(#HP&Hown1)".
+ iModIntro. iSplitL "Hown1"; auto with iFrame.
+ Qed.
+
+ (* test robustness in presence of other invariants *)
+ Lemma test_iInv_7 t N1 N2 N3 E1 E2 P:
+ ↑N3 ⊆ E1 →
+ inv N1 P ∗ na_inv t N3 (<pers> P) ∗ inv N2 P ∗ na_own t E1 ∗ na_own t E2
+ ={⊤}=∗ na_own t E1 ∗ na_own t E2 ∗ ▷ P.
+ Proof.
+ iIntros (?) "(#?&#?&#?&Hown1&Hown2)".
+ iInv N3 with "Hown1" as "(#HP&Hown1)".
+ iModIntro. iSplitL "Hown1"; auto with iFrame.
+ Qed.
+
+ (* iInv should work even where we have "inv N P" in which P contains an evar *)
+ Lemma test_iInv_8 N : ∃ P, inv N P ={⊤}=∗ P ≡ True ∧ inv N P.
+ Proof.
+ eexists. iIntros "#H".
+ iInv N as "HP". iFrame "HP". auto.
+ Qed.
+
+ (* test selection by hypothesis name instead of namespace *)
+ Lemma test_iInv_9 t N1 N2 N3 E1 E2 P:
+ ↑N3 ⊆ E1 →
+ inv N1 P ∗ na_inv t N3 (<pers> P) ∗ inv N2 P ∗ na_own t E1 ∗ na_own t E2
+ ={⊤}=∗ na_own t E1 ∗ na_own t E2 ∗ ▷ P.
+ Proof.
+ iIntros (?) "(#?&#HInv&#?&Hown1&Hown2)".
+ iInv "HInv" with "Hown1" as "(#HP&Hown1)".
+ iModIntro. iSplitL "Hown1"; auto with iFrame.
+ Qed.
+
+ (* test selection by hypothesis name instead of namespace *)
+ Lemma test_iInv_10 t N1 N2 N3 E1 E2 P:
+ ↑N3 ⊆ E1 →
+ inv N1 P ∗ na_inv t N3 (<pers> P) ∗ inv N2 P ∗ na_own t E1 ∗ na_own t E2
+ ={⊤}=∗ na_own t E1 ∗ na_own t E2 ∗ ▷ P.
+ Proof.
+ iIntros (?) "(#?&#HInv&#?&Hown1&Hown2)".
+ iInv "HInv" as "(#HP&Hown1)".
+ iModIntro. iSplitL "Hown1"; auto with iFrame.
+ Qed.
+
+ (* test selection by ident name *)
+ Lemma test_iInv_11 N P: inv N (<pers> P) ={⊤}=∗ ▷ P.
+ Proof.
+ let H := iFresh in
+ (iIntros H; iInv H as "#H2"). auto.
+ Qed.
+
+ (* error messages *)
+ Lemma test_iInv_12 N P: inv N (<pers> P) ={⊤}=∗ True.
+ Proof.
+ iIntros "H".
+ Fail iInv 34 as "#H2".
+ Fail iInv nroot as "#H2".
+ Fail iInv "H2" as "#H2".
+ done.
+ Qed.
+
+ (* test destruction of existentials when opening an invariant *)
+ Lemma test_iInv_13 N:
+ inv N (∃ (v1 v2 v3 : nat), emp ∗ emp ∗ emp) ={⊤}=∗ ▷ emp.
+ Proof.
+ iIntros "H"; iInv "H" as (v1 v2 v3) "(?&?&_)".
+ eauto.
+ Qed.
+End iris_tests.
+
+Section monpred_tests.
+ Context `{invG Σ}.
+ Context {I : biIndex}.
+ Local Notation monPred := (monPred I (iPropI Σ)).
+ Local Notation monPredI := (monPredI I (iPropI Σ)).
+ Local Notation monPredSI := (monPredSI I (iPropSI Σ)).
+ Implicit Types P Q R : monPred.
+ Implicit Types ð“Ÿ ð“ ð“¡ : iProp Σ.
+
+ Lemma test_iInv N E ð“Ÿ :
+ ↑N ⊆ E →
+ ⎡inv N ð“ŸâŽ¤ ⊢@{monPredI} |={E}=> emp.
+ Proof.
+ iIntros (?) "Hinv".
+ iInv N as "HP". Show.
+ iFrame "HP". auto.
+ Qed.
+
+ Lemma test_iInv_with_close N E ð“Ÿ :
+ ↑N ⊆ E →
+ ⎡inv N ð“ŸâŽ¤ ⊢@{monPredI} |={E}=> emp.
+ Proof.
+ iIntros (?) "Hinv".
+ iInv N as "HP" "Hclose". Show.
+ iMod ("Hclose" with "HP"). auto.
+ Qed.
+
+End monpred_tests.
diff --git a/tests/proofmode_monpred.ref b/tests/proofmode_monpred.ref
new file mode 100644
index 0000000000000000000000000000000000000000..459ec829a8026efcd2bc56fe91bd2f4d73e794f0
--- /dev/null
+++ b/tests/proofmode_monpred.ref
@@ -0,0 +1,64 @@
+1 subgoal
+
+ I : biIndex
+ PROP : sbi
+ P, Q : monpred.monPred I PROP
+ i : I
+ ============================
+ "HW" : (P -∗ Q) i
+ --------------------------------------∗
+ (P -∗ Q) i
+
+1 subgoal
+
+ I : biIndex
+ PROP : sbi
+ P, Q : monpred.monPred I PROP
+ i, j : I
+ ============================
+ "HW" : (P -∗ Q) j
+ "HP" : P j
+ --------------------------------------∗
+ Q j
+
+1 subgoal
+
+ I : biIndex
+ PROP : sbi
+ P, Q : monpred.monPred I PROP
+ Objective0 : Objective Q
+ ð“Ÿ, ð“ : PROP
+ ============================
+ "H2" : ∀ i : I, Q i
+ "H3" : ð“Ÿ
+ "H4" : ð“
+ --------------------------------------∗
+ ∀ i : I, 𓟠∗ ð“ ∗ Q i
+
+1 subgoal
+
+ I : biIndex
+ PROP : sbi
+ FU0 : BiFUpd PROP * ()
+ P, Q : monpred.monPred I PROP
+ i : I
+ ============================
+ --------------------------------------∗
+ (Q -∗ emp) i
+
+1 subgoal
+
+ I : biIndex
+ PROP : sbi
+ FU0 : BiFUpd PROP * ()
+ P : monpred.monPred I PROP
+ i : I
+ ============================
+ --------------------------------------∗
+ ∀ _ : (), ∃ _ : (), emp
+
+The command has indeed failed with message:
+In nested Ltac calls to "iFrame (constr)",
+"<iris.proofmode.ltac_tactics.iFrame_go>" and
+"<iris.proofmode.ltac_tactics.iFrameHyp>", last call failed.
+Tactic failure: iFrame: cannot frame (P i).
diff --git a/tests/proofmode_monpred.v b/tests/proofmode_monpred.v
new file mode 100644
index 0000000000000000000000000000000000000000..c683a11a74f73442789fca7307f5b408cd74442f
--- /dev/null
+++ b/tests/proofmode_monpred.v
@@ -0,0 +1,169 @@
+From iris.proofmode Require Import tactics monpred.
+
+Section tests.
+ Context {I : biIndex} {PROP : sbi}.
+ Local Notation monPred := (monPred I PROP).
+ Local Notation monPredI := (monPredI I PROP).
+ Local Notation monPredSI := (monPredSI I PROP).
+ Implicit Types P Q R : monPred.
+ Implicit Types ð“Ÿ ð“ ð“¡ : PROP.
+ Implicit Types i j : I.
+
+ Lemma test0 P : P -∗ P.
+ Proof. iIntros "$". Qed.
+
+ Lemma test_iStartProof_1 P : P -∗ P.
+ Proof. iStartProof. iStartProof. iIntros "$". Qed.
+ Lemma test_iStartProof_2 P : P -∗ P.
+ Proof. iStartProof monPred. iStartProof monPredI. iIntros "$". Qed.
+ Lemma test_iStartProof_3 P : P -∗ P.
+ Proof. iStartProof monPredI. iStartProof monPredSI. iIntros "$". Qed.
+ Lemma test_iStartProof_4 P : P -∗ P.
+ Proof. iStartProof monPredSI. iStartProof monPred. iIntros "$". Qed.
+ Lemma test_iStartProof_5 P : P -∗ P.
+ Proof. iStartProof PROP. iIntros (i) "$". Qed.
+ Lemma test_iStartProof_6 P : P ⊣⊢ P.
+ Proof. iStartProof PROP. iIntros (i). iSplit; iIntros "$". Qed.
+ Lemma test_iStartProof_7 P : ((P ≡ P)%I : monPredI).
+ Proof. iStartProof PROP. done. Qed.
+
+ Lemma test_intowand_1 P Q : (P -∗ Q) -∗ P -∗ Q.
+ Proof.
+ iStartProof PROP. iIntros (i) "HW". Show.
+ iIntros (j ->) "HP". Show. by iApply "HW".
+ Qed.
+ Lemma test_intowand_2 P Q : (P -∗ Q) -∗ P -∗ Q.
+ Proof.
+ iStartProof PROP. iIntros (i) "HW". iIntros (j ->) "HP".
+ iSpecialize ("HW" with "[HP //]"). done.
+ Qed.
+ Lemma test_intowand_3 P Q : (P -∗ Q) -∗ P -∗ Q.
+ Proof.
+ iStartProof PROP. iIntros (i) "HW". iIntros (j ->) "HP".
+ iSpecialize ("HW" with "HP"). done.
+ Qed.
+ Lemma test_intowand_4 P Q : (P -∗ Q) -∗ ▷ P -∗ ▷ Q.
+ Proof.
+ iStartProof PROP. iIntros (i) "HW". iIntros (j ->) "HP". by iApply "HW".
+ Qed.
+ Lemma test_intowand_5 P Q : (P -∗ Q) -∗ ▷ P -∗ ▷ Q.
+ Proof.
+ iStartProof PROP. iIntros (i) "HW". iIntros (j ->) "HP".
+ iSpecialize ("HW" with "HP"). done.
+ Qed.
+
+ Lemma test_apply_in_elim (P : monPredI) (i : I) : monPred_in i -∗ ⎡ P i ⎤ → P.
+ Proof. iIntros. by iApply monPred_in_elim. Qed.
+
+ Lemma test_iStartProof_forall_1 (Φ : nat → monPredI) : ∀ n, Φ n -∗ Φ n.
+ Proof.
+ iStartProof PROP. iIntros (n i) "$".
+ Qed.
+ Lemma test_iStartProof_forall_2 (Φ : nat → monPredI) : ∀ n, Φ n -∗ Φ n.
+ Proof.
+ iStartProof. iIntros (n) "$".
+ Qed.
+
+ Lemma test_embed_wand (P Q : PROP) : (⎡P⎤ -∗ ⎡Q⎤) -∗ ⎡P -∗ Q⎤ : monPred.
+ Proof.
+ iIntros "H HP". by iApply "H".
+ Qed.
+
+ Lemma test_objectively P Q : <obj> emp -∗ <obj> P -∗ <obj> Q -∗ <obj> (P ∗ Q).
+ Proof. iIntros "#? HP HQ". iAlways. by iSplitL "HP". Qed.
+
+ Lemma test_objectively_absorbing P Q R `{!Absorbing P} :
+ <obj> emp -∗ <obj> P -∗ <obj> Q -∗ R -∗ <obj> (P ∗ Q).
+ Proof. iIntros "#? HP HQ HR". iAlways. by iSplitL "HP". Qed.
+
+ Lemma test_objectively_affine P Q R `{!Affine R} :
+ <obj> emp -∗ <obj> P -∗ <obj> Q -∗ R -∗ <obj> (P ∗ Q).
+ Proof. iIntros "#? HP HQ HR". iAlways. by iSplitL "HP". Qed.
+
+ Lemma test_iModIntro_embed P `{!Affine Q} ð“Ÿ ð“ :
+ â–¡ P -∗ Q -∗ ⎡ð“ŸâŽ¤ -∗ ⎡ð“ ⎤ -∗ ⎡ 𓟠∗ ð“ ⎤.
+ Proof. iIntros "#H1 _ H2 H3". iAlways. iFrame. Qed.
+
+ Lemma test_iModIntro_embed_objective P `{!Objective Q} ð“Ÿ ð“ :
+ â–¡ P -∗ Q -∗ ⎡ð“ŸâŽ¤ -∗ ⎡ð“ ⎤ -∗ ⎡ ∀ i, 𓟠∗ ð“ ∗ Q i ⎤.
+ Proof. iIntros "#H1 H2 H3 H4". iAlways. Show. iFrame. Qed.
+
+ Lemma test_iModIntro_embed_nested P ð“Ÿ ð“ :
+ â–¡ P -∗ ⎡◇ ð“ŸâŽ¤ -∗ ⎡◇ ð“ ⎤ -∗ ⎡ â—‡ (𓟠∗ ð“ ) ⎤.
+ Proof. iIntros "#H1 H2 H3". iModIntro ⎡ _ ⎤%I. by iSplitL "H2". Qed.
+
+ Lemma test_into_wand_embed ð“Ÿ ð“ :
+ (ð“Ÿ -∗ â—‡ ð“ ) →
+ ⎡ð“ŸâŽ¤ ⊢@{monPredI} â—‡ ⎡ð“ ⎤.
+ Proof.
+ iIntros (HPQ) "HP".
+ iMod (HPQ with "[-]") as "$"; last by auto.
+ iAssumption.
+ Qed.
+
+ (* This is a hack to avoid avoid coq bug #5735: sections variables ignore hint
+ modes. So we assume the instances in a way that cannot be used by type
+ class resolution, and then separately declare the instance as such. *)
+ Context (FU0 : BiFUpd PROP * unit).
+ Instance FU : BiFUpd PROP := fst FU0.
+
+ Lemma test_apply_fupd_intro_mask E1 E2 P :
+ E2 ⊆ E1 → P -∗ |={E1,E2}=> |={E2,E1}=> P.
+ Proof. iIntros. by iApply @fupd_intro_mask. Qed.
+ Lemma test_apply_fupd_intro_mask_2 E1 E2 P :
+ E2 ⊆ E1 → P -∗ |={E1,E2}=> |={E2,E1}=> P.
+ Proof. iIntros. iFrame. by iApply @fupd_intro_mask'. Qed.
+
+ Lemma test_iFrame_embed_persistent (P : PROP) (Q: monPred) :
+ Q ∗ □ ⎡P⎤ ⊢ Q ∗ ⎡P ∗ P⎤.
+ Proof.
+ iIntros "[$ #HP]". iFrame "HP".
+ Qed.
+
+ Lemma test_iNext_Bi P :
+ ▷ P ⊢@{monPredI} ▷ P.
+ Proof. iIntros "H". by iNext. Qed.
+
+ (** Test monPred_at framing *)
+ Lemma test_iFrame_monPred_at_wand (P Q : monPred) i :
+ P i -∗ (Q -∗ P) i.
+ Proof. iIntros "$". Show. Abort.
+
+ Program Definition monPred_id (R : monPred) : monPred :=
+ MonPred (λ V, R V) _.
+ Next Obligation. intros ? ???. eauto. Qed.
+
+ Lemma test_iFrame_monPred_id (Q R : monPred) i :
+ Q i ∗ R i -∗ (Q ∗ monPred_id R) i.
+ Proof.
+ iIntros "(HQ & HR)". iFrame "HR". iAssumption.
+ Qed.
+
+ Lemma test_iFrame_rel P i j ij :
+ IsBiIndexRel i ij → IsBiIndexRel j ij →
+ P i -∗ P j -∗ P ij ∗ P ij.
+ Proof. iIntros (??) "HPi HPj". iFrame. Qed.
+
+ Lemma test_iFrame_later_rel `{!BiAffine PROP} P i j :
+ IsBiIndexRel i j →
+ ▷ (P i) -∗ (▷ P) j.
+ Proof. iIntros (?) "?". iFrame. Qed.
+
+ Lemma test_iFrame_laterN n P i :
+ ▷^n (P i) -∗ (▷^n P) i.
+ Proof. iIntros "?". iFrame. Qed.
+
+ Lemma test_iFrame_quantifiers P i :
+ P i -∗ (∀ _:(), ∃ _:(), P) i.
+ Proof. iIntros "?". iFrame. Show. iIntros ([]). iExists (). iEmpIntro. Qed.
+
+ Lemma test_iFrame_embed (P : PROP) i :
+ P -∗ (embed (B:=monPredI) P) i.
+ Proof. iIntros "$". Qed.
+
+ (* Make sure search doesn't diverge on an evar *)
+ Lemma test_iFrame_monPred_at_evar (P : monPred) i j :
+ P i -∗ ∃ Q, (Q j).
+ Proof. iIntros "HP". iExists _. Fail iFrame "HP". Abort.
+
+End tests.
diff --git a/tests/telescopes.ref b/tests/telescopes.ref
new file mode 100644
index 0000000000000000000000000000000000000000..0816c1fa580fdb2ee3576d27ddb20c1fdef07ef4
--- /dev/null
+++ b/tests/telescopes.ref
@@ -0,0 +1,93 @@
+1 subgoal
+
+ PROP : sbi
+ BiFUpd0 : BiFUpd PROP
+ X : tele
+ E1, E2 : coPset
+ α, β, γ1, γ2 : X → PROP
+ x' : X
+ ============================
+ "Hγ12" : ∀.. x : X, γ1 x -∗ γ2 x
+ "Hα" : α x'
+ "Hclose" : β x' ={E2,E1}=∗ γ1 x'
+ --------------------------------------∗
+ |={E2}=> ∃.. x : X, α x ∗ (β x ={E2,E1}=∗ γ2 x)
+
+1 subgoal
+
+ PROP : sbi
+ BiFUpd0 : BiFUpd PROP
+ E1, E2 : coPset
+ ============================
+ "H" : ∃ x x0 : nat, <affine> ⌜x = x0⌠∗ (True ={E2,E1}=∗ <affine> ⌜x ≠x0âŒ)
+ --------------------------------------∗
+ |={E2,E1}=> False
+
+"test1_test"
+ : string
+1 subgoal
+
+ PROP : sbi
+ x : nat
+ ============================
+ "H" : ∃ x0 : nat, <affine> ⌜x = x0âŒ
+ --------------------------------------∗
+ â–· False
+
+1 subgoal
+
+ PROP : sbi
+ x : nat
+ ============================
+ "H" : ∃ x0 : nat, <affine> ⌜x = x0âŒ
+ --------------------------------------∗
+ â–· False
+
+"test2_test"
+ : string
+1 subgoal
+
+ PROP : sbi
+ ============================
+ "H" : ∃ x x0 : nat, <affine> ⌜x = x0âŒ
+ --------------------------------------∗
+ False
+
+1 subgoal
+
+ PROP : sbi
+ x : nat
+ ============================
+ "H" : ∃ x0 : nat, <affine> ⌜x = x0âŒ
+ --------------------------------------∗
+ False
+
+1 subgoal
+
+ PROP : sbi
+ x : nat
+ ============================
+ "H" : â–· (∃ x0 : nat, <affine> ⌜x = x0âŒ)
+ --------------------------------------∗
+ â–· False
+
+"test3_test"
+ : string
+1 subgoal
+
+ PROP : sbi
+ x : nat
+ ============================
+ "H" : ∃ x0 : nat, <affine> ⌜x = x0âŒ
+ --------------------------------------∗
+ â–· False
+
+1 subgoal
+
+ PROP : sbi
+ x : nat
+ ============================
+ "H" : â—‡ (∃ x0 : nat, <affine> ⌜x = x0âŒ)
+ --------------------------------------∗
+ â–· False
+
diff --git a/tests/telescopes.v b/tests/telescopes.v
new file mode 100644
index 0000000000000000000000000000000000000000..621e086dff47bb7aed49c11191c4f511fe1ad9fd
--- /dev/null
+++ b/tests/telescopes.v
@@ -0,0 +1,113 @@
+From stdpp Require Import coPset namespaces.
+From iris.proofmode Require Import tactics.
+Set Default Proof Using "Type".
+
+Section accessor.
+(* Just playing around a bit with a telescope version
+ of accessors with just one binder list. *)
+Definition accessor `{!BiFUpd PROP} {X : tele} (E1 E2 : coPset)
+ (α β γ : X → PROP) : PROP :=
+ (|={E1,E2}=> ∃.. x, α x ∗ (β x -∗ |={E2,E1}=> (γ x)))%I.
+
+Notation "'ACC' @ E1 , E2 {{ ∃ x1 .. xn , α | β | γ } }" :=
+ (accessor (X:=TeleS (fun x1 => .. (TeleS (fun xn => TeleO)) .. ))
+ E1 E2
+ (tele_app (TT:=TeleS (fun x1 => .. (TeleS (fun xn => TeleO)) .. )) $
+ fun x1 => .. (fun xn => α%I) ..)
+ (tele_app (TT:=TeleS (fun x1 => .. (TeleS (fun xn => TeleO)) .. )) $
+ fun x1 => .. (fun xn => β%I) ..)
+ (tele_app (TT:=TeleS (fun x1 => .. (TeleS (fun xn => TeleO)) .. )) $
+ fun x1 => .. (fun xn => γ%I) ..))
+ (at level 20, α, β, γ at level 200, x1 binder, xn binder, only parsing).
+
+(* Working with abstract telescopes. *)
+Section tests.
+Context `{!BiFUpd PROP} {X : tele}.
+Implicit Types α β γ : X → PROP.
+
+Lemma acc_mono E1 E2 α β γ1 γ2 :
+ (∀.. x, γ1 x -∗ γ2 x) -∗
+ accessor E1 E2 α β γ1 -∗ accessor E1 E2 α β γ2.
+Proof.
+ iIntros "Hγ12 >Hacc". iDestruct "Hacc" as (x') "[Hα Hclose]". Show.
+ iModIntro. iExists x'. iFrame. iIntros "Hβ".
+ iMod ("Hclose" with "Hβ") as "Hγ". iApply "Hγ12". auto.
+Qed.
+End tests.
+
+Section printing_tests.
+Context `{!BiFUpd PROP}.
+
+(* Working with concrete telescopes: Testing the reduction into normal quantifiers. *)
+Lemma acc_elim_test_1 E1 E2 :
+ ACC @ E1, E2 {{ ∃ a b : nat, <affine> ⌜a = b⌠| True | <affine> ⌜a ≠b⌠}}
+ ⊢@{PROP} |={E1}=> False.
+Proof.
+ iIntros ">H". Show.
+ iDestruct "H" as (a b) "[% Hclose]". iMod ("Hclose" with "[//]") as "%".
+ done.
+Qed.
+End printing_tests.
+End accessor.
+
+(* Robbert's tests *)
+Section telescopes_and_tactics.
+
+Definition test1 {PROP : sbi} {X : tele} (α : X → PROP) : PROP :=
+ (∃.. x, α x)%I.
+
+Notation "'TEST1' {{ ∃ x1 .. xn , α } }" :=
+ (test1 (X:=TeleS (fun x1 => .. (TeleS (fun xn => TeleO)) .. ))
+ (tele_app (TT:=TeleS (fun x1 => .. (TeleS (fun xn => TeleO)) .. )) $
+ fun x1 => .. (fun xn => α%I) ..))
+ (at level 20, α at level 200, x1 binder, xn binder, only parsing).
+
+Definition test2 {PROP : sbi} {X : tele} (α : X → PROP) : PROP :=
+ (▷ ∃.. x, α x)%I.
+
+Notation "'TEST2' {{ ∃ x1 .. xn , α } }" :=
+ (test2 (X:=TeleS (fun x1 => .. (TeleS (fun xn => TeleO)) .. ))
+ (tele_app (TT:=TeleS (fun x1 => .. (TeleS (fun xn => TeleO)) .. )) $
+ fun x1 => .. (fun xn => α%I) ..))
+ (at level 20, α at level 200, x1 binder, xn binder, only parsing).
+
+Definition test3 {PROP : sbi} {X : tele} (α : X → PROP) : PROP :=
+ (◇ ∃.. x, α x)%I.
+
+Notation "'TEST3' {{ ∃ x1 .. xn , α } }" :=
+ (test3 (X:=TeleS (fun x1 => .. (TeleS (fun xn => TeleO)) .. ))
+ (tele_app (TT:=TeleS (fun x1 => .. (TeleS (fun xn => TeleO)) .. )) $
+ fun x1 => .. (fun xn => α%I) ..))
+ (at level 20, α at level 200, x1 binder, xn binder, only parsing).
+
+Check "test1_test".
+Lemma test1_test {PROP : sbi} :
+ TEST1 {{ ∃ a b : nat, <affine> ⌜a = b⌠}} ⊢@{PROP} ▷ False.
+Proof.
+ iIntros "H". iDestruct "H" as (x) "H". Show.
+Restart.
+ iIntros "H". unfold test1. iDestruct "H" as (x) "H". Show.
+Abort.
+
+Check "test2_test".
+Lemma test2_test {PROP : sbi} :
+ TEST2 {{ ∃ a b : nat, <affine> ⌜a = b⌠}} ⊢@{PROP} ▷ False.
+Proof.
+ iIntros "H". iModIntro. Show.
+ iDestruct "H" as (x) "H". Show.
+Restart.
+ iIntros "H". iDestruct "H" as (x) "H". Show.
+Abort.
+
+Check "test3_test".
+Lemma test3_test {PROP : sbi} :
+ TEST3 {{ ∃ a b : nat, <affine> ⌜a = b⌠}} ⊢@{PROP} ▷ False.
+Proof.
+ iIntros "H". iMod "H".
+ iDestruct "H" as (x) "H".
+ Show.
+Restart.
+ iIntros "H". iDestruct "H" as (x) "H". Show.
+Abort.
+
+End telescopes_and_tactics.
diff --git a/tests/tree_sum.ref b/tests/tree_sum.ref
new file mode 100644
index 0000000000000000000000000000000000000000..e69de29bb2d1d6434b8b29ae775ad8c2e48c5391
diff --git a/theories/tests/tree_sum.v b/tests/tree_sum.v
similarity index 100%
rename from theories/tests/tree_sum.v
rename to tests/tree_sum.v
diff --git a/theories/algebra/auth.v b/theories/algebra/auth.v
index 87b5a7cc741f95400ad5e89ee56c68ef185bf530..a5f62158a55a59b9d1833d6f9d325f3d52627297 100644
--- a/theories/algebra/auth.v
+++ b/theories/algebra/auth.v
@@ -1,6 +1,6 @@
From iris.algebra Require Export excl local_updates.
+From iris.algebra Require Import proofmode_classes.
From iris.base_logic Require Import base_logic.
-From iris.proofmode Require Import classes.
Set Default Proof Using "Type".
Record auth (A : Type) := Auth { authoritative : excl' A; auth_own : A }.
@@ -154,7 +154,7 @@ Proof.
- by split; simpl; rewrite ?cmra_core_l.
- by split; simpl; rewrite ?cmra_core_idemp.
- intros ??; rewrite! auth_included; intros [??].
- by split; simpl; apply cmra_core_mono.
+ by split; simpl; apply: cmra_core_mono. (* FIXME: apply cmra_core_mono. fails *)
- assert (∀ n (a b1 b2 : A), b1 ⋅ b2 ≼{n} a → b1 ≼{n} a).
{ intros n a b1 b2 <-; apply cmra_includedN_l. }
intros n [[[a1|]|] b1] [[[a2|]|] b2]; rewrite auth_validN_eq;
diff --git a/theories/algebra/cmra.v b/theories/algebra/cmra.v
index b22018df5e54bc3cf9dc19960967d19d5ec27125..d0f5cffddae4dd32f4af0c050abf69f2a0c7d69f 100644
--- a/theories/algebra/cmra.v
+++ b/theories/algebra/cmra.v
@@ -170,16 +170,16 @@ Hint Mode IdFree + ! : typeclass_instances.
Instance: Params (@IdFree) 1.
(** * CMRAs whose core is total *)
-(** The function [core] may return a dummy when used on CMRAs without total
-core. *)
Class CmraTotal (A : cmraT) := cmra_total (x : A) : is_Some (pcore x).
Hint Mode CmraTotal ! : typeclass_instances.
+(** The function [core] returns a dummy when used on CMRAs without total
+core. *)
Class Core (A : Type) := core : A → A.
Hint Mode Core ! : typeclass_instances.
Instance: Params (@core) 2.
-Instance core' `{PCore A} : Core A := λ x, from_option id x (pcore x).
+Instance core' `{PCore A} : Core A := λ x, default x (pcore x).
Arguments core' _ _ _ /.
(** * CMRAs with a unit element *)
diff --git a/theories/algebra/coPset.v b/theories/algebra/coPset.v
index 653043cdf5fdd0e878221abb553bde799b8d299b..763ca1e299e4b2f9d099a30472f33013bdbb87f0 100644
--- a/theories/algebra/coPset.v
+++ b/theories/algebra/coPset.v
@@ -46,7 +46,7 @@ Section coPset.
Proof. split. done. intros X. by rewrite coPset_op_union left_id_L. done. Qed.
Canonical Structure coPsetUR := UcmraT coPset coPset_ucmra_mixin.
- Lemma coPset_opM X mY : X ⋅? mY = X ∪ from_option id ∅ mY.
+ Lemma coPset_opM X mY : X ⋅? mY = X ∪ default ∅ mY.
Proof. destruct mY; by rewrite /= ?right_id_L. Qed.
Lemma coPset_update X Y : X ~~> Y.
diff --git a/theories/algebra/cofe_solver.v b/theories/algebra/cofe_solver.v
index 0474eb3a8b2d9fdb32cb6695c2190976b04b3c0e..0b473a7925775b4b536967dedbb2d3fe349609b8 100644
--- a/theories/algebra/cofe_solver.v
+++ b/theories/algebra/cofe_solver.v
@@ -93,7 +93,7 @@ Proof using Fcontr. intros. by rewrite -(fg (X (S (S k)))) -(g_tower X). Qed.
Lemma ff_tower k i (X : tower) : ff i (X (S k)) ≡{k}≡ X (i + S k).
Proof using Fcontr.
intros; induction i as [|i IH]; simpl; [done|].
- by rewrite IH Nat.add_succ_r (dist_le _ _ _ _ (f_tower _ X)); last omega.
+ by rewrite IH Nat.add_succ_r (dist_le _ _ _ _ (f_tower _ X)); last lia.
Qed.
Lemma gg_tower k i (X : tower) : gg i (X (i + k)) ≡ X k.
Proof. by induction i as [|i IH]; simpl; [done|rewrite g_tower IH]. Qed.
diff --git a/theories/algebra/frac.v b/theories/algebra/frac.v
index c83f701175df6a20c8c4487f3df0831f45b659fd..d76652cc9f5877b92821a4f23c94fde1b079b667 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.algebra 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 b6fc071c4063b7bb5ed05bdb7f6269697d9b7bea..fdee147fee6c66e0285797c060a0fd28f7b98690 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.algebra Require Import proofmode_classes.
Definition frac_authR (A : cmraT) : cmraT :=
authR (optionUR (prodR fracR A)).
diff --git a/theories/algebra/functions.v b/theories/algebra/functions.v
index 6983a95f3fac022c900e358f5e119719934ccac4..e3c368d1ac93da666e9cb5beb6b2e5f6f8007a4d 100644
--- a/theories/algebra/functions.v
+++ b/theories/algebra/functions.v
@@ -17,6 +17,10 @@ Section ofe.
Implicit Types x : A.
Implicit Types f g : ofe_fun B.
+ Global Instance ofe_funC_ofe_discrete :
+ (∀ i, OfeDiscrete (B i)) → OfeDiscrete (ofe_funC B).
+ Proof. intros HB f f' Heq i. apply HB, Heq. Qed.
+
(** Properties of ofe_fun_insert. *)
Global Instance ofe_fun_insert_ne x :
NonExpansive2 (ofe_fun_insert (B:=B) x).
@@ -52,6 +56,10 @@ Section cmra.
Implicit Types x : A.
Implicit Types f g : ofe_fun B.
+ Global Instance ofe_funR_cmra_discrete:
+ (∀ i, CmraDiscrete (B i)) → CmraDiscrete (ofe_funR B).
+ Proof. intros HB. split; [apply _|]. intros x Hv i. apply HB, Hv. Qed.
+
Global Instance ofe_fun_singleton_ne x :
NonExpansive (ofe_fun_singleton x : B x → _).
Proof. intros n y1 y2 ?; apply ofe_fun_insert_ne. done. by apply equiv_dist. Qed.
diff --git a/theories/algebra/gmap.v b/theories/algebra/gmap.v
index fd4df4077a947e71a69c410b39c14357bbda90cc..54b81d30e5f50889455a07253819e54e677fbd3f 100644
--- a/theories/algebra/gmap.v
+++ b/theories/algebra/gmap.v
@@ -2,6 +2,7 @@ From iris.algebra Require Export cmra.
From stdpp Require Export gmap.
From iris.algebra Require Import updates local_updates.
From iris.base_logic Require Import base_logic.
+From iris.algebra Require Import proofmode_classes.
Set Default Proof Using "Type".
Section cofe.
@@ -236,6 +237,9 @@ Qed.
Lemma op_singleton (i : K) (x y : A) :
{[ i := x ]} â‹… {[ i := y ]} = ({[ i := x â‹… y ]} : gmap K A).
Proof. by apply (merge_singleton _ _ _ x y). Qed.
+Global Instance is_op_singleton i a a1 a2 :
+ IsOp a a1 a2 → IsOp' ({[ i := a ]} : gmap K A) {[ i := a1 ]} {[ i := a2 ]}.
+Proof. rewrite /IsOp' /IsOp=> ->. by rewrite -op_singleton. Qed.
Global Instance gmap_core_id m : (∀ x : A, CoreId x) → CoreId m.
Proof.
diff --git a/theories/algebra/gmultiset.v b/theories/algebra/gmultiset.v
index c3bcfa600b588e37e408b230df18b8e7f1ee8335..1916b8f40d6c83ecb507c9d9fdbaf1f39c49796e 100644
--- a/theories/algebra/gmultiset.v
+++ b/theories/algebra/gmultiset.v
@@ -55,7 +55,7 @@ Section gmultiset.
apply: discrete_cancelable=> Y Z _ ?. fold_leibniz. by apply (inj (X ∪)).
Qed.
- Lemma gmultiset_opM X mY : X ⋅? mY = X ∪ from_option id ∅ mY.
+ Lemma gmultiset_opM X mY : X ⋅? mY = X ∪ default ∅ mY.
Proof. destruct mY; by rewrite /= ?right_id_L. Qed.
Lemma gmultiset_update X Y : X ~~> Y.
@@ -74,7 +74,7 @@ Section gmultiset.
rewrite local_update_unital_discrete=> Z' _ /leibniz_equiv_iff->.
split. done. rewrite !gmultiset_op_union=> x.
repeat (rewrite multiplicity_difference || rewrite multiplicity_union).
- omega.
+ lia.
Qed.
End gmultiset.
diff --git a/theories/algebra/gset.v b/theories/algebra/gset.v
index 15555f38557751fcffca06472f6c077e06941b74..b4d5e520d84eacf0575e11b0c0b1c6f86a470050 100644
--- a/theories/algebra/gset.v
+++ b/theories/algebra/gset.v
@@ -45,7 +45,7 @@ Section gset.
Proof. split. done. intros X. by rewrite gset_op_union left_id_L. done. Qed.
Canonical Structure gsetUR := UcmraT (gset K) gset_ucmra_mixin.
- Lemma gset_opM X mY : X ⋅? mY = X ∪ from_option id ∅ mY.
+ Lemma gset_opM X mY : X ⋅? mY = X ∪ default ∅ mY.
Proof. destruct mY; by rewrite /= ?right_id_L. Qed.
Lemma gset_update X Y : X ~~> Y.
diff --git a/theories/algebra/list.v b/theories/algebra/list.v
index ec603646ce481741cec12a3427a1fa5c5c5cea27..c620e931f083f01dfd3dac9e28d803e2dc6dd121 100644
--- a/theories/algebra/list.v
+++ b/theories/algebra/list.v
@@ -56,7 +56,7 @@ Canonical Structure listC := OfeT (list A) list_ofe_mixin.
Program Definition list_chain
(c : chain listC) (x : A) (k : nat) : chain A :=
- {| chain_car n := from_option id x (c n !! k) |}.
+ {| chain_car n := default x (c n !! k) |}.
Next Obligation. intros c x k n i ?. by rewrite /= (chain_cauchy c n i). Qed.
Definition list_compl `{Cofe A} : Compl listC := λ c,
match c 0 with
@@ -68,11 +68,11 @@ Global Program Instance list_cofe `{Cofe A} : Cofe listC :=
Next Obligation.
intros ? n c; rewrite /compl /list_compl.
destruct (c 0) as [|x l] eqn:Hc0 at 1.
- { by destruct (chain_cauchy c 0 n); auto with omega. }
- rewrite -(λ H, length_ne _ _ _ (chain_cauchy c 0 n H)); last omega.
+ { by destruct (chain_cauchy c 0 n); auto with lia. }
+ rewrite -(λ H, length_ne _ _ _ (chain_cauchy c 0 n H)); last lia.
apply Forall2_lookup=> i. rewrite -dist_option_Forall2 list_lookup_fmap.
destruct (decide (i < length (c n))); last first.
- { rewrite lookup_seq_ge ?lookup_ge_None_2; auto with omega. }
+ { rewrite lookup_seq_ge ?lookup_ge_None_2; auto with lia. }
rewrite lookup_seq //= (conv_compl n (list_chain c _ _)) /=.
destruct (lookup_lt_is_Some_2 (c n) i) as [? Hcn]; first done.
by rewrite Hcn.
@@ -310,7 +310,7 @@ Section properties.
Lemma list_lookup_singletonM_ne i j x :
i ≠j →
({[ i := x ]} : list A) !! j = None ∨ ({[ i := x ]} : list A) !! j = Some ε.
- Proof. revert j; induction i; intros [|j]; naive_solver auto with omega. Qed.
+ Proof. revert j; induction i; intros [|j]; naive_solver auto with lia. Qed.
Lemma list_singletonM_validN n i x : ✓{n} ({[ i := x ]} : list A) ↔ ✓{n} x.
Proof.
rewrite list_lookup_validN. split.
@@ -354,7 +354,7 @@ Section properties.
x ~~>: P → (∀ y, P y → Q [y]) → [x] ~~>: Q.
Proof.
rewrite !cmra_total_updateP=> Hup HQ n lf /list_lookup_validN Hv.
- destruct (Hup n (from_option id ε (lf !! 0))) as (y&?&Hv').
+ destruct (Hup n (default ε (lf !! 0))) as (y&?&Hv').
{ move: (Hv 0). by destruct lf; rewrite /= ?right_id. }
exists [y]; split; first by auto.
apply list_lookup_validN=> i.
diff --git a/theories/algebra/local_updates.v b/theories/algebra/local_updates.v
index 6801268688cf11d35e1896a2ca5fde9644c806b1..32479f7998febcf33d80e75286fbf4b0e8cb1a35 100644
--- a/theories/algebra/local_updates.v
+++ b/theories/algebra/local_updates.v
@@ -179,7 +179,7 @@ Proof.
move=>Hex. apply local_update_unital=>n z /= Hy Heq. split; first done.
destruct z as [z|]; last done. exfalso.
move: Hy. rewrite Heq /= -Some_op=>Hy. eapply Hex.
- eapply cmra_validN_le. eapply Hy. omega.
+ eapply cmra_validN_le. eapply Hy. lia.
Qed.
(** * Natural numbers *)
diff --git a/theories/algebra/ofe.v b/theories/algebra/ofe.v
index 7810042a61a57f1de308b0e593d3aedb71acf6a6..e68cec85d735f12b325f6cc3e92d65da47e8ef24 100644
--- a/theories/algebra/ofe.v
+++ b/theories/algebra/ofe.v
@@ -1,5 +1,6 @@
From iris.algebra Require Export base.
Set Default Proof Using "Type".
+Set Primitive Projections.
(** This files defines (a shallow embedding of) the category of OFEs:
Complete ordered families of equivalences. This is a cartesian closed
@@ -33,25 +34,20 @@ Tactic Notation "ofe_subst" :=
| H:@dist ?A ?d ?n _ ?x |- _ => symmetry in H;setoid_subst_aux (@dist A d n) x
end.
-Section mixin.
- Local Set Primitive Projections.
- Record OfeMixin A `{Equiv A, Dist A} := {
- mixin_equiv_dist x y : x ≡ y ↔ ∀ n, x ≡{n}≡ y;
- mixin_dist_equivalence n : Equivalence (dist n);
- mixin_dist_S n x y : x ≡{S n}≡ y → x ≡{n}≡ y
- }.
-End mixin.
+Record OfeMixin A `{Equiv A, Dist A} := {
+ mixin_equiv_dist x y : x ≡ y ↔ ∀ n, x ≡{n}≡ y;
+ mixin_dist_equivalence n : Equivalence (dist n);
+ mixin_dist_S n x y : x ≡{S n}≡ y → x ≡{n}≡ y
+}.
(** Bundeled version *)
-Structure ofeT := OfeT' {
+Structure ofeT := OfeT {
ofe_car :> Type;
ofe_equiv : Equiv ofe_car;
ofe_dist : Dist ofe_car;
- ofe_mixin : OfeMixin ofe_car;
- _ : Type
+ ofe_mixin : OfeMixin ofe_car
}.
-Arguments OfeT' _ {_ _} _ _.
-Notation OfeT A m := (OfeT' A m A).
+Arguments OfeT _ {_ _} _.
Add Printing Constructor ofeT.
Hint Extern 0 (Equiv _) => eapply (@ofe_equiv _) : typeclass_instances.
Hint Extern 0 (Dist _) => eapply (@ofe_dist _) : typeclass_instances.
@@ -182,7 +178,7 @@ Section ofe.
Lemma conv_compl' `{Cofe A} n (c : chain A) : compl c ≡{n}≡ c (S n).
Proof.
transitivity (c n); first by apply conv_compl. symmetry.
- apply chain_cauchy. omega.
+ apply chain_cauchy. lia.
Qed.
Lemma discrete_iff n (x : A) `{!Discrete x} y : x ≡ y ↔ x ≡{n}≡ y.
@@ -296,16 +292,16 @@ Program Definition fixpoint_chain {A : ofeT} `{Inhabited A} (f : A → A)
`{!Contractive f} : chain A := {| chain_car i := Nat.iter (S i) f inhabitant |}.
Next Obligation.
intros A ? f ? n.
- induction n as [|n IH]=> -[|i] //= ?; try omega.
+ induction n as [|n IH]=> -[|i] //= ?; try lia.
- apply (contractive_0 f).
- - apply (contractive_S f), IH; auto with omega.
+ - apply (contractive_S f), IH; auto with lia.
Qed.
Program Definition fixpoint_def `{Cofe A, Inhabited A} (f : A → A)
`{!Contractive f} : A := compl (fixpoint_chain f).
Definition fixpoint_aux : seal (@fixpoint_def). by eexists. Qed.
-Definition fixpoint {A AC AiH} f {Hf} := unseal fixpoint_aux A AC AiH f Hf.
-Definition fixpoint_eq : @fixpoint = @fixpoint_def := seal_eq fixpoint_aux.
+Definition fixpoint {A AC AiH} f {Hf} := fixpoint_aux.(unseal) A AC AiH f Hf.
+Definition fixpoint_eq : @fixpoint = @fixpoint_def := fixpoint_aux.(seal_eq).
Section fixpoint.
Context `{Cofe A, Inhabited A} (f : A → A) `{!Contractive f}.
@@ -345,7 +341,7 @@ Section fixpoint.
intros ? [x Hx] Hincr Hlim. set (chcar i := Nat.iter (S i) f x).
assert (Hcauch : ∀ n i : nat, n ≤ i → chcar i ≡{n}≡ chcar n).
{ intros n. rewrite /chcar. induction n as [|n IH]=> -[|i] //=;
- eauto using contractive_0, contractive_S with omega. }
+ eauto using contractive_0, contractive_S with lia. }
set (fp2 := compl {| chain_cauchy := Hcauch |}).
assert (f fp2 ≡ fp2).
{ apply equiv_dist=>n. rewrite /fp2 (conv_compl n) /= /chcar.
@@ -860,7 +856,7 @@ Section discrete_ofe.
{ compl c := c 0 }.
Next Obligation.
intros n c. rewrite /compl /=;
- symmetry; apply (chain_cauchy c 0 n). omega.
+ symmetry; apply (chain_cauchy c 0 n). lia.
Qed.
End discrete_ofe.
@@ -909,7 +905,7 @@ Section option.
Canonical Structure optionC := OfeT (option A) option_ofe_mixin.
Program Definition option_chain (c : chain optionC) (x : A) : chain A :=
- {| chain_car n := from_option id x (c n) |}.
+ {| chain_car n := default x (c n) |}.
Next Obligation. intros c x n i ?; simpl. by destruct (chain_cauchy c n i). Qed.
Definition option_compl `{Cofe A} : Compl optionC := λ c,
match c 0 with Some x => Some (compl (option_chain c x)) | None => None end.
@@ -988,7 +984,7 @@ Proof.
Qed.
(** Later *)
-Inductive later (A : Type) : Type := Next { later_car : A }.
+Record later (A : Type) : Type := Next { later_car : A }.
Add Printing Constructor later.
Arguments Next {_} _.
Arguments later_car {_} _.
diff --git a/theories/algebra/proofmode_classes.v b/theories/algebra/proofmode_classes.v
new file mode 100644
index 0000000000000000000000000000000000000000..7ccebbe786a091147778f9ca798f9ab62a8b84a0
--- /dev/null
+++ b/theories/algebra/proofmode_classes.v
@@ -0,0 +1,54 @@
+From iris.proofmode Require Export classes.
+From iris.algebra Require Export cmra.
+
+(* 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.
+
+(* 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.
\ No newline at end of file
diff --git a/theories/base_logic/base_logic.v b/theories/base_logic/base_logic.v
index aba95bf6c22445487b0620b8d3bd3ef23167fb29..5059f6575fa7f53f83a3c406545d7ea703a88aca 100644
--- a/theories/base_logic/base_logic.v
+++ b/theories/base_logic/base_logic.v
@@ -1,20 +1,12 @@
-From iris.base_logic Require Export derived.
+From iris.base_logic Require Export derived proofmode.
+From iris.bi Require Export bi.
Set Default Proof Using "Type".
(* The trick of having multiple [uPred] modules, which are all exported in
another [uPred] module is by Jason Gross and described in:
https://sympa.inria.fr/sympa/arc/coq-club/2016-12/msg00069.html *)
Module Import uPred.
- Export upred.uPred.
- Export primitive.uPred.
+ Export base_logic.bi.uPred.
Export derived.uPred.
+ Export bi.bi.
End uPred.
-
-(* Hint DB for the logic *)
-Hint Resolve pure_intro : I.
-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 Immediate True_intro False_elim : I.
-Hint Immediate iff_refl internal_eq_refl' : I.
diff --git a/theories/base_logic/bi.v b/theories/base_logic/bi.v
new file mode 100644
index 0000000000000000000000000000000000000000..114d50904479e1fcef0359cf5962830cccd94887
--- /dev/null
+++ b/theories/base_logic/bi.v
@@ -0,0 +1,227 @@
+From iris.bi Require Export derived_connectives updates plainly.
+From iris.base_logic Require Export upred.
+Import uPred_primitive.
+
+(** BI instances for uPred, and re-stating the remaining primitive laws in terms
+of the BI interface. This file does *not* unseal. *)
+
+Definition uPred_emp {M} : uPred M := uPred_pure True.
+
+Local Existing Instance entails_po.
+
+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_sep uPred_wand
+ uPred_persistently.
+Proof.
+ split.
+ - exact: entails_po.
+ - exact: equiv_spec.
+ - exact: pure_ne.
+ - exact: and_ne.
+ - exact: or_ne.
+ - exact: impl_ne.
+ - exact: forall_ne.
+ - exact: exist_ne.
+ - exact: sep_ne.
+ - exact: wand_ne.
+ - exact: persistently_ne.
+ - exact: pure_intro.
+ - exact: pure_elim'.
+ - exact: @pure_forall_2.
+ - exact: and_elim_l.
+ - exact: and_elim_r.
+ - exact: and_intro.
+ - exact: or_intro_l.
+ - exact: or_intro_r.
+ - exact: or_elim.
+ - exact: impl_intro_r.
+ - exact: impl_elim_l'.
+ - exact: @forall_intro.
+ - exact: @forall_elim.
+ - exact: @exist_intro.
+ - exact: @exist_elim.
+ - exact: sep_mono.
+ - exact: True_sep_1.
+ - exact: True_sep_2.
+ - exact: sep_comm'.
+ - exact: sep_assoc'.
+ - exact: wand_intro_r.
+ - exact: wand_elim_l'.
+ - exact: persistently_mono.
+ - exact: persistently_idemp_2.
+ - (* emp ⊢ <pers> emp (ADMISSIBLE) *)
+ trans (uPred_forall (M:=M) (λ _ : False, uPred_persistently uPred_emp)).
+ + apply forall_intro=>[[]].
+ + etrans; first exact: persistently_forall_2.
+ apply persistently_mono. exact: pure_intro.
+ - exact: @persistently_forall_2.
+ - exact: @persistently_exist_1.
+ - (* <pers> P ∗ Q ⊢ <pers> P (ADMISSIBLE) *)
+ intros. etrans; first exact: sep_comm'.
+ etrans; last exact: True_sep_2.
+ apply sep_mono; last done.
+ exact: pure_intro.
+ - exact: persistently_and_sep_l_1.
+Qed.
+
+Lemma uPred_sbi_mixin (M : ucmraT) : SbiMixin
+ uPred_entails uPred_pure uPred_or uPred_impl
+ (@uPred_forall M) (@uPred_exist M) uPred_sep
+ uPred_persistently (@uPred_internal_eq M) uPred_later.
+Proof.
+ split.
+ - exact: later_contractive.
+ - exact: internal_eq_ne.
+ - exact: @internal_eq_refl.
+ - exact: @internal_eq_rewrite.
+ - exact: @fun_ext.
+ - exact: @sig_eq.
+ - exact: @discrete_eq_1.
+ - exact: @later_eq_1.
+ - exact: @later_eq_2.
+ - exact: later_mono.
+ - exact: later_intro.
+ - exact: @later_forall_2.
+ - exact: @later_exist_false.
+ - exact: later_sep_1.
+ - exact: later_sep_2.
+ - exact: later_persistently_1.
+ - exact: later_persistently_2.
+ - exact: later_false_em.
+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_emp_valid.
+
+Lemma uPred_plainly_mixin M : BiPlainlyMixin (uPredSI M) uPred_plainly.
+Proof.
+ split.
+ - exact: plainly_ne.
+ - exact: plainly_mono.
+ - exact: plainly_elim_persistently.
+ - exact: plainly_idemp_2.
+ - exact: @plainly_forall_2.
+ - exact: persistently_impl_plainly.
+ - exact: plainly_impl_plainly.
+ - (* P ⊢ ■emp (ADMISSIBLE) *)
+ intros P.
+ trans (uPred_forall (M:=M) (λ _ : False , uPred_plainly uPred_emp)).
+ + apply forall_intro=>[[]].
+ + etrans; first exact: plainly_forall_2.
+ apply plainly_mono. exact: pure_intro.
+ - (* ■P ∗ Q ⊢ ■P (ADMISSIBLE) *)
+ intros P Q. etrans; last exact: True_sep_2.
+ etrans; first exact: sep_comm'.
+ apply sep_mono; last done.
+ exact: pure_intro.
+ - exact: prop_ext.
+ - exact: later_plainly_1.
+ - exact: later_plainly_2.
+Qed.
+Global Instance uPred_plainlyC M : BiPlainly (uPredSI M) :=
+ {| bi_plainly_mixin := uPred_plainly_mixin M |}.
+
+Lemma uPred_bupd_mixin M : BiBUpdMixin (uPredI M) uPred_bupd.
+Proof.
+ split.
+ - exact: bupd_ne.
+ - exact: bupd_intro.
+ - exact: bupd_mono.
+ - exact: bupd_trans.
+ - exact: bupd_frame_r.
+Qed.
+Global Instance uPred_bi_bupd M : BiBUpd (uPredI M) := {| bi_bupd_mixin := uPred_bupd_mixin M |}.
+
+Global Instance uPred_bi_bupd_plainly M : BiBUpdPlainly (uPredSI M).
+Proof. exact: bupd_plainly. Qed.
+
+(** extra BI instances *)
+
+Global Instance uPred_affine : BiAffine (uPredI M) | 0.
+Proof. intros P Q. exact: pure_intro. Qed.
+(* Also add this to the global hint database, otherwise [eauto] won't work for
+many lemmas that have [BiAffine] as a premise. *)
+Hint Immediate uPred_affine.
+
+Global Instance uPred_plainly_exist_1 : BiPlainlyExist (uPredSI M).
+Proof. exact: @plainly_exist_1. Qed.
+
+(** Re-state/export lemmas about Iris-specific primitive connectives (own, valid) *)
+
+Module uPred.
+
+Section restate.
+Context {M : ucmraT}.
+Implicit Types φ : Prop.
+Implicit Types P Q : uPred M.
+Implicit Types A : Type.
+
+(* 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).
+
+Global Instance ownM_ne : NonExpansive (@uPred_ownM M) := uPred_primitive.ownM_ne.
+Global Instance cmra_valid_ne {A : cmraT} : NonExpansive (@uPred_cmra_valid M A)
+ := uPred_primitive.cmra_valid_ne.
+
+(** Re-exporting primitive Own and valid lemmas *)
+Lemma ownM_op (a1 a2 : M) :
+ uPred_ownM (a1 ⋅ a2) ⊣⊢ uPred_ownM a1 ∗ uPred_ownM a2.
+Proof. exact: uPred_primitive.ownM_op. Qed.
+Lemma persistently_ownM_core (a : M) : uPred_ownM a ⊢ <pers> uPred_ownM (core a).
+Proof. exact: uPred_primitive.persistently_ownM_core. Qed.
+Lemma ownM_unit P : P ⊢ (uPred_ownM ε).
+Proof. exact: uPred_primitive.ownM_unit. Qed.
+Lemma later_ownM a : ▷ uPred_ownM a ⊢ ∃ b, uPred_ownM b ∧ ▷ (a ≡ b).
+Proof. exact: uPred_primitive.later_ownM. Qed.
+Lemma bupd_ownM_updateP x (Φ : M → Prop) :
+ x ~~>: Φ → uPred_ownM x ⊢ |==> ∃ y, ⌜Φ y⌠∧ uPred_ownM y.
+Proof. exact: uPred_primitive.bupd_ownM_updateP. Qed.
+
+Lemma ownM_valid (a : M) : uPred_ownM a ⊢ ✓ a.
+Proof. exact: uPred_primitive.ownM_valid. Qed.
+Lemma cmra_valid_intro {A : cmraT} P (a : A) : ✓ a → P ⊢ (✓ a).
+Proof. exact: uPred_primitive.cmra_valid_intro. Qed.
+Lemma cmra_valid_elim {A : cmraT} (a : A) : ¬ ✓{0} a → ✓ a ⊢ False.
+Proof. exact: uPred_primitive.cmra_valid_elim. Qed.
+Lemma plainly_cmra_valid_1 {A : cmraT} (a : A) : ✓ a ⊢ ■✓ a.
+Proof. exact: uPred_primitive.plainly_cmra_valid_1. Qed.
+Lemma cmra_valid_weaken {A : cmraT} (a b : A) : ✓ (a ⋅ b) ⊢ ✓ a.
+Proof. exact: uPred_primitive.cmra_valid_weaken. Qed.
+Lemma prod_validI {A B : cmraT} (x : A * B) : ✓ x ⊣⊢ ✓ x.1 ∧ ✓ x.2.
+Proof. exact: uPred_primitive.prod_validI. Qed.
+Lemma option_validI {A : cmraT} (mx : option A) :
+ ✓ mx ⊣⊢ match mx with Some x => ✓ x | None => True : uPred M end.
+Proof. exact: uPred_primitive.option_validI. Qed.
+Lemma discrete_valid {A : cmraT} `{!CmraDiscrete A} (a : A) : ✓ a ⊣⊢ ⌜✓ aâŒ.
+Proof. exact: uPred_primitive.discrete_valid. Qed.
+Lemma ofe_fun_validI `{B : A → ucmraT} (g : ofe_fun B) : ✓ g ⊣⊢ ∀ i, ✓ g i.
+Proof. exact: uPred_primitive.ofe_fun_validI. Qed.
+
+(** Consistency/soundness statement *)
+Lemma soundness_iter φ n : Nat.iter n sbi_later (⌜ φ ⌠: uPred M)%I → φ.
+Proof. exact: uPred_primitive.soundness. Qed.
+
+End restate.
+
+(** New unseal tactic that also unfolds the BI layer.
+ This is used by [base_logic.double_negation].
+ TODO: Can we get rid of this? *)
+Ltac unseal := (* Coq unfold is used to circumvent bug #5699 in rewrite /foo *)
+ unfold bi_emp; simpl; unfold sbi_emp; simpl;
+ unfold uPred_emp, bupd, bi_bupd_bupd, bi_pure,
+ bi_and, bi_or, bi_impl, bi_forall, bi_exist,
+ bi_sep, bi_wand, bi_persistently, sbi_internal_eq, sbi_later; simpl;
+ unfold sbi_emp, sbi_pure, sbi_and, sbi_or, sbi_impl, sbi_forall, sbi_exist,
+ sbi_internal_eq, sbi_sep, sbi_wand, sbi_persistently; simpl;
+ unfold plainly, bi_plainly_plainly; simpl;
+ uPred_primitive.unseal.
+
+End uPred.
diff --git a/theories/base_logic/big_op.v b/theories/base_logic/big_op.v
deleted file mode 100644
index 02d819a9a00a5cac07d41010ce9474ff2af2bf79..0000000000000000000000000000000000000000
--- a/theories/base_logic/big_op.v
+++ /dev/null
@@ -1,633 +0,0 @@
-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.
-Set Default Proof Using "Type".
-Import uPred.
-
-(* Notations *)
-Notation "'[∗' 'list]' k ↦ x ∈ l , P" := (big_opL uPred_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)
- (at level 200, l at level 10, x at level 1, right associativity,
- format "[∗ list] x ∈ l , P") : uPred_scope.
-
-Notation "'[∗]' Ps" :=
- (big_opL uPred_sep (λ _ x, x) Ps) (at level 20) : uPred_scope.
-
-Notation "'[∗' 'map]' k ↦ x ∈ m , P" := (big_opM uPred_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)
- (at level 200, m at level 10, x at level 1, right associativity,
- format "[∗ map] x ∈ m , P") : uPred_scope.
-
-Notation "'[∗' 'set]' x ∈ X , P" := (big_opS uPred_sep (λ x, P) X)
- (at level 200, X at level 10, x at level 1, right associativity,
- format "[∗ set] x ∈ X , P") : uPred_scope.
-
-Notation "'[∗' 'mset]' x ∈ X , P" := (big_opMS uPred_sep (λ x, P) X)
- (at level 200, X at level 10, x at level 1, right associativity,
- format "[∗ mset] x ∈ X , P") : uPred_scope.
-
-(** * Properties *)
-Section big_op.
-Context {M : ucmraT}.
-Implicit Types Ps Qs : list (uPred M).
-Implicit Types A : Type.
-
-(** ** Big ops over lists *)
-Section list.
- Context {A : Type}.
- Implicit Types l : list A.
- Implicit Types Φ Ψ : nat → A → uPred M.
-
- Lemma big_sepL_nil Φ : ([∗ list] k↦y ∈ nil, Φ k y) ⊣⊢ True.
- Proof. done. Qed.
- Lemma big_sepL_nil' P Φ : P ⊢ [∗ list] k↦y ∈ nil, Φ k y.
- Proof. apply True_intro. 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.
- Lemma big_sepL_singleton Φ x : ([∗ list] k↦y ∈ [x], Φ k y) ⊣⊢ Φ 0 x.
- Proof. by rewrite big_opL_singleton. Qed.
- Lemma big_sepL_app Φ l1 l2 :
- ([∗ list] k↦y ∈ l1 ++ l2, Φ k y)
- ⊣⊢ ([∗ list] k↦y ∈ l1, Φ k y) ∗ ([∗ list] k↦y ∈ l2, Φ (length l1 + k) y).
- Proof. by rewrite big_opL_app. Qed.
-
- Lemma big_sepL_mono Φ Ψ l :
- (∀ 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_forall; apply _. Qed.
- Lemma big_sepL_proper Φ Ψ l :
- (∀ 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 :
- l1 ⊆+ l2 → ([∗ list] y ∈ l2, Φ y) ⊢ [∗ list] y ∈ l1, Φ y.
- 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)).
- 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)).
- Proof. by induction 1 as [|P Q Ps Qs HPQ ? IH]; rewrite /= ?HPQ ?IH. 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)).
- Proof.
- intros Hli. rewrite -(take_drop_middle l i x) // big_sepL_app /=.
- rewrite Nat.add_0_r take_length_le; eauto using lookup_lt_Some, Nat.lt_le_incl.
- rewrite assoc -!(comm _ (Φ _ _)) -assoc. by apply sep_mono_r, wand_intro_l.
- Qed.
-
- Lemma big_sepL_lookup Φ l 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.
-
- Lemma big_sepL_elem_of (Φ : A → uPred M) l 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 :
- ([∗ list] k↦y ∈ f <$> l, Φ k y) ⊣⊢ ([∗ list] k↦y ∈ l, Φ k (f y)).
- Proof. by rewrite big_opL_fmap. Qed.
-
- Lemma big_sepL_sepL Φ Ψ l :
- ([∗ list] k↦x ∈ l, Φ k x ∗ Ψ k x)
- ⊣⊢ ([∗ list] k↦x ∈ l, Φ k x) ∗ ([∗ list] k↦x ∈ l, Ψ k x).
- Proof. by rewrite big_opL_opL. Qed.
-
- 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.
-
- Lemma big_sepL_persistently Φ 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 :
- (∀ 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.
- - 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.
- 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.
- Qed.
-
- Lemma big_sepL_delete Φ l i x :
- l !! i = Some x →
- ([∗ list] k↦y ∈ l, Φ k y) ⊣⊢ Φ i x ∗ [∗ list] k↦y ∈ l, ⌜ k ≠i ⌠→ Φ k y.
- Proof.
- intros. rewrite -(take_drop_middle l i x) // !big_sepL_app /= Nat.add_0_r.
- rewrite take_length_le; last eauto using lookup_lt_Some, Nat.lt_le_incl.
- rewrite pure_False; last by intros []. rewrite False_impl left_id.
- rewrite assoc -!(comm _ (Φ _ _)) -assoc. do 2 f_equiv.
- - apply big_sepL_proper=> k y Hk. apply lookup_lt_Some in Hk.
- rewrite take_length in Hk. by rewrite pure_True ?True_impl; last lia.
- - apply big_sepL_proper=> k y _. by rewrite pure_True ?True_impl; last lia.
- Qed.
-
- Global Instance big_sepL_nil_plain Φ : Plain ([∗ list] k↦x ∈ [], Φ k x).
- Proof. simpl; apply _. Qed.
- Global Instance big_sepL_plain Φ l :
- (∀ k x, Plain (Φ k x)) → Plain ([∗ list] k↦x ∈ l, Φ k x).
- Proof. revert Φ. induction l as [|x l IH]=> Φ ? /=; apply _. Qed.
- Global Instance big_sepL_plain_id Ps : TCForall Plain Ps → Plain ([∗] Ps).
- Proof. induction 1; simpl; apply _. Qed.
-
- Global Instance big_sepL_nil_persistent Φ :
- Persistent ([∗ list] k↦x ∈ [], Φ k x).
- Proof. simpl; apply _. Qed.
- Global Instance big_sepL_persistent Φ 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 :
- 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.
- (* 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)).
- 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.
- Qed.
-End list2.
-
-(** ** Big ops over finite maps *)
-Section gmap.
- Context `{Countable K} {A : Type}.
- Implicit Types m : gmap K A.
- Implicit Types Φ Ψ : K → A → uPred M.
-
- 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_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.
-
- 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.
-
- Lemma big_sepM_empty Φ : ([∗ map] k↦x ∈ ∅, Φ k x) ⊣⊢ True.
- 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_insert Φ m i x :
- m !! i = None →
- ([∗ map] k↦y ∈ <[i:=x]> m, Φ k y) ⊣⊢ Φ i x ∗ [∗ map] k↦y ∈ m, Φ k y.
- Proof. apply big_opM_insert. Qed.
-
- Lemma big_sepM_delete Φ m i x :
- m !! i = Some x →
- ([∗ map] k↦y ∈ m, Φ k y) ⊣⊢ Φ i x ∗ [∗ map] k↦y ∈ delete i m, Φ k y.
- Proof. apply big_opM_delete. Qed.
-
- Lemma big_sepM_lookup_acc Φ m i x :
- m !! i = Some x →
- ([∗ map] k↦y ∈ m, Φ k y) ⊢ Φ i x ∗ (Φ i x -∗ ([∗ map] k↦y ∈ m, Φ k y)).
- Proof.
- intros. rewrite big_sepM_delete //. by apply sep_mono_r, wand_intro_l.
- Qed.
-
- Lemma big_sepM_lookup Φ m 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 :
- 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 :
- ([∗ map] k↦y ∈ f <$> m, Φ k y) ⊣⊢ ([∗ map] k↦y ∈ m, Φ k (f y)).
- Proof. by rewrite big_opM_fmap. Qed.
-
- Lemma big_sepM_insert_override Φ m i x x' :
- m !! i = Some x → (Φ i x ⊣⊢ Φ i x') →
- ([∗ map] k↦y ∈ <[i:=x']> m, Φ k y) ⊣⊢ ([∗ map] k↦y ∈ m, Φ k y).
- Proof. apply big_opM_insert_override. Qed.
-
- Lemma big_sepM_insert_override_1 Φ m i x x' :
- m !! i = Some x →
- ([∗ map] k↦y ∈ <[i:=x']> m, Φ k y) ⊢
- (Φ i x' -∗ Φ i x) -∗ ([∗ map] k↦y ∈ m, Φ k y).
- Proof.
- intros ?. apply wand_intro_l.
- rewrite -insert_delete big_sepM_insert ?lookup_delete //.
- by rewrite assoc wand_elim_l -big_sepM_delete.
- Qed.
-
- Lemma big_sepM_insert_override_2 Φ m i x x' :
- m !! i = Some x →
- ([∗ map] k↦y ∈ m, Φ k y) ⊢
- (Φ i x -∗ Φ i x') -∗ ([∗ map] k↦y ∈ <[i:=x']> m, Φ k y).
- Proof.
- intros ?. apply wand_intro_l.
- rewrite {1}big_sepM_delete //; rewrite assoc wand_elim_l.
- 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 :
- 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 :
- 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.
-
- Lemma big_sepM_sepM Φ Ψ m :
- ([∗ map] k↦x ∈ m, Φ k x ∗ Ψ k x)
- ⊣⊢ ([∗ map] k↦x ∈ m, Φ k x) ∗ ([∗ map] k↦x ∈ m, Ψ k x).
- Proof. apply big_opM_opM. Qed.
-
- 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.
-
- 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 :
- (□ [∗ 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 :
- (∀ 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; auto using big_sepM_empty'.
- rewrite big_sepM_insert // -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.
- apply impl_intro_l, pure_elim_l=> ?.
- rewrite lookup_insert_ne; last by intros ?; simplify_map_eq.
- by rewrite pure_True // True_impl.
- 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.
- 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.
- Qed.
-
- Global Instance big_sepM_empty_plain Φ : Plain ([∗ map] k↦x ∈ ∅, Φ k x).
- Proof. rewrite /big_opM map_to_list_empty. apply _. Qed.
- Global Instance big_sepM_plain Φ m :
- (∀ k x, Plain (Φ k x)) → Plain ([∗ map] k↦x ∈ m, Φ k x).
- Proof. intros. apply big_sepL_plain=> _ [??]; apply _. Qed.
-
- Global Instance big_sepM_empty_persistent Φ :
- Persistent ([∗ map] k↦x ∈ ∅, Φ k x).
- Proof. rewrite /big_opM map_to_list_empty. apply _. Qed.
- Global Instance big_sepM_persistent Φ 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.
-
-
-(** ** Big ops over finite sets *)
-Section gset.
- Context `{Countable A}.
- Implicit Types X : gset A.
- Implicit Types Φ : A → uPred M.
-
- 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_proper Φ Ψ X :
- (∀ x, x ∈ X → Φ x ⊣⊢ Ψ x) →
- ([∗ set] x ∈ X, Φ x) ⊣⊢ ([∗ set] x ∈ X, Ψ x).
- Proof. apply big_opS_proper. 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.
-
- Lemma big_sepS_empty Φ : ([∗ set] x ∈ ∅, Φ x) ⊣⊢ True.
- 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_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 :
- x ∉ X →
- ([∗ set] y ∈ {[ x ]} ∪ X, Ψ y (<[x:=b]> f y))
- ⊣⊢ (Ψ x b ∗ [∗ set] y ∈ X, Ψ y (f y)).
- Proof. apply big_opS_fn_insert. Qed.
-
- Lemma big_sepS_fn_insert' Φ X x P :
- x ∉ X → ([∗ set] y ∈ {[ x ]} ∪ X, <[x:=P]> Φ y) ⊣⊢ (P ∗ [∗ set] y ∈ X, Φ y).
- Proof. apply big_opS_fn_insert'. Qed.
-
- Lemma big_sepS_union Φ X Y :
- X ## Y →
- ([∗ set] y ∈ X ∪ Y, Φ y) ⊣⊢ ([∗ set] y ∈ X, Φ y) ∗ ([∗ set] y ∈ Y, Φ y).
- Proof. apply big_opS_union. Qed.
-
- Lemma big_sepS_delete Φ X x :
- 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_acc Φ X x :
- x ∈ X →
- ([∗ set] y ∈ X, Φ y) ⊢ Φ x ∗ (Φ x -∗ ([∗ set] y ∈ X, Φ y)).
- Proof.
- intros. rewrite big_sepS_delete //. by apply sep_mono_r, wand_intro_l.
- Qed.
-
- 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).
- 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.
- - rewrite filter_union_L filter_singleton_not_L // left_id_L.
- by rewrite !big_sepS_insert // IH pure_False // False_impl left_id.
- Qed.
-
- 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).
- 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.
- 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.
-
- Lemma big_sepS_laterN Φ n X :
- ▷^n ([∗ set] y ∈ X, Φ y) ⊣⊢ ([∗ set] y ∈ X, ▷^n Φ 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 :
- (∀ 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; auto using big_sepS_empty'.
- rewrite big_sepS_insert // -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.
- 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.
- Qed.
-
- Global Instance big_sepS_empty_plain Φ : Plain ([∗ set] x ∈ ∅, Φ x).
- Proof. rewrite /big_opS elements_empty. apply _. Qed.
- Global Instance big_sepS_plain Φ X :
- (∀ x, Plain (Φ x)) → Plain ([∗ set] x ∈ X, Φ x).
- Proof. rewrite /big_opS. apply _. Qed.
-
- Global Instance big_sepS_empty_persistent Φ : Persistent ([∗ set] x ∈ ∅, Φ x).
- Proof. rewrite /big_opS elements_empty. apply _. Qed.
- Global Instance big_sepS_persistent Φ 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) :
- ([∗ map] k↦_ ∈ m, Φ k) ⊣⊢ ([∗ set] k ∈ dom _ m, Φ k).
-Proof. apply big_opM_dom. Qed.
-
-
-(** ** Big ops over finite multisets *)
-Section gmultiset.
- Context `{Countable A}.
- Implicit Types X : gmultiset A.
- Implicit Types Φ : A → uPred M.
-
- 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_proper Φ Ψ X :
- (∀ x, x ∈ X → Φ x ⊣⊢ Ψ x) →
- ([∗ mset] x ∈ X, Φ x) ⊣⊢ ([∗ mset] x ∈ X, Ψ x).
- Proof. apply big_opMS_proper. 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.
-
- Lemma big_sepMS_empty Φ : ([∗ mset] x ∈ ∅, Φ x) ⊣⊢ True.
- 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_union Φ X Y :
- ([∗ mset] y ∈ X ∪ Y, Φ y) ⊣⊢ ([∗ mset] y ∈ X, Φ y) ∗ [∗ mset] y ∈ Y, Φ y.
- Proof. apply big_opMS_union. Qed.
-
- Lemma big_sepMS_delete Φ X x :
- 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.
- Proof. intros. by rewrite big_sepMS_delete // sep_elim_l. Qed.
-
- Lemma big_sepMS_elem_of_acc Φ X x :
- x ∈ X →
- ([∗ mset] y ∈ X, Φ y) ⊢ Φ x ∗ (Φ x -∗ ([∗ mset] y ∈ X, Φ y)).
- Proof.
- intros. rewrite big_sepMS_delete //. by apply sep_mono_r, wand_intro_l.
- Qed.
-
- Lemma big_sepMS_singleton Φ x : ([∗ mset] y ∈ {[ x ]}, Φ y) ⊣⊢ Φ x.
- Proof. apply big_opMS_singleton. Qed.
-
- Lemma big_sepMS_sepMS Φ Ψ X :
- ([∗ mset] y ∈ X, Φ y ∗ Ψ y) ⊣⊢ ([∗ mset] y ∈ X, Φ y) ∗ ([∗ mset] y ∈ X, Ψ y).
- Proof. apply big_opMS_opMS. Qed.
-
- 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.
-
- Lemma big_sepMS_later Φ 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.
-
- Lemma big_sepMS_persistently Φ 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).
- Proof. apply (big_opMS_commute _). Qed.
-
- Global Instance big_sepMS_empty_plain Φ : Plain ([∗ mset] x ∈ ∅, Φ x).
- Proof. rewrite /big_opMS gmultiset_elements_empty. apply _. Qed.
- Global Instance big_sepMS_plain Φ X :
- (∀ x, Plain (Φ x)) → Plain ([∗ mset] x ∈ X, Φ x).
- Proof. rewrite /big_opMS. apply _. 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.
diff --git a/theories/base_logic/deprecated.v b/theories/base_logic/deprecated.v
deleted file mode 100644
index 3a3b9c86208c569e9855f1bd64d0f11950bd9667..0000000000000000000000000000000000000000
--- a/theories/base_logic/deprecated.v
+++ /dev/null
@@ -1,12 +0,0 @@
-From iris.base_logic Require Import primitive.
-Set Default Proof Using "Type".
-
-(* Deprecated 2016-11-22. Use ⌜φ⌠instead. *)
-Notation "■φ" := (uPred_pure φ%stdpp%type)
- (at level 20, right associativity, only parsing) : uPred_scope.
-
-(* Deprecated 2016-11-22. Use ⌜x = y⌠instead. *)
-Notation "x = y" := (uPred_pure (x%stdpp%type = y%stdpp%type)) (only parsing) : uPred_scope.
-
-(* Deprecated 2016-11-22. Use ⌜x ## y ⌠instead. *)
-Notation "x ## y" := (uPred_pure (x%stdpp%type ## y%stdpp%type)) (only parsing) : uPred_scope.
diff --git a/theories/base_logic/derived.v b/theories/base_logic/derived.v
index 65187b820e61951340e7a812ab64671f96316524..d3ff12d81d6622b48e7e5a107fbfd1e62512dab8 100644
--- a/theories/base_logic/derived.v
+++ b/theories/base_logic/derived.v
@@ -1,48 +1,10 @@
-From iris.base_logic Require Export primitive.
+From iris.base_logic Require Export bi.
+From iris.bi Require Export bi.
Set Default Proof Using "Type".
-Import upred.uPred primitive.uPred.
+Import bi base_logic.bi.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) := timeless : ▷ P ⊢ ◇ P.
-Arguments timeless {_} _ {_}.
-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.
-
-Class Plain {M} (P : uPred M) := plain : P ⊢ ■P.
-Arguments plain {_} _ {_}.
-Hint Mode Plain + ! : typeclass_instances.
-Instance: Params (@Plain) 1.
+(** Derived laws for Iris-specific primitive connectives (own, valid).
+ This file does NOT unseal! *)
Module uPred.
Section derived.
@@ -50,1149 +12,95 @@ 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.
- rewrite (internal_eq_rewrite a b (λ b, b ≡ a)%I ltac:(solve_proper)).
- by rewrite -internal_eq_refl True_impl.
-Qed.
-Lemma f_equiv {A B : ofeT} (f : A → B) `{!NonExpansive f} x y :
- x ≡ y ⊢ f x ≡ f y.
-Proof.
- rewrite (internal_eq_rewrite x y (λ y, f x ≡ f y)%I ltac:(solve_proper)).
- by rewrite -internal_eq_refl True_impl.
-Qed.
-Lemma internal_eq_rewrite_contractive {A : ofeT} a b (Ψ : A → uPred M)
- {HΨ : Contractive Ψ} : ▷ (a ≡ b) ⊢ Ψ a → Ψ b.
-Proof. move: HΨ=> /contractiveI ->. by rewrite (internal_eq_rewrite _ _ id). 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.
- rewrite (internal_eq_rewrite P Q (λ Q, P ↔ Q)%I ltac:(solve_proper)).
- by rewrite -(iff_refl True) True_impl.
-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.
-
-(* Plainness modality *)
-Global Instance plainly_mono' : Proper ((⊢) ==> (⊢)) (@uPred_plainly M).
-Proof. intros P Q; apply plainly_mono. Qed.
-Global Instance naugth_flip_mono' :
- Proper (flip (⊢) ==> flip (⊢)) (@uPred_plainly M).
-Proof. intros P Q; apply plainly_mono. Qed.
-
-Lemma plainly_elim P : ■P ⊢ P.
-Proof. by rewrite plainly_elim' persistently_elim. Qed.
-Hint Resolve plainly_mono plainly_elim.
-Lemma plainly_intro' P Q : (■P ⊢ Q) → ■P ⊢ ■Q.
-Proof. intros <-. apply plainly_idemp. Qed.
-Lemma plainly_idemp P : ■■P ⊣⊢ ■P.
-Proof. apply (anti_symm _); auto using plainly_idemp. Qed.
-
-Lemma persistently_plainly P : □ ■P ⊣⊢ ■P.
-Proof.
- apply (anti_symm _); auto using persistently_elim.
- by rewrite -plainly_elim' plainly_idemp.
-Qed.
-Lemma plainly_persistently P : ■□ P ⊣⊢ ■P.
-Proof.
- apply (anti_symm _); auto using plainly_mono, persistently_elim.
- by rewrite -plainly_elim' plainly_idemp.
-Qed.
-
-Lemma plainly_pure φ : ■⌜φ⌠⊣⊢ ⌜φâŒ.
-Proof.
- apply (anti_symm _); auto.
- apply pure_elim'=> Hφ.
- trans (∀ x : False, ■True : uPred M)%I; [by apply forall_intro|].
- rewrite plainly_forall_2. auto using plainly_mono, pure_intro.
-Qed.
-Lemma plainly_forall {A} (Ψ : A → uPred M) : (■∀ a, Ψ a) ⊣⊢ (∀ a, ■Ψ a).
-Proof.
- apply (anti_symm _); auto using plainly_forall_2.
- apply forall_intro=> x. by rewrite (forall_elim x).
-Qed.
-Lemma plainly_exist {A} (Ψ : A → uPred M) : (■∃ a, Ψ a) ⊣⊢ (∃ a, ■Ψ a).
-Proof.
- apply (anti_symm _); auto using plainly_exist_1.
- apply exist_elim=> x. by rewrite (exist_intro x).
-Qed.
-Lemma plainly_and P Q : ■(P ∧ Q) ⊣⊢ ■P ∧ ■Q.
-Proof. rewrite !and_alt plainly_forall. by apply forall_proper=> -[]. Qed.
-Lemma plainly_or P Q : ■(P ∨ Q) ⊣⊢ ■P ∨ ■Q.
-Proof. rewrite !or_alt plainly_exist. by apply exist_proper=> -[]. Qed.
-Lemma plainly_impl P Q : ■(P → Q) ⊢ ■P → ■Q.
-Proof.
- apply impl_intro_l; rewrite -plainly_and.
- apply plainly_mono, impl_elim with P; auto.
-Qed.
-Lemma plainly_internal_eq {A:ofeT} (a b : A) : ■(a ≡ b) ⊣⊢ a ≡ b.
-Proof.
- apply (anti_symm (⊢)); auto using persistently_elim.
- rewrite {1}(internal_eq_rewrite a b (λ b, ■(a ≡ b))%I ltac:(solve_proper)).
- by rewrite -internal_eq_refl plainly_pure True_impl.
-Qed.
-
-Lemma plainly_and_sep_l_1 P Q : ■P ∧ Q ⊢ ■P ∗ Q.
-Proof. by rewrite -persistently_plainly persistently_and_sep_l_1. Qed.
-Lemma plainly_and_sep_l' P Q : ■P ∧ Q ⊣⊢ ■P ∗ Q.
-Proof. apply (anti_symm (⊢)); auto using plainly_and_sep_l_1. Qed.
-Lemma plainly_and_sep_r' P Q : P ∧ ■Q ⊣⊢ P ∗ ■Q.
-Proof. by rewrite !(comm _ P) plainly_and_sep_l'. Qed.
-Lemma plainly_sep_dup' P : ■P ⊣⊢ ■P ∗ ■P.
-Proof. by rewrite -plainly_and_sep_l' idemp. Qed.
-Lemma plainly_and_sep P Q : ■(P ∧ Q) ⊣⊢ ■(P ∗ Q).
-Proof.
- apply (anti_symm (⊢)); auto.
- rewrite -{1}plainly_idemp plainly_and plainly_and_sep_l'; auto.
-Qed.
-Lemma plainly_sep P Q : ■(P ∗ Q) ⊣⊢ ■P ∗ ■Q.
-Proof. by rewrite -plainly_and_sep -plainly_and_sep_l' plainly_and. Qed.
-
-Lemma plainly_wand P Q : ■(P -∗ Q) ⊢ ■P -∗ ■Q.
-Proof. by apply wand_intro_r; rewrite -plainly_sep wand_elim_l. Qed.
-Lemma plainly_impl_wand P Q : ■(P → Q) ⊣⊢ ■(P -∗ Q).
-Proof.
- apply (anti_symm (⊢)); [by rewrite -impl_wand_1|].
- apply plainly_intro', impl_intro_r.
- by rewrite plainly_and_sep_l' plainly_elim wand_elim_l.
-Qed.
-Lemma impl_wand_plainly P Q : (■P → Q) ⊣⊢ (■P -∗ Q).
-Proof.
- apply (anti_symm (⊢)); [by rewrite -impl_wand_1|].
- apply impl_intro_l. by rewrite plainly_and_sep_l' wand_elim_r.
-Qed.
-Lemma plainly_entails_l' P Q : (P ⊢ ■Q) → P ⊢ ■Q ∗ P.
-Proof. intros; rewrite -plainly_and_sep_l'; auto. Qed.
-Lemma plainly_entails_r' P Q : (P ⊢ ■Q) → P ⊢ P ∗ ■Q.
-Proof. intros; rewrite -plainly_and_sep_r'; auto. Qed.
-
-Lemma plainly_laterN n P : ■▷^n P ⊣⊢ ▷^n ■P.
-Proof. induction n as [|n IH]; simpl; auto. by rewrite plainly_later IH. 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. by rewrite -plainly_pure persistently_plainly. 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. by rewrite -plainly_internal_eq persistently_plainly. 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 *)
-Hint Resolve later_mono.
-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.
-
-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).
-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 → 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).
-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; 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; f_equiv/=; auto. Qed.
-Lemma laterN_plus n1 n2 P : ▷^(n1 + n2) P ⊣⊢ ▷^n1 ▷^n2 P.
-Proof. induction n1; f_equiv/=; 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 ?IH; 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 ?IH; 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 ?IH; 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 ?IH; 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 ?IH; 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.
+(* 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).
-(* True now *)
-Global Instance except_0_ne : NonExpansive (@uPred_except_0 M).
+(** Propers *)
+Global Instance uPred_valid_proper : Proper ((⊣⊢) ==> iff) (@uPred_valid M).
Proof. solve_proper. Qed.
-Global Instance except_0_proper : Proper ((⊣⊢) ==> (⊣⊢)) (@uPred_except_0 M).
+Global Instance uPred_valid_mono : Proper ((⊢) ==> impl) (@uPred_valid M).
Proof. solve_proper. Qed.
-Global Instance except_0_mono' : Proper ((⊢) ==> (⊢)) (@uPred_except_0 M).
+Global Instance uPred_valid_flip_mono :
+ Proper (flip (⊢) ==> flip impl) (@uPred_valid 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 (anti_symm _).
- { apply forall_intro=> a. by rewrite (forall_elim a). }
- trans (▷ (∀ a : A, Φ a) ∧ (∀ a : A, ◇ Φ a))%I.
- { apply and_intro, reflexivity. rewrite later_forall. apply forall_mono=> a.
- apply or_elim; auto using later_intro. }
- rewrite later_false_excluded_middle and_or_r. apply or_elim.
- { rewrite and_elim_l. apply or_intro_l. }
- apply or_intro_r', forall_intro=> a. rewrite !(forall_elim a).
- by rewrite /uPred_except_0 and_or_l impl_elim_l and_elim_r idemp.
-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_plainly P : ◇ ■P ⊣⊢ ■◇ P.
-Proof. by rewrite /uPred_except_0 plainly_or plainly_later plainly_pure. 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.
+Global Instance ownM_proper: Proper ((≡) ==> (⊣⊢)) (@uPred_ownM M) := ne_proper _.
+Global Instance cmra_valid_proper {A : cmraT} :
+ Proper ((≡) ==> (⊣⊢)) (@uPred_cmra_valid M A) := ne_proper _.
-(* Own and valid derived *)
-Lemma persistently_ownM (a : M) : CoreId a → □ uPred_ownM a ⊣⊢ uPred_ownM a.
+(** Own and valid derived *)
+Lemma persistently_cmra_valid_1 {A : cmraT} (a : A) : ✓ a ⊢ <pers> (✓ a : uPred M).
+Proof. by rewrite {1}plainly_cmra_valid_1 plainly_elim_persistently. Qed.
+Lemma intuitionistically_ownM (a : M) : CoreId a → □ uPred_ownM a ⊣⊢ uPred_ownM a.
Proof.
- intros; apply (anti_symm _); first by apply:persistently_elim.
+ rewrite /bi_intuitionistically affine_affinely=>?; apply (anti_symm _);
+ [by rewrite persistently_elim|].
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_unit. Qed.
Lemma plainly_cmra_valid {A : cmraT} (a : A) : ■✓ a ⊣⊢ ✓ a.
-Proof. apply (anti_symm _); auto using plainly_elim, plainly_cmra_valid_1. Qed.
-Lemma persistently_cmra_valid {A : cmraT} (a : A) : □ ✓ a ⊣⊢ ✓ a.
-Proof. by rewrite -plainly_cmra_valid persistently_plainly. Qed.
-
-(** * Derived rules *)
-Global Instance bupd_mono' : Proper ((⊢) ==> (⊢)) (@uPred_bupd M).
-Proof. intros P Q; apply bupd_mono. Qed.
-Global Instance bupd_flip_mono' : Proper (flip (⊢) ==> flip (⊢)) (@uPred_bupd M).
-Proof. intros P Q; apply bupd_mono. Qed.
-Lemma bupd_frame_l R Q : (R ∗ |==> Q) ==∗ R ∗ Q.
-Proof. rewrite !(comm _ R); apply bupd_frame_r. Qed.
-Lemma bupd_wand_l P Q : (P -∗ Q) ∗ (|==> P) ==∗ Q.
-Proof. by rewrite bupd_frame_l wand_elim_l. Qed.
-Lemma bupd_wand_r P Q : (|==> P) ∗ (P -∗ Q) ==∗ Q.
-Proof. by rewrite bupd_frame_r wand_elim_r. Qed.
-Lemma bupd_sep P Q : (|==> P) ∗ (|==> Q) ==∗ P ∗ Q.
-Proof. by rewrite bupd_frame_r bupd_frame_l bupd_trans. Qed.
+Proof. apply (anti_symm _), plainly_cmra_valid_1. apply plainly_elim, _. Qed.
+Lemma intuitionistically_cmra_valid {A : cmraT} (a : A) : □ ✓ a ⊣⊢ ✓ a.
+Proof.
+ rewrite /bi_intuitionistically affine_affinely. intros; apply (anti_symm _);
+ first by rewrite persistently_elim.
+ apply:persistently_cmra_valid_1.
+Qed.
Lemma bupd_ownM_update x y : x ~~> y → uPred_ownM x ⊢ |==> uPred_ownM y.
Proof.
intros; rewrite (bupd_ownM_updateP _ (y =)); last by apply cmra_update_updateP.
by apply bupd_mono, exist_elim=> y'; apply pure_elim_l=> ->.
Qed.
-Lemma except_0_bupd P : ◇ (|==> P) ⊢ (|==> ◇ P).
-Proof.
- rewrite /uPred_except_0. apply or_elim; auto using bupd_mono.
- 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 (timeless _). 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 except_0_forall later_forall.
- apply forall_mono; auto.
-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 (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 (timeless (a≡b)) (except_0_intro (uPred_ownM b)) -except_0_and.
- apply except_0_mono. rewrite internal_eq_sym. apply impl_elim_r'.
- apply: internal_eq_rewrite.
-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 plainness *)
-Global Instance Plain_proper : Proper ((≡) ==> iff) (@Plain M).
-Proof. solve_proper. Qed.
-Global Instance limit_preserving_Plain {A:ofeT} `{Cofe A} (Φ : A → uPred M) :
- NonExpansive Φ → LimitPreserving (λ x, Plain (Φ x)).
-Proof. intros. apply limit_preserving_entails; solve_proper. Qed.
-
-(* Not an instance, see the bottom of this file *)
-Lemma plain_persistent P : Plain P → Persistent P.
-Proof. rewrite /Plain /Persistent=> HP. by rewrite {1}HP plainly_elim'. Qed.
-
-Lemma plainly_plainly P `{!Plain P} : ■P ⊣⊢ P.
-Proof. apply (anti_symm (⊢)); eauto. Qed.
-Lemma plainly_intro P Q `{!Plain P} : (P ⊢ Q) → P ⊢ ■Q.
-Proof. rewrite -(plainly_plainly P); apply plainly_intro'. Qed.
-Lemma plainly_alt P : ■P ⊣⊢ P ≡ True.
-Proof.
- apply (anti_symm (⊢)).
- - rewrite -prop_ext. apply plainly_mono, and_intro; apply impl_intro_r; auto.
- - rewrite internal_eq_sym (internal_eq_rewrite _ _ (λ P, ■P)%I).
- by rewrite plainly_pure True_impl.
-Qed.
-
-Lemma bupd_plain P `{!Plain P} : (|==> P) ⊢ P.
-Proof. by rewrite -{1}(plainly_plainly P) bupd_plainly. 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.
+ apply except_0_mono. rewrite internal_eq_sym.
+ apply (internal_eq_rewrite' b a (uPred_ownM) _);
+ auto using and_elim_l, and_elim_r.
Qed.
-(* Plain *)
-Global Instance pure_plain φ : Plain (⌜φ⌠: uPred M)%I.
-Proof. by rewrite /Plain plainly_pure. Qed.
-Global Instance impl_plain P Q : Plain P → Plain Q → Plain (P → Q).
-Proof.
- rewrite /Plain=> HP HQ.
- by rewrite {2}HP -plainly_impl_plainly -HQ plainly_elim.
-Qed.
-Global Instance wand_plain P Q : Plain P → Plain Q → Plain (P -∗ Q)%I.
-Proof.
- rewrite /Plain=> HP HQ.
- by rewrite {2}HP -{1}(plainly_elim P) -!impl_wand_plainly -plainly_impl_plainly -HQ.
-Qed.
-Global Instance plainly_plain P : Plain (â– P).
-Proof. by intros; apply plainly_intro'. Qed.
-Global Instance persistently_plain P : Plain P → Plain (□ P).
-Proof. rewrite /Plain=> HP. by rewrite {1}HP persistently_plainly plainly_persistently. Qed.
-Global Instance and_plain P Q :
- Plain P → Plain Q → Plain (P ∧ Q).
-Proof. by intros; rewrite /Plain plainly_and; apply and_mono. Qed.
-Global Instance or_plain P Q :
- Plain P → Plain Q → Plain (P ∨ Q).
-Proof. by intros; rewrite /Plain plainly_or; apply or_mono. Qed.
-Global Instance sep_plain P Q :
- Plain P → Plain Q → Plain (P ∗ Q).
-Proof. by intros; rewrite /Plain plainly_sep; apply sep_mono. Qed.
-Global Instance forall_plain {A} (Ψ : A → uPred M) :
- (∀ x, Plain (Ψ x)) → Plain (∀ x, Ψ x).
-Proof. by intros; rewrite /Plain plainly_forall; apply forall_mono. Qed.
-Global Instance exist_palin {A} (Ψ : A → uPred M) :
- (∀ x, Plain (Ψ x)) → Plain (∃ x, Ψ x).
-Proof. by intros; rewrite /Plain plainly_exist; apply exist_mono. Qed.
-Global Instance internal_eq_plain {A : ofeT} (a b : A) :
- Plain (a ≡ b : uPred M)%I.
-Proof. by intros; rewrite /Plain plainly_internal_eq. Qed.
+(** Plainness *)
Global Instance cmra_valid_plain {A : cmraT} (a : A) :
Plain (✓ a : uPred M)%I.
-Proof. by intros; rewrite /Plain; apply plainly_cmra_valid_1. Qed.
-Global Instance later_plain P : Plain P → Plain (▷ P).
-Proof. by intros; rewrite /Plain plainly_later; apply later_mono. Qed.
-Global Instance except_0_plain P : Plain P → Plain (◇ P).
-Proof. by intros; rewrite /Plain -except_0_plainly; apply except_0_mono. Qed.
-Global Instance laterN_plain n P : Plain P → Plain (▷^n P).
-Proof. induction n; apply _. Qed.
-Global Instance from_option_palin {A} P (Ψ : A → uPred M) (mx : option A) :
- (∀ x, Plain (Ψ x)) → Plain P → Plain (from_option Ψ P mx).
-Proof. destruct mx; apply _. Qed.
+Proof. rewrite /Persistent. apply plainly_cmra_valid_1. Qed.
-(* Persistence *)
-Global Instance pure_persistent φ : Persistent (⌜φ⌠: uPred M)%I.
-Proof. by rewrite /Persistent persistently_pure. Qed.
-Global Instance impl_persistent P Q :
- Plain P → Persistent Q → Persistent (P → Q).
-Proof.
- rewrite /Plain /Persistent=> HP HQ.
- rewrite {2}HP -persistently_impl_plainly. by rewrite -HQ plainly_elim.
-Qed.
-Global Instance wand_persistent P Q :
- Plain P → Persistent Q → Persistent (P -∗ Q)%I.
-Proof.
- rewrite /Plain /Persistent=> HP HQ.
- by rewrite {2}HP -{1}(plainly_elim P) -!impl_wand_plainly -persistently_impl_plainly -HQ.
-Qed.
-Global Instance plainly_persistent P : Persistent (â– P).
-Proof. by rewrite /Persistent persistently_plainly. 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.
+(** Persistence *)
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 except_0_persistent P : Persistent P → Persistent (◇ P).
-Proof. by intros; rewrite /Persistent -except_0_persistently; apply except_0_mono. 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_plainly_and_homomorphism :
- MonoidHomomorphism uPred_and uPred_and (≡) (@uPred_plainly M).
-Proof. split; [split; try apply _|]. apply plainly_and. apply plainly_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_plainly_or_homomorphism :
- MonoidHomomorphism uPred_or uPred_or (≡) (@uPred_plainly M).
-Proof. split; [split; try apply _|]. apply plainly_or. apply plainly_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.
+Proof. rewrite /Persistent. apply persistently_cmra_valid_1. Qed.
+Global Instance ownM_persistent a : CoreId a → Persistent (@uPred_ownM M a).
+Proof.
+ intros. rewrite /Persistent -{2}(core_id_core a). apply persistently_ownM_core.
+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_plainly_sep_homomorphism :
- MonoidHomomorphism uPred_sep uPred_sep (≡) (@uPred_plainly M).
-Proof. split; [split; try apply _|]. apply plainly_sep. apply plainly_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.
+(** For big ops *)
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.
-End uPred.
-(* When declared as an actual instance, [plain_persistent] will give cause
-failing proof searches to take exponential time, as Coq will try to apply it
-the instance at any node in the proof search tree.
+(** Consistency/soundness statement *)
+Lemma soundness φ n : (▷^n ⌜ φ ⌠: uPred M)%I → φ.
+Proof. rewrite laterN_iter. apply soundness_iter. Qed.
+
+Corollary consistency_modal n : ¬ (▷^n False : uPred M)%I.
+Proof. exact (soundness False n). Qed.
+
+Corollary consistency : ¬(False : uPred M)%I.
+Proof. exact (consistency_modal 0). Qed.
-To avoid that, we declare it using a [Hint Immediate], so that it will only be
-used at the leaves of the proof search tree, i.e. when the premise of the hint
-can be derived from just the current context. *)
-Hint Immediate uPred.plain_persistent : typeclass_instances.
+End derived.
+
+End uPred.
diff --git a/theories/base_logic/double_negation.v b/theories/base_logic/double_negation.v
index a57b61357380c0f2ccaccf16c6cfacd2fc277e8c..4ebe5cccc7ae03383bc76cf0c0be2760fb0165c9 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) : stdpp_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_mono; 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];
@@ -90,7 +90,7 @@ Proof.
* rewrite comm -assoc. done.
* rewrite comm -assoc. done.
* exists y'. split=>//. by exists x'.
- - intros; assert (n' < a). omega.
+ - intros; assert (n' < a). lia.
move: laterN_small. uPred.unseal.
naive_solver.
Qed.
@@ -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 *)
@@ -178,21 +178,22 @@ Lemma nnupd_nnupd_k_dist k P: (|=n=> P)%I ≡{k}≡ (|=n=>_k P)%I.
case (decide (k' < n)).
** move: laterN_small; uPred.unseal; naive_solver.
** intros. exfalso. eapply HnnP; eauto.
- assert (n ≤ k'). omega.
+ assert (n ≤ k'). lia.
intros n'' x'' ???.
specialize (HPF n'' x''). exfalso.
eapply laterN_big; last (unseal; eauto).
- eauto. omega.
- * inversion Hle; subst.
+ eauto. lia.
+ * 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.
+ *** intros. exfalso. assert (n ≤ k'). lia.
+ assert (n = S k ∨ n < S k) as [->|] by lia.
+ **** 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.
+ eapply (Hnnupdk n k); first lia; eauto.
exists x, x'. split_and!; eauto. eapply uPred_mono; eauto.
** intros HP. eapply IHk; auto.
move:HP. unseal. intros (?&?); naive_solver.
@@ -264,7 +265,7 @@ Proof.
exfalso. eapply laterN_big; last (uPred.unseal; eapply (Hwand n' x')); eauto.
* rewrite comm. done.
* rewrite comm. done.
- - intros; assert (n' < a). omega.
+ - intros; assert (n' < a). lia.
move: laterN_small. uPred.unseal.
naive_solver.
Qed.
@@ -285,7 +286,7 @@ Proof using Type*.
red; rewrite //= => n' x' ???.
case (decide (n' = k)); intros.
- subst. exfalso. eapply Hfal. rewrite (comm op); eauto.
- - assert (n' < k). omega.
+ - assert (n' < k). lia.
move: laterN_small. uPred.unseal. naive_solver.
Qed.
End classical.
@@ -305,7 +306,7 @@ Proof.
split. unseal. intros n' ?? Hupd.
case (decide (n' < n)).
- intros. move: laterN_small. unseal. naive_solver.
- - intros. assert (n ≤ n'). omega.
+ - intros. assert (n ≤ n'). lia.
exfalso. specialize (Hupd n' ε).
eapply Hdne. intros Hfal.
eapply laterN_big; eauto.
@@ -325,15 +326,14 @@ 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.
+ assert (n' < S k ∨ n' = S k) as [|] by lia.
* intros. move:(laterN_small n' (S k) x' False). rewrite //=. unseal. intros Hsmall.
eapply Hsmall; eauto.
* subst. intros. exfalso. eapply Hf2. exists x'. split; eauto using cmra_validN_S.
- intros k P x Hx. rewrite ?Nat_iter_S_r.
- replace (S (S n) + k) with (S n + (S k)) by omega.
- replace (S n + k) with (n + (S k)) by omega.
- intros. eapply IHn. replace (S n + S k) with (S (S n) + k) by omega. eauto.
+ replace (S (S n) + k) with (S n + (S k)) by lia.
+ replace (S n + k) with (n + (S k)) by lia.
+ intros. eapply IHn. replace (S n + S k) with (S (S n) + k) by lia. eauto.
rewrite ?Nat_iter_S_r. eauto.
Qed.
@@ -352,11 +352,11 @@ 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.
- eapply (adequacy_helper2 _ n 1); (replace (S n + 1) with (S (S n)) by omega); eauto.
+ eapply (adequacy_helper2 _ n 1); (replace (S n + 1) with (S (S n)) by lia); eauto.
unseal. intros (x'&?&Hphi). simpl in *.
eapply Hfal. auto.
Qed.
diff --git a/theories/base_logic/fixpoint.v b/theories/base_logic/fixpoint.v
deleted file mode 100644
index 3d61e8629d6f7bf3d3baa0cbc51e243c27f43e57..0000000000000000000000000000000000000000
--- a/theories/base_logic/fixpoint.v
+++ /dev/null
@@ -1,101 +0,0 @@
-From iris.base_logic Require Import base_logic.
-From iris.proofmode Require Import tactics.
-Set Default Proof Using "Type*".
-Import uPred.
-
-(** Least and greatest fixpoint of a monotone function, defined entirely inside
- the logic. *)
-Class BIMonoPred {M} {A : ofeT} (F : (A → uPred M) → (A → uPred M)) := {
- bi_mono_pred Φ Ψ : ((□ ∀ x, Φ x -∗ Ψ x) → ∀ x, F Φ x -∗ F Ψ x)%I;
- bi_mono_pred_ne Φ : NonExpansive Φ → NonExpansive (F Φ)
-}.
-Arguments bi_mono_pred {_ _ _ _} _ _.
-Local Existing Instance bi_mono_pred_ne.
-
-Definition uPred_least_fixpoint {M} {A : ofeT}
- (F : (A → uPred M) → (A → uPred M)) (x : A) : uPred M :=
- (∀ Φ : A -n> uPredC M, □ (∀ x, F Φ x → Φ x) → Φ x)%I.
-
-Definition uPred_greatest_fixpoint {M} {A : ofeT}
- (F : (A → uPred M) → (A → uPred M)) (x : A) : uPred M :=
- (∃ Φ : A -n> uPredC M, □ (∀ x, Φ x → F Φ x) ∧ Φ x)%I.
-
-Section least.
- Context {M} {A : ofeT} (F : (A → uPred M) → (A → uPred M)) `{!BIMonoPred F}.
-
- Global Instance least_fixpoint_ne : NonExpansive (uPred_least_fixpoint F).
- Proof. solve_proper. Qed.
-
- Lemma least_fixpoint_unfold_2 x : F (uPred_least_fixpoint F) x ⊢ uPred_least_fixpoint F x.
- Proof.
- iIntros "HF" (Φ) "#Hincl".
- iApply "Hincl". iApply (bi_mono_pred _ Φ); last done.
- iIntros "!#" (y) "Hy". iApply "Hy". done.
- Qed.
-
- Lemma least_fixpoint_unfold_1 x :
- uPred_least_fixpoint F x ⊢ F (uPred_least_fixpoint F) x.
- Proof.
- iIntros "HF". iApply ("HF" $! (CofeMor (F (uPred_least_fixpoint F))) with "[#]").
- iIntros "!#" (y) "Hy". iApply bi_mono_pred; last done. iIntros "!#" (z) "?".
- by iApply least_fixpoint_unfold_2.
- Qed.
-
- Corollary least_fixpoint_unfold x :
- uPred_least_fixpoint F x ≡ F (uPred_least_fixpoint F) x.
- Proof.
- apply (anti_symm _); auto using least_fixpoint_unfold_1, least_fixpoint_unfold_2.
- Qed.
-
- Lemma least_fixpoint_ind (Φ : A → uPred M) `{!NonExpansive Φ} :
- □ (∀ y, F Φ y → Φ y) ⊢ ∀ x, uPred_least_fixpoint F x → Φ x.
- Proof.
- iIntros "#HΦ" (x) "HF". by iApply ("HF" $! (CofeMor Φ) with "[#]").
- Qed.
-
- Lemma least_fixpoint_strong_ind (Φ : A → uPred M) `{!NonExpansive Φ} :
- □ (∀ y, F (λ x, Φ x ∧ uPred_least_fixpoint F x) y → Φ y)
- ⊢ ∀ x, uPred_least_fixpoint F x → Φ x.
- Proof.
- trans (∀ x, uPred_least_fixpoint F x → Φ x ∧ uPred_least_fixpoint F x)%I.
- { iIntros "#HΦ". iApply least_fixpoint_ind; first solve_proper.
- iIntros "!#" (y) "H". iSplit; first by iApply "HΦ".
- iApply least_fixpoint_unfold_2. iApply (bi_mono_pred with "[] H").
- by iIntros "!# * [_ ?]". }
- by setoid_rewrite and_elim_l.
- Qed.
-End least.
-
-Section greatest.
- Context {M} {A : ofeT} (F : (A → uPred M) → (A → uPred M)) `{!BIMonoPred F}.
-
- Global Instance greatest_fixpoint_ne : NonExpansive (uPred_greatest_fixpoint F).
- Proof. solve_proper. Qed.
-
- Lemma greatest_fixpoint_unfold_1 x :
- uPred_greatest_fixpoint F x ⊢ F (uPred_greatest_fixpoint F) x.
- Proof.
- iDestruct 1 as (Φ) "[#Hincl HΦ]".
- iApply (bi_mono_pred Φ (uPred_greatest_fixpoint F)).
- - iIntros "!#" (y) "Hy". iExists Φ. auto.
- - by iApply "Hincl".
- Qed.
-
- Lemma greatest_fixpoint_unfold_2 x :
- F (uPred_greatest_fixpoint F) x ⊢ uPred_greatest_fixpoint F x.
- Proof.
- iIntros "HF". iExists (CofeMor (F (uPred_greatest_fixpoint F))).
- iIntros "{$HF} !#" (y) "Hy". iApply (bi_mono_pred with "[] Hy").
- iIntros "!#" (z) "?". by iApply greatest_fixpoint_unfold_1.
- Qed.
-
- Corollary greatest_fixpoint_unfold x :
- uPred_greatest_fixpoint F x ≡ F (uPred_greatest_fixpoint F) x.
- Proof.
- apply (anti_symm _); auto using greatest_fixpoint_unfold_1, greatest_fixpoint_unfold_2.
- Qed.
-
- Lemma greatest_fixpoint_coind (Φ : A → uPred M) `{!NonExpansive Φ} :
- □ (∀ y, Φ y → F Φ y) ⊢ ∀ x, Φ x → uPred_greatest_fixpoint F x.
- Proof. iIntros "#HΦ" (x) "Hx". iExists (CofeMor Φ). by iIntros "{$Hx} !#". Qed.
-End greatest.
diff --git a/theories/base_logic/hlist.v b/theories/base_logic/hlist.v
deleted file mode 100644
index a035aad0250498b6d64bc6af5fa8ab20772b0b00..0000000000000000000000000000000000000000
--- 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 adcd5859d32af3cb3546104a78b12ca563529c9c..bd849ac1fe365dab99912240c7d10b3109e16fe5 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 48e7b766f8b5605a980141eca558fb5441479482..597f175ab0b6ee5cf9ecbe70cc04bdf89ed9f830 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,8 +100,7 @@ Qed.
Lemma box_alloc : box N ∅ True%I.
Proof.
- iIntros; iExists (λ _, True)%I; iSplit; last done.
- iNext. by rewrite big_opM_empty.
+ iIntros. iExists (λ _, True)%I. iSplit; by auto.
Qed.
Lemma slice_insert_empty E q f Q P :
@@ -128,15 +126,15 @@ Lemma slice_delete_empty E q f P Q γ :
↑N ⊆ E →
f !! γ = Some false →
slice N γ Q -∗ ▷?q box N f P ={E}=∗ ∃ P',
- ▷?q ▷ (P ≡ (Q ∗ P')) ∗ ▷?q box N (delete γ f) P'.
+ ▷?q (▷ (P ≡ (Q ∗ P')) ∗ box N (delete γ f) P').
Proof.
iIntros (??) "[#HγQ Hinv] H". iDestruct "H" as (Φ) "[#HeqP Hf]".
iExists ([∗ map] γ'↦_ ∈ delete γ f, Φ γ')%I.
- iInv N as (b) "[>Hγ _]" "Hclose".
+ iInv N as (b) "[>Hγ _]".
iDestruct (big_opM_delete _ f _ false with "Hf")
as "[[>Hγ' #[HγΦ ?]] ?]"; first done.
iDestruct (box_own_auth_agree γ b false with "[-]") as %->; first by iFrame.
- iMod ("Hclose" with "[Hγ]"); first iExists false; eauto.
+ iModIntro. iSplitL "Hγ"; first iExists false; eauto.
iModIntro. iNext. iSplit.
- iDestruct (box_own_agree γ Q (Φ γ) with "[#]") as "HeqQ"; first by eauto.
iNext. iRewrite "HeqP". iRewrite "HeqQ". by rewrite -big_opM_delete.
@@ -149,11 +147,11 @@ Lemma slice_fill E q f γ P Q :
slice N γ Q -∗ ▷ Q -∗ ▷?q box N f P ={E}=∗ ▷?q box N (<[γ:=true]> f) P.
Proof.
iIntros (??) "#[HγQ Hinv] HQ H"; iDestruct "H" as (Φ) "[#HeqP Hf]".
- iInv N as (b') "[>Hγ _]" "Hclose".
+ iInv N as (b') "[>Hγ _]".
iDestruct (big_opM_delete _ f _ false with "Hf")
as "[[>Hγ' #[HγΦ Hinv']] ?]"; first done.
iMod (box_own_auth_update γ b' false true with "[$Hγ $Hγ']") as "[Hγ Hγ']".
- iMod ("Hclose" with "[Hγ HQ]"); first (iNext; iExists true; by iFrame).
+ iModIntro. iSplitL "Hγ HQ"; first (iNext; iExists true; by iFrame).
iModIntro; iNext; iExists Φ; iSplit.
- by rewrite big_opM_insert_override.
- rewrite -insert_delete big_opM_insert ?lookup_delete //.
@@ -166,13 +164,13 @@ Lemma slice_empty E q f P Q γ :
slice N γ Q -∗ ▷?q box N f P ={E}=∗ ▷ Q ∗ ▷?q box N (<[γ:=false]> f) P.
Proof.
iIntros (??) "#[HγQ Hinv] H"; iDestruct "H" as (Φ) "[#HeqP Hf]".
- iInv N as (b) "[>Hγ HQ]" "Hclose".
+ iInv N as (b) "[>Hγ HQ]".
iDestruct (big_opM_delete _ f with "Hf")
as "[[>Hγ' #[HγΦ Hinv']] ?]"; first done.
iDestruct (box_own_auth_agree γ b true with "[-]") as %->; first by iFrame.
iFrame "HQ".
iMod (box_own_auth_update γ with "[$Hγ $Hγ']") as "[Hγ Hγ']".
- iMod ("Hclose" with "[Hγ]"); first (iNext; iExists false; by repeat iSplit).
+ iModIntro. iSplitL "Hγ"; first (iNext; iExists false; by repeat iSplit).
iModIntro; iNext; iExists Φ; iSplit.
- by rewrite big_opM_insert_override.
- rewrite -insert_delete big_opM_insert ?lookup_delete //.
@@ -209,15 +207,15 @@ Lemma box_fill E f P :
Proof.
iIntros (?) "H HP"; iDestruct "H" as (Φ) "[#HeqP Hf]".
iExists Φ; iSplitR; first by rewrite big_opM_fmap.
- iEval (rewrite internal_eq_iff later_iff big_opM_commute) in "HeqP".
+ iEval (rewrite internal_eq_iff later_iff big_sepM_later) in "HeqP".
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".
+ iInv N as (b) "[>Hγ _]".
iMod (box_own_auth_update γ with "[Hγ Hγ']") as "[Hγ $]"; first by iFrame.
- iApply "Hclose". iNext; iExists true. by iFrame.
+ iModIntro. iSplitL; last done. iNext; iExists true. iFrame.
Qed.
Lemma box_empty E f P :
@@ -232,13 +230,13 @@ Proof.
{ rewrite -big_opM_opM -fupd_big_sepM. iApply (@big_sepM_impl with "[$Hf]").
iIntros "!#" (γ b ?) "(Hγ' & #HγΦ & #Hinv)".
assert (true = b) as <- by eauto.
- iInv N as (b) "[>Hγ HΦ]" "Hclose".
+ iInv N as (b) "[>Hγ HΦ]".
iDestruct (box_own_auth_agree γ b true with "[-]") as %->; first by iFrame.
iMod (box_own_auth_update γ true true false with "[$Hγ $Hγ']") as "[Hγ $]".
- iMod ("Hclose" with "[Hγ]"); first (iNext; iExists false; iFrame; eauto).
+ iModIntro. iSplitL "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.
@@ -256,7 +254,7 @@ Proof.
iAlways. by iSplit; iIntros "[? $]"; iApply "HQQ'".
- iMod (slice_delete_empty with "Hs Hb") as (P') "(Heq & Hb)"; try done.
iMod (slice_insert_empty with "Hb") as (γ' ?) "[#Hs' Hb]"; try done.
- iExists γ', _. iIntros "{$∗ $# $%} !>". do 2 iNext. iRewrite "Heq".
+ iExists γ', (Q' ∗ P')%I. iIntros "{$∗ $# $%} !>". do 2 iNext. iRewrite "Heq".
iAlways. by iSplit; iIntros "[? $]"; iApply "HQQ'".
Qed.
@@ -273,7 +271,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. iApply (internal_eq_rewrite_contractive with "[#] Hbox").
+ iNext. iApply (internal_eq_rewrite_contractive _ _ (λ P, _) with "[Heq] Hbox").
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 +279,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. iApply (internal_eq_rewrite_contractive with "[#] Hbox").
+ iNext. iApply (internal_eq_rewrite_contractive _ _ (λ P, _) with "[Heq] Hbox").
iNext. iRewrite "Heq". iPureIntro. by rewrite assoc (comm _ Q2).
Qed.
@@ -298,14 +296,14 @@ Proof.
iMod (slice_insert_full _ _ _ _ (Q1 ∗ Q2)%I with "[$HQ1 $HQ2] Hbox")
as (γ ?) "[#Hslice Hbox]"; first done.
iExists γ. iIntros "{$% $#} !>". iNext.
- iApply (internal_eq_rewrite_contractive with "[#] Hbox").
+ iApply (internal_eq_rewrite_contractive _ _ (λ P, _) with "[Heq1 Heq2] Hbox").
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.
- iApply (internal_eq_rewrite_contractive with "[#] Hbox").
+ iApply (internal_eq_rewrite_contractive _ _ (λ P, _) with "[Heq1 Heq2] Hbox").
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 6d18584e5691980efc845bf77fb23c5400ac0e21..e2f20276dc2cc0aa22b2dcf5480efbe575217310 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.lib Require Import fractional.
From iris.algebra Require Export frac.
From iris.proofmode Require Import tactics.
Set Default Proof Using "Type".
@@ -38,7 +39,7 @@ Section proofs.
Proof. rewrite /cinv; apply _. Qed.
Global Instance cinv_own_fractional γ : Fractional (cinv_own γ).
- Proof. intros ??. by rewrite -own_op. Qed.
+ Proof. intros ??. by rewrite /cinv_own -own_op. Qed.
Global Instance cinv_own_as_fractional γ q :
AsFractional (cinv_own γ q) (cinv_own γ) q.
Proof. split. done. apply _. Qed.
@@ -56,7 +57,7 @@ Section proofs.
▷ □ (P ↔ P') -∗ cinv N γ P -∗ cinv N γ P'.
Proof.
iIntros "#HP' Hinv". iDestruct "Hinv" as (P'') "[#HP'' Hinv]".
- iExists _. iFrame "Hinv". iNext. iAlways. iSplit.
+ iExists _. iFrame "Hinv". iAlways. iNext. iSplit.
- iIntros "?". iApply "HP''". iApply "HP'". done.
- iIntros "?". iApply "HP'". iApply "HP''". done.
Qed.
@@ -106,6 +107,18 @@ Section proofs.
iMod (cinv_open_strong with "Hinv Hγ") as "($ & $ & H)"; first done.
iIntros "!> HP". iApply "H"; auto.
Qed.
+
+ Global Instance into_inv_cinv N γ P : IntoInv (cinv N γ P) N.
+
+ Global Instance into_acc_cinv E N γ P p :
+ IntoAcc (X:=unit) (cinv N γ P)
+ (↑N ⊆ E) (cinv_own γ p) (fupd E (E∖↑N)) (fupd (E∖↑N) E)
+ (λ _, ▷ P ∗ cinv_own γ p)%I (λ _, ▷ P)%I (λ _, None)%I.
+ Proof.
+ rewrite /IntoAcc /accessor. iIntros (?) "#Hinv Hown".
+ rewrite exist_unit -assoc.
+ iApply (cinv_open with "Hinv"); done.
+ Qed.
End proofs.
Typeclasses Opaque cinv_own cinv.
diff --git a/theories/base_logic/lib/core.v b/theories/base_logic/lib/core.v
deleted file mode 100644
index f7cfb0ebb607fc58cb3cbdbe3335c48e1df68b78..0000000000000000000000000000000000000000
--- a/theories/base_logic/lib/core.v
+++ /dev/null
@@ -1,49 +0,0 @@
-From iris.base_logic Require Import base_logic.
-From iris.proofmode Require Import tactics.
-Set Default Proof Using "Type".
-Import uPred.
-
-(** The "core" of an assertion is its maximal persistent part. *)
-Definition coreP {M : ucmraT} (P : uPred M) : uPred M :=
- (∀ Q, ■(Q → □ Q) → ■(P → Q) → Q)%I.
-Instance: Params (@coreP) 1.
-Typeclasses Opaque coreP.
-
-Section core.
- Context {M : ucmraT}.
- Implicit Types P Q : uPred M.
-
- Lemma coreP_intro P : P -∗ coreP P.
- Proof. rewrite /coreP. iIntros "HP" (Q) "_ HPQ". by iApply "HPQ". Qed.
-
- Global Instance coreP_persistent P : Persistent (coreP P).
- Proof.
- rewrite /coreP /Persistent. iIntros "HC" (Q).
- iApply persistently_impl_plainly. iIntros "#HQ".
- iApply persistently_impl_plainly. iIntros "#HPQ".
- iApply "HQ". by iApply "HC".
- Qed.
-
- Global Instance coreP_ne : NonExpansive (@coreP M).
- Proof. solve_proper. Qed.
- Global Instance coreP_proper : Proper ((⊣⊢) ==> (⊣⊢)) (@coreP M).
- Proof. solve_proper. Qed.
-
- Global Instance coreP_mono : Proper ((⊢) ==> (⊢)) (@coreP M).
- Proof.
- rewrite /coreP. iIntros (P P' HP) "H"; iIntros (Q) "#HQ #HPQ".
- iApply ("H" $! Q with "[]"); first done. by rewrite HP.
- Qed.
-
- Lemma coreP_elim P : Persistent P → coreP P -∗ P.
- Proof. rewrite /coreP. iIntros (?) "HCP". iApply ("HCP" $! P); auto. Qed.
-
- Lemma coreP_wand P Q : (coreP P ⊢ Q) ↔ (P ⊢ □ Q).
- Proof.
- split.
- - iIntros (HP) "HP". iDestruct (coreP_intro with "HP") as "#HcP".
- iAlways. by iApply HP.
- - iIntros (HPQ) "HcP". iDestruct (coreP_mono _ _ HPQ with "HcP") as "HcQ".
- iDestruct (coreP_elim with "HcQ") as "#HQ". done.
- Qed.
-End core.
diff --git a/theories/base_logic/lib/fancy_updates.v b/theories/base_logic/lib/fancy_updates.v
index f9aa2a2f0e8ca071979979ce4e7b237cb84ac037..f38e00d279084bcb05c71ecf0fec148034ae4d0f 100644
--- a/theories/base_logic/lib/fancy_updates.v
+++ b/theories/base_logic/lib/fancy_updates.v
@@ -1,269 +1,52 @@
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.
+From iris.proofmode Require Import tactics.
Set Default Proof Using "Type".
Export invG.
Import uPred.
-Program Definition fupd_def `{invG Σ}
- (E1 E2 : coPset) (P : iProp Σ) : iProp Σ :=
+Definition uPred_fupd_def `{invG Σ} (E1 E2 : coPset) (P : iProp Σ) : iProp Σ :=
(wsat ∗ ownE E1 ==∗ ◇ (wsat ∗ ownE E2 ∗ P))%I.
-Definition fupd_aux : seal (@fupd_def). by eexists. Qed.
-Definition fupd := unseal fupd_aux.
-Definition fupd_eq : @fupd = @fupd_def := seal_eq fupd_aux.
-Arguments fupd {_ _} _ _ _%I.
-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.
-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.
-Notation "P ={ E1 , E2 }=∗ Q" := (P -∗ |={E1,E2}=> Q)
- (at level 99, E1, E2 at level 50, Q at level 200, only parsing) : stdpp_scope.
-
-Notation "|={ E }=> Q" := (fupd E E Q)
- (at level 99, E at level 50, Q at level 200,
- format "|={ E }=> Q") : uPred_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.
-Notation "P ={ E }=∗ Q" := (P -∗ |={E}=> Q)
- (at level 99, E at level 50, Q at level 200, only parsing) : stdpp_scope.
-
-Section fupd.
-Context `{invG Σ}.
-Implicit Types P Q : iProp Σ.
-
-Global Instance fupd_ne E1 E2 : NonExpansive (@fupd Σ _ E1 E2).
-Proof. rewrite fupd_eq. solve_proper. Qed.
-Global Instance fupd_proper E1 E2 : Proper ((≡) ==> (≡)) (@fupd Σ _ E1 E2).
-Proof. apply ne_proper, _. Qed.
-
-Lemma fupd_intro_mask E1 E2 P : E2 ⊆ E1 → P ⊢ |={E1,E2}=> |={E2,E1}=> P.
-Proof.
- intros (E1''&->&?)%subseteq_disjoint_union_L.
- rewrite fupd_eq /fupd_def ownE_op //.
- by iIntros "$ ($ & $ & HE) !> !> [$ $] !> !>" .
-Qed.
-
-Lemma except_0_fupd E1 E2 P : ◇ (|={E1,E2}=> P) ={E1,E2}=∗ P.
-Proof. rewrite fupd_eq. iIntros ">H [Hw HE]". iApply "H"; by iFrame. Qed.
-
-Lemma bupd_fupd E P : (|==> P) ={E}=∗ P.
-Proof. rewrite fupd_eq /fupd_def. by iIntros ">? [$ $] !> !>". Qed.
-
-Lemma fupd_mono E1 E2 P Q : (P ⊢ Q) → (|={E1,E2}=> P) ⊢ |={E1,E2}=> Q.
-Proof.
- rewrite fupd_eq /fupd_def. iIntros (HPQ) "HP HwE".
- rewrite -HPQ. by iApply "HP".
-Qed.
-
-Lemma fupd_trans E1 E2 E3 P : (|={E1,E2}=> |={E2,E3}=> P) ⊢ |={E1,E3}=> P.
-Proof.
- rewrite fupd_eq /fupd_def. iIntros "HP HwE".
- iMod ("HP" with "HwE") as ">(Hw & HE & HP)". iApply "HP"; by iFrame.
-Qed.
-
-Lemma fupd_mask_frame_r' E1 E2 Ef P :
- E1 ## Ef → (|={E1,E2}=> ⌜E2 ## Ef⌠→ P) ={E1 ∪ Ef,E2 ∪ Ef}=∗ P.
-Proof.
- intros. rewrite fupd_eq /fupd_def ownE_op //. iIntros "Hvs (Hw & HE1 &HEf)".
- iMod ("Hvs" with "[Hw HE1]") as ">($ & HE2 & HP)"; first by iFrame.
- iDestruct (ownE_op' with "[HE2 HEf]") as "[? $]"; first by iFrame.
- iIntros "!> !>". by iApply "HP".
-Qed.
-
-Lemma fupd_frame_r E1 E2 P Q : (|={E1,E2}=> P) ∗ Q ={E1,E2}=∗ P ∗ Q.
-Proof. rewrite fupd_eq /fupd_def. by iIntros "[HwP $]". Qed.
-
-Lemma fupd_plain' E1 E2 E2' P Q `{!Plain P} :
- E1 ⊆ E2 →
- (Q ={E1, E2'}=∗ P) -∗ (|={E1, E2}=> Q) ={E1}=∗ (|={E1, E2}=> Q) ∗ P.
-Proof.
- iIntros ((E3&->&HE)%subseteq_disjoint_union_L) "HQP HQ".
- rewrite fupd_eq /fupd_def ownE_op //. iIntros "H".
- iMod ("HQ" with "H") as ">(Hws & [HE1 HE3] & HQ)"; iModIntro.
- iAssert (â—‡ P)%I as "#HP".
- { by iMod ("HQP" with "HQ [$]") as "(_ & _ & HP)". }
- iMod "HP". iFrame. auto.
-Qed.
-
-Lemma later_fupd_plain E P `{!Plain P} : (▷ |={E}=> P) ={E}=∗ ▷ ◇ P.
-Proof.
- rewrite fupd_eq /fupd_def. iIntros "HP [Hw HE]".
- iAssert (â–· â—‡ P)%I with "[-]" as "#$"; last by iFrame.
- iNext. by iMod ("HP" with "[$]") as "(_ & _ & HP)".
-Qed.
-
-(** * Derived rules *)
-Global Instance fupd_mono' E1 E2 : Proper ((⊢) ==> (⊢)) (@fupd Σ _ E1 E2).
-Proof. intros P Q; apply fupd_mono. Qed.
-Global Instance fupd_flip_mono' E1 E2 :
- Proper (flip (⊢) ==> flip (⊢)) (@fupd Σ _ E1 E2).
-Proof. intros P Q; apply fupd_mono. Qed.
-
-Lemma fupd_intro E P : P ={E}=∗ P.
-Proof. iIntros "HP". by iApply bupd_fupd. Qed.
-Lemma fupd_intro_mask' E1 E2 : E2 ⊆ E1 → (|={E1,E2}=> |={E2,E1}=> True)%I.
-Proof. exact: fupd_intro_mask. Qed.
-Lemma fupd_except_0 E1 E2 P : (|={E1,E2}=> ◇ P) ={E1,E2}=∗ P.
-Proof. by rewrite {1}(fupd_intro E2 P) except_0_fupd fupd_trans. Qed.
-
-Lemma fupd_frame_l E1 E2 P Q : (P ∗ |={E1,E2}=> Q) ={E1,E2}=∗ P ∗ Q.
-Proof. rewrite !(comm _ P); apply fupd_frame_r. Qed.
-Lemma fupd_wand_l E1 E2 P Q : (P -∗ Q) ∗ (|={E1,E2}=> P) ={E1,E2}=∗ Q.
-Proof. by rewrite fupd_frame_l wand_elim_l. Qed.
-Lemma fupd_wand_r E1 E2 P Q : (|={E1,E2}=> P) ∗ (P -∗ Q) ={E1,E2}=∗ Q.
-Proof. by rewrite fupd_frame_r wand_elim_r. Qed.
-
-Lemma fupd_trans_frame E1 E2 E3 P Q :
- ((Q ={E2,E3}=∗ True) ∗ |={E1,E2}=> (Q ∗ P)) ={E1,E3}=∗ P.
-Proof.
- rewrite fupd_frame_l assoc -(comm _ Q) wand_elim_r.
- by rewrite fupd_frame_r left_id fupd_trans.
-Qed.
-
-Lemma fupd_mask_frame_r E1 E2 Ef P :
- E1 ## Ef → (|={E1,E2}=> P) ={E1 ∪ Ef,E2 ∪ Ef}=∗ P.
-Proof.
- iIntros (?) "H". iApply fupd_mask_frame_r'; auto.
- iApply fupd_wand_r; iFrame "H"; eauto.
-Qed.
-Lemma fupd_mask_mono E1 E2 P : E1 ⊆ E2 → (|={E1}=> P) ={E2}=∗ P.
-Proof.
- intros (Ef&->&?)%subseteq_disjoint_union_L. by apply fupd_mask_frame_r.
-Qed.
-
-Lemma fupd_sep E P Q : (|={E}=> P) ∗ (|={E}=> Q) ={E}=∗ P ∗ Q.
-Proof. by rewrite fupd_frame_r fupd_frame_l fupd_trans. Qed.
-Lemma fupd_big_sepL {A} E (Φ : nat → A → iProp Σ) (l : list A) :
- ([∗ list] k↦x ∈ l, |={E}=> Φ k x) ={E}=∗ [∗ list] k↦x ∈ l, Φ k x.
-Proof.
- apply (big_opL_forall (λ P Q, P ={E}=∗ Q)); auto using fupd_intro.
- intros P1 P2 HP Q1 Q2 HQ. by rewrite HP HQ -fupd_sep.
-Qed.
-Lemma fupd_big_sepM `{Countable K} {A} E (Φ : K → A → iProp Σ) (m : gmap K A) :
- ([∗ map] k↦x ∈ m, |={E}=> Φ k x) ={E}=∗ [∗ map] k↦x ∈ m, Φ k x.
-Proof.
- apply (big_opM_forall (λ P Q, P ={E}=∗ Q)); auto using fupd_intro.
- intros P1 P2 HP Q1 Q2 HQ. by rewrite HP HQ -fupd_sep.
-Qed.
-Lemma fupd_big_sepS `{Countable A} E (Φ : A → iProp Σ) X :
- ([∗ set] x ∈ X, |={E}=> Φ x) ={E}=∗ [∗ set] x ∈ X, Φ x.
-Proof.
- apply (big_opS_forall (λ P Q, P ={E}=∗ Q)); auto using fupd_intro.
- intros P1 P2 HP Q1 Q2 HQ. by rewrite HP HQ -fupd_sep.
-Qed.
-
-Lemma fupd_plain E1 E2 P Q `{!Plain P} :
- E1 ⊆ E2 → (Q -∗ P) -∗ (|={E1, E2}=> Q) ={E1}=∗ (|={E1, E2}=> Q) ∗ P.
-Proof.
- iIntros (HE) "HQP HQ". iApply (fupd_plain' _ _ E1 with "[HQP] HQ"); first done.
- iIntros "?". iApply fupd_intro. by iApply "HQP".
-Qed.
-End fupd.
-
-(** Proofmode class instances *)
-Section proofmode_classes.
- Context `{invG Σ}.
- Implicit Types P Q : iProp Σ.
-
- Global Instance from_pure_fupd E P φ : FromPure P φ → FromPure (|={E}=> P) φ.
- Proof. rewrite /FromPure. intros <-. apply fupd_intro. Qed.
-
- Global Instance from_assumption_fupd E p P Q :
- 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').
- Proof.
- rewrite /WandWeaken' /WandWeaken=>->. apply wand_intro_l. by rewrite fupd_wand_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 or_split_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 Σ) :
- FromExist P Φ → FromExist (|={E1,E2}=> P) (λ a, |={E1,E2}=> Φ a)%I.
- Proof.
- rewrite /FromExist=><-. apply exist_elim=> a. by rewrite -(exist_intro a).
- Qed.
-
- Global Instance frame_fupd p E1 E2 R P Q :
- Frame p R P Q → Frame p R (|={E1,E2}=> P) (|={E1,E2}=> Q).
- Proof. rewrite /Frame=><-. by rewrite fupd_frame_l. Qed.
-
- Global Instance is_except_0_fupd E1 E2 P : IsExcept0 (|={E1,E2}=> P).
- Proof. by rewrite /IsExcept0 except_0_fupd. Qed.
-
- Global Instance from_modal_fupd E P : FromModal (|={E}=> P) P.
- Proof. rewrite /FromModal. apply fupd_intro. Qed.
-
- Global Instance elim_modal_bupd_fupd E1 E2 P Q :
- ElimModal (|==> P) P (|={E1,E2}=> Q) (|={E1,E2}=> Q).
- Proof.
- by rewrite /ElimModal (bupd_fupd E1) fupd_frame_r wand_elim_r fupd_trans.
- Qed.
- Global Instance elim_modal_fupd_fupd E1 E2 E3 P Q :
- ElimModal (|={E1,E2}=> P) P (|={E1,E3}=> Q) (|={E2,E3}=> Q).
- Proof. by rewrite /ElimModal fupd_frame_r wand_elim_r fupd_trans. Qed.
-
- Global Instance add_modal_fupd E1 E2 P Q :
- AddModal (|={E1}=> P) P (|={E1,E2}=> Q).
- Proof. by rewrite /AddModal fupd_frame_r wand_elim_r fupd_trans. Qed.
-End proofmode_classes.
-
-Hint Extern 2 (coq_tactics.envs_entails _ (|={_}=> _)) => iModIntro.
-
-(** Fancy updates that take a step. *)
-
-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.
-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.
-Notation "|={ E }â–·=> Q" := (|={E,E}â–·=> Q)%I
- (at level 99, E at level 50, Q at level 200,
- format "|={ E }â–·=> Q") : uPred_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.
-
-Section step_fupd.
-Context `{invG Σ}.
-
-Lemma step_fupd_wand E1 E2 P Q : (|={E1,E2}▷=> P) -∗ (P -∗ Q) -∗ |={E1,E2}▷=> Q.
-Proof. iIntros "HP HPQ". by iApply "HPQ". Qed.
-
-Lemma step_fupd_mask_frame_r E1 E2 Ef P :
- E1 ## Ef → E2 ## Ef → (|={E1,E2}▷=> P) ⊢ |={E1 ∪ Ef,E2 ∪ Ef}▷=> P.
-Proof.
- iIntros (??) "HP". iApply fupd_mask_frame_r. done. iMod "HP". iModIntro.
- iNext. by iApply fupd_mask_frame_r.
-Qed.
-
-Lemma step_fupd_mask_mono E1 E2 F1 F2 P :
- F1 ⊆ F2 → E1 ⊆ E2 → (|={E1,F2}▷=> P) ⊢ |={E2,F1}▷=> P.
-Proof.
- iIntros (??) "HP".
- iMod (fupd_intro_mask') as "HM1"; first done. iMod "HP".
- iMod (fupd_intro_mask') as "HM2"; first done. iModIntro.
- iNext. iMod "HM2". iMod "HP". iMod "HM1". done.
-Qed.
-
-Lemma step_fupd_intro E1 E2 P : E2 ⊆ E1 → ▷ P -∗ |={E1,E2}▷=> P.
-Proof. iIntros (?) "HP". iApply (step_fupd_mask_mono E2 _ _ E2); auto. Qed.
-End step_fupd.
+Definition uPred_fupd_aux `{invG Σ} : seal uPred_fupd_def. by eexists. Qed.
+Definition uPred_fupd `{invG Σ} : FUpd (iProp Σ):= uPred_fupd_aux.(unseal).
+Definition uPred_fupd_eq `{invG Σ} : @fupd _ uPred_fupd = uPred_fupd_def :=
+ uPred_fupd_aux.(seal_eq).
+
+Lemma uPred_fupd_mixin `{invG Σ} : BiFUpdMixin (uPredSI (iResUR Σ)) uPred_fupd.
+Proof.
+ split.
+ - rewrite uPred_fupd_eq. solve_proper.
+ - intros E1 E2 P (E1''&->&?)%subseteq_disjoint_union_L.
+ rewrite uPred_fupd_eq /uPred_fupd_def ownE_op //.
+ by iIntros "$ ($ & $ & HE) !> !> [$ $] !> !>" .
+ - rewrite uPred_fupd_eq. iIntros (E1 E2 P) ">H [Hw HE]". iApply "H"; by iFrame.
+ - rewrite uPred_fupd_eq. iIntros (E1 E2 P Q HPQ) "HP HwE". rewrite -HPQ. by iApply "HP".
+ - rewrite uPred_fupd_eq. iIntros (E1 E2 E3 P) "HP HwE".
+ iMod ("HP" with "HwE") as ">(Hw & HE & HP)". iApply "HP"; by iFrame.
+ - intros E1 E2 Ef P HE1Ef. rewrite uPred_fupd_eq /uPred_fupd_def ownE_op //.
+ iIntros "Hvs (Hw & HE1 &HEf)".
+ iMod ("Hvs" with "[Hw HE1]") as ">($ & HE2 & HP)"; first by iFrame.
+ iDestruct (ownE_op' with "[HE2 HEf]") as "[? $]"; first by iFrame.
+ iIntros "!> !>". by iApply "HP".
+ - rewrite uPred_fupd_eq /uPred_fupd_def. by iIntros (????) "[HwP $]".
+Qed.
+Instance uPred_bi_fupd `{invG Σ} : BiFUpd (uPredSI (iResUR Σ)) :=
+ {| bi_fupd_mixin := uPred_fupd_mixin |}.
+
+Instance uPred_bi_bupd_fupd `{invG Σ} : BiBUpdFUpd (uPredSI (iResUR Σ)).
+Proof. rewrite /BiBUpdFUpd uPred_fupd_eq. by iIntros (E P) ">? [$ $] !> !>". Qed.
+
+Instance uPred_bi_fupd_plainly `{invG Σ} : BiFUpdPlainly (uPredSI (iResUR Σ)).
+Proof.
+ split.
+ - iIntros (E1 E2 E2' P Q ? (E3&->&HE)%subseteq_disjoint_union_L) "HQP HQ".
+ rewrite uPred_fupd_eq /uPred_fupd_def ownE_op //. iIntros "H".
+ iMod ("HQ" with "H") as ">(Hws & [HE1 HE3] & HQ)"; iModIntro.
+ iAssert (â—‡ P)%I as "#HP".
+ { by iMod ("HQP" with "HQ [$]") as "(_ & _ & HP)". }
+ iMod "HP". iFrame. auto.
+ - rewrite uPred_fupd_eq /uPred_fupd_def. iIntros (E P ?) "HP [Hw HE]".
+ iAssert (â–· â—‡ P)%I with "[-]" as "#$"; last by iFrame.
+ iNext. by iMod ("HP" with "[$]") as "(_ & _ & HP)".
+Qed.
\ No newline at end of file
diff --git a/theories/base_logic/lib/fancy_updates_from_vs.v b/theories/base_logic/lib/fancy_updates_from_vs.v
index 5f94d9be7911a6a078403bfb4cab7ec8ea2d1a9c..b47fa0df6b8b48693d4c8baf4df9ede3836f884e 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 Export base_logic.
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.
@@ -67,4 +68,4 @@ Proof.
iIntros "[Hvs HQ]". iDestruct "Hvs" as (R) "[HR Hvs]".
iExists (R ∗ Q)%I. iFrame "HR HQ". by iApply vs_frame_r.
Qed.
-End fupd.
\ No newline at end of file
+End fupd.
diff --git a/theories/base_logic/lib/gen_heap.v b/theories/base_logic/lib/gen_heap.v
index e08e113f236c46d7cafb29706117a3784490c289..dfbaa78bf2de211c43b5f4e5c9bb0f7db9e1dcad 100644
--- a/theories/base_logic/lib/gen_heap.v
+++ b/theories/base_logic/lib/gen_heap.v
@@ -1,6 +1,6 @@
From iris.algebra Require Import auth gmap frac agree.
From iris.base_logic.lib Require Export own.
-From iris.base_logic.lib Require Import fractional.
+From iris.bi.lib Require Import fractional.
From iris.proofmode Require Import tactics.
Set Default Proof Using "Type".
Import uPred.
@@ -36,17 +36,17 @@ Section definitions.
Definition mapsto_def (l : L) (q : Qp) (v: V) : iProp Σ :=
own (gen_heap_name hG) (â—¯ {[ l := (q, to_agree (v : leibnizC V)) ]}).
Definition mapsto_aux : seal (@mapsto_def). by eexists. Qed.
- Definition mapsto := unseal mapsto_aux.
- Definition mapsto_eq : @mapsto = @mapsto_def := seal_eq mapsto_aux.
+ Definition mapsto := mapsto_aux.(unseal).
+ Definition mapsto_eq : @mapsto = @mapsto_def := mapsto_aux.(seal_eq).
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}.
@@ -94,7 +94,7 @@ Section gen_heap.
Proof. rewrite mapsto_eq /mapsto_def. apply _. Qed.
Global Instance mapsto_fractional l v : Fractional (λ q, l ↦{q} v)%I.
Proof.
- intros p q. by rewrite mapsto_eq -own_op -auth_frag_op
+ intros p q. by rewrite mapsto_eq /mapsto_def -own_op -auth_frag_op
op_singleton pair_op agree_idemp.
Qed.
Global Instance mapsto_as_fractional l q v :
@@ -104,7 +104,7 @@ Section gen_heap.
Lemma mapsto_agree l q1 q2 v1 v2 : l ↦{q1} v1 -∗ l ↦{q2} v2 -∗ ⌜v1 = v2âŒ.
Proof.
apply wand_intro_r.
- rewrite mapsto_eq -own_op -auth_frag_op own_valid discrete_valid.
+ rewrite mapsto_eq /mapsto_def -own_op -auth_frag_op own_valid discrete_valid.
f_equiv=> /auth_own_valid /=. rewrite op_singleton singleton_valid pair_op.
by intros [_ ?%agree_op_invL'].
Qed.
diff --git a/theories/base_logic/lib/invariants.v b/theories/base_logic/lib/invariants.v
index bff17b5684fca4f476d2fba516adbef20ce8c721..1ecc9bcc72d82703cc2feaa1231ecf97b684c1df 100644
--- a/theories/base_logic/lib/invariants.v
+++ b/theories/base_logic/lib/invariants.v
@@ -1,8 +1,8 @@
From iris.base_logic.lib Require Export fancy_updates.
-From stdpp Require Export namespaces.
+From stdpp Require Export namespaces.
From iris.base_logic.lib Require Import wsat.
From iris.algebra Require Import gmap.
-From iris.proofmode Require Import tactics coq_tactics intro_patterns.
+From iris.proofmode Require Import tactics.
Set Default Proof Using "Type".
Import uPred.
@@ -10,8 +10,8 @@ Import uPred.
Definition inv_def `{invG Σ} (N : namespace) (P : iProp Σ) : iProp Σ :=
(∃ i P', ⌜i ∈ (↑N:coPset)⌠∧ ▷ □ (P' ↔ P) ∧ ownI i P')%I.
Definition inv_aux : seal (@inv_def). by eexists. Qed.
-Definition inv {Σ i} := unseal inv_aux Σ i.
-Definition inv_eq : @inv = @inv_def := seal_eq inv_aux.
+Definition inv {Σ i} := inv_aux.(unseal) Σ i.
+Definition inv_eq : @inv = @inv_def := inv_aux.(seal_eq).
Instance: Params (@inv) 3.
Typeclasses Opaque inv.
@@ -52,16 +52,16 @@ Qed.
Lemma inv_alloc N E P : ▷ P ={E}=∗ inv N P.
Proof.
- rewrite inv_eq /inv_def fupd_eq /fupd_def. iIntros "HP [Hw $]".
+ rewrite inv_eq /inv_def uPred_fupd_eq. iIntros "HP [Hw $]".
iMod (ownI_alloc (∈ (↑N : coPset)) P with "[$HP $Hw]")
as (i ?) "[$ ?]"; auto using fresh_inv_name.
- do 2 iModIntro. iExists i, P. rewrite -(iff_refl True). auto.
+ do 2 iModIntro. iExists i, P. rewrite -(iff_refl True%I). auto.
Qed.
Lemma inv_alloc_open N E P :
↑N ⊆ E → (|={E, E∖↑N}=> inv N P ∗ (▷P ={E∖↑N, E}=∗ True))%I.
Proof.
- rewrite inv_eq /inv_def fupd_eq /fupd_def. iIntros (Sub) "[Hw HE]".
+ rewrite inv_eq /inv_def uPred_fupd_eq. iIntros (Sub) "[Hw HE]".
iMod (ownI_alloc_open (∈ (↑N : coPset)) P with "Hw")
as (i ?) "(Hw & #Hi & HD)"; auto using fresh_inv_name.
iAssert (ownE {[i]} ∗ ownE (↑ N ∖ {[i]}) ∗ ownE (E ∖ ↑ N))%I
@@ -70,19 +70,19 @@ Proof.
rewrite assoc_L -!union_difference_L //. set_solver. }
do 2 iModIntro. iFrame "HE\N". iSplitL "Hw HEi"; first by iApply "Hw".
iSplitL "Hi".
- { iExists i, P. rewrite -(iff_refl True). auto. }
+ { iExists i, P. rewrite -(iff_refl True%I). auto. }
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 :
↑N ⊆ E → inv N P ={E,E∖↑N}=∗ ▷ P ∗ (▷ P ={E∖↑N,E}=∗ True).
Proof.
- rewrite inv_eq /inv_def fupd_eq /fupd_def.
+ rewrite inv_eq /inv_def uPred_fupd_eq /uPred_fupd_def.
iDestruct 1 as (i P') "(Hi & #HP' & #HiP)".
iDestruct "Hi" as % ?%elem_of_subseteq_singleton.
rewrite {1 4}(union_difference_L (↑ N) E) // ownE_op; last set_solver.
@@ -107,36 +107,22 @@ Proof.
by rewrite left_id_L.
Qed.
+Global Instance into_inv_inv N P : IntoInv (inv N P) N.
+
+Global Instance into_acc_inv E N P :
+ IntoAcc (X:=unit) (inv N P)
+ (↑N ⊆ E) True (fupd E (E∖↑N)) (fupd (E∖↑N) E)
+ (λ _, ▷ P)%I (λ _, ▷ P)%I (λ _, None)%I.
+Proof.
+ rewrite /IntoAcc /accessor exist_unit.
+ iIntros (?) "#Hinv _". iApply inv_open; done.
+Qed.
+
Lemma inv_open_timeless E N P `{!Timeless P} :
↑N ⊆ E → inv N P ={E,E∖↑N}=∗ P ∗ (P ={E∖↑N,E}=∗ True).
Proof.
iIntros (?) "Hinv". iMod (inv_open with "Hinv") as "[>HP Hclose]"; auto.
iIntros "!> {$HP} HP". iApply "Hclose"; auto.
Qed.
-End inv.
-Tactic Notation "iInvCore" constr(N) "as" tactic(tac) constr(Hclose) :=
- let Htmp := iFresh in
- let patback := intro_pat.parse_one Hclose in
- let pat := constr:(IList [[IIdent Htmp; patback]]) in
- iMod (inv_open _ N with "[#]") as pat;
- [idtac|iAssumption || fail "iInv: invariant" N "not found"|idtac];
- [solve_ndisj || match goal with |- ?P => fail "iInv: cannot solve" P end
- |tac Htmp].
-
-Tactic Notation "iInv" constr(N) "as" constr(pat) constr(Hclose) :=
- iInvCore N as (fun H => iDestruct H as pat) Hclose.
-Tactic Notation "iInv" constr(N) "as" "(" simple_intropattern(x1) ")"
- constr(pat) constr(Hclose) :=
- iInvCore N as (fun H => iDestruct H as (x1) pat) Hclose.
-Tactic Notation "iInv" constr(N) "as" "(" simple_intropattern(x1)
- simple_intropattern(x2) ")" constr(pat) constr(Hclose) :=
- iInvCore N as (fun H => iDestruct H as (x1 x2) pat) Hclose.
-Tactic Notation "iInv" constr(N) "as" "(" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) ")"
- constr(pat) constr(Hclose) :=
- iInvCore N as (fun H => iDestruct H as (x1 x2 x3) pat) Hclose.
-Tactic Notation "iInv" constr(N) "as" "(" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4) ")"
- constr(pat) constr(Hclose) :=
- iInvCore N as (fun H => iDestruct H as (x1 x2 x3 x4) pat) Hclose.
+End inv.
diff --git a/theories/base_logic/lib/iprop.v b/theories/base_logic/lib/iprop.v
index 8f1768137509da9551500bee52f1be2bfa3b1fe3..2ca017324e6062d4e5f380b4fc2be4665c1d30f9 100644
--- a/theories/base_logic/lib/iprop.v
+++ b/theories/base_logic/lib/iprop.v
@@ -118,6 +118,8 @@ Module Type iProp_solution_sig.
Definition iResUR (Σ : gFunctors) : ucmraT :=
ofe_funUR (λ i, gmapUR gname (Σ i (iPreProp Σ))).
Notation iProp Σ := (uPredC (iResUR Σ)).
+ Notation iPropI Σ := (uPredI (iResUR Σ)).
+ Notation iPropSI Σ := (uPredSI (iResUR Σ)).
Parameter iProp_unfold: ∀ {Σ}, iProp Σ -n> iPreProp Σ.
Parameter iProp_fold: ∀ {Σ}, iPreProp Σ -n> iProp Σ.
@@ -149,8 +151,7 @@ End iProp_solution.
(** * Properties of the solution to the recursive domain equation *)
Lemma iProp_unfold_equivI {Σ} (P Q : iProp Σ) :
- iProp_unfold P ≡ iProp_unfold Q ⊢ (P ≡ Q : iProp Σ).
+ iProp_unfold P ≡ iProp_unfold Q ⊢@{iPropI Σ} P ≡ Q.
Proof.
- rewrite -{2}(iProp_fold_unfold P) -{2}(iProp_fold_unfold Q).
- apply: uPred.f_equiv.
+ rewrite -{2}(iProp_fold_unfold P) -{2}(iProp_fold_unfold Q). apply: bi.f_equiv.
Qed.
diff --git a/theories/base_logic/lib/na_invariants.v b/theories/base_logic/lib/na_invariants.v
index f0cb736288d74e6285c85d0a07686af991f6c902..beaf8ebfe54d0ba730328d21e212bed70a651000 100644
--- a/theories/base_logic/lib/na_invariants.v
+++ b/theories/base_logic/lib/na_invariants.v
@@ -1,5 +1,5 @@
From iris.base_logic.lib Require Export invariants.
-From iris.algebra Require Export gmap gset coPset.
+From iris.algebra Require Import gset coPset.
From iris.proofmode Require Import tactics.
Set Default Proof Using "Type".
Import uPred.
@@ -101,13 +101,26 @@ Section proofs.
rewrite [F as X in na_own p X](union_difference_L (↑N) F) //.
rewrite [X in (X ∪ _)](union_difference_L {[i]} (↑N)) ?na_own_union; [|set_solver..].
iDestruct "Htoks" as "[[Htoki $] $]".
- iInv N as "[[$ >Hdis]|>Htoki2]" "Hclose".
+ iInv "Hinv" as "[[$ >Hdis]|>Htoki2]" "Hclose".
- iMod ("Hclose" with "[Htoki]") as "_"; first auto.
iIntros "!> [HP $]".
- iInv N as "[[_ >Hdis2]|>Hitok]" "Hclose".
+ iInv N as "[[_ >Hdis2]|>Hitok]".
+ iDestruct (own_valid_2 with "Hdis Hdis2") as %[_ Hval%gset_disj_valid_op].
set_solver.
- + iFrame. iApply "Hclose". iNext. iLeft. by iFrame.
+ + iSplitR "Hitok"; last by iFrame. eauto with iFrame.
- iDestruct (na_own_disjoint with "Htoki Htoki2") as %?. set_solver.
Qed.
+
+ Global Instance into_inv_na p N P : IntoInv (na_inv p N P) N.
+
+ Global Instance into_acc_na p F E N P :
+ IntoAcc (X:=unit) (na_inv p N P)
+ (↑N ⊆ E ∧ ↑N ⊆ F) (na_own p F) (fupd E E) (fupd E E)
+ (λ _, ▷ P ∗ na_own p (F∖↑N))%I (λ _, ▷ P ∗ na_own p (F∖↑N))%I
+ (λ _, Some (na_own p F))%I.
+ Proof.
+ rewrite /IntoAcc /accessor. iIntros ((?&?)) "#Hinv Hown".
+ rewrite exist_unit -assoc /=.
+ iApply (na_inv_open with "Hinv"); done.
+ Qed.
End proofs.
diff --git a/theories/base_logic/lib/own.v b/theories/base_logic/lib/own.v
index ed1ab6073ee9ca2b54dec5a9a74673be0d8fcdb8..a9d78acb9ff6502969e1c11c83253d1c951d4cbf 100644
--- a/theories/base_logic/lib/own.v
+++ b/theories/base_logic/lib/own.v
@@ -1,7 +1,6 @@
From iris.algebra Require Import functions 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.algebra Require Import proofmode_classes.
Set Default Proof Using "Type".
Import uPred.
@@ -55,8 +54,8 @@ Instance: Params (@iRes_singleton) 4.
Definition own_def `{inG Σ A} (γ : gname) (a : A) : iProp Σ :=
uPred_ownM (iRes_singleton γ a).
Definition own_aux : seal (@own_def). by eexists. Qed.
-Definition own {Σ A i} := unseal own_aux Σ A i.
-Definition own_eq : @own = @own_def := seal_eq own_aux.
+Definition own {Σ A i} := own_aux.(unseal) Σ A i.
+Definition own_eq : @own = @own_def := own_aux.(seal_eq).
Instance: Params (@own) 4.
Typeclasses Opaque own.
@@ -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_emp_valid (ownM_unit emp).
eapply bupd_ownM_updateP, (ofe_fun_singleton_updateP_empty (inG_id _));
first (eapply alloc_updateP_strong', cmra_transport_valid, Ha);
naive_solver.
@@ -128,8 +127,8 @@ Proof.
Qed.
Lemma own_alloc a : ✓ a → (|==> ∃ γ, own γ a)%I.
Proof.
- intros Ha. rewrite /uPred_valid (own_alloc_strong a ∅) //; [].
- apply bupd_mono, exist_mono=>?. eauto with I.
+ intros Ha. rewrite /uPred_valid /bi_emp_valid (own_alloc_strong a ∅) //; [].
+ apply bupd_mono, exist_mono=>?. eauto using and_elim_r.
Qed.
(** ** Frame preserving updates *)
@@ -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_emp_valid (ownM_unit emp) !own_eq /own_def.
apply bupd_ownM_update, ofe_fun_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 γ a b1 b2 :
+ IsOp a b1 b2 → IntoSep (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.
Qed.
End proofmode_classes.
diff --git a/theories/base_logic/lib/viewshifts.v b/theories/base_logic/lib/viewshifts.v
index c8ab4eb42184ab7bd29885a29e9712d2a57af845..e45a87c0c9420662be8df21813459187b458b83d 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,8 @@ 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. do 2 f_equiv. setoid_rewrite bi.affine_affinely; last apply _.
+ by 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 a26f4f6ae6395fd36dfc415e01f14410ffd7d46c..ebe50cad7aac020000904779463a560f98b26538 100644
--- a/theories/base_logic/lib/wsat.v
+++ b/theories/base_logic/lib/wsat.v
@@ -1,7 +1,6 @@
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.
Set Default Proof Using "Type".
@@ -54,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_emp_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âŒ.
@@ -69,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_emp_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âŒ.
@@ -91,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 "?".
@@ -99,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 6cb248ce7e7ae690522d12d3c6a8d027d1cac635..0000000000000000000000000000000000000000
--- a/theories/base_logic/primitive.v
+++ /dev/null
@@ -1,654 +0,0 @@
-From iris.base_logic Require Export upred.
-From stdpp Require Import finite.
-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 n1' x1 x1' HPQ [x2 Hx1'] Hn1 n2 x3 [x4 Hx3] ?; simpl in *.
- rewrite Hx3 (dist_le _ _ _ _ Hx1'); auto. intros ??.
- eapply HPQ; auto. exists (x2 â‹… x4); by rewrite assoc.
-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 n1 n2 x y (x1&x2&Hx&?&?) [z Hy] Hn.
- exists x1, (x2 â‹… z); split_and?; eauto using uPred_mono, cmra_includedN_l.
- eapply dist_le, Hn. by rewrite Hy Hx assoc.
-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 n1 n1' x1 x1' HPQ ? Hn n3 x3 ???; simpl in *.
- eapply uPred_mono with n3 (x1 â‹… x3);
- eauto using cmra_validN_includedN, cmra_monoN_r, cmra_includedN_le.
-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.
-
-(* Equivalently, this could be `∀ y, P n y`. That's closer to the intuition
- of "embedding the step-indexed logic in Iris", but the two are equivalent
- because Iris is afine. The following is easier to work with. *)
-Program Definition uPred_plainly_def {M} (P : uPred M) : uPred M :=
- {| uPred_holds n x := P n ε |}.
-Solve Obligations with naive_solver eauto using uPred_mono, ucmra_unit_validN.
-Definition uPred_plainly_aux : seal (@uPred_plainly_def). by eexists. Qed.
-Definition uPred_plainly {M} := unseal uPred_plainly_aux M.
-Definition uPred_plainly_eq :
- @uPred_plainly = @uPred_plainly_def := seal_eq uPred_plainly_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.
-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 [|n1] [|n2] x1 x2; eauto using uPred_mono, cmra_includedN_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 n1 n2 x1 x [a' Hx1] [x2 Hx] Hn. eapply cmra_includedN_le=>//.
- exists (a' â‹… x2). by rewrite Hx(assoc op) Hx1.
-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 n1 n2 x1 x2 HQ [x3 Hx] Hn 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.
- eauto using uPred_mono, cmra_includedN_l.
-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 φ%stdpp%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_plainly P)
- (at level 20, 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) : stdpp_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) : stdpp_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_plainly_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.
-Definition later_ne : NonExpansive (@uPred_later M) := _.
-Global Instance later_proper :
- Proper ((⊣⊢) ==> (⊣⊢)) (@uPred_later M) := ne_proper _.
-Global Instance plainly_ne : NonExpansive (@uPred_plainly M).
-Proof.
- intros n P1 P2 HP.
- unseal; split=> n' x; split; apply HP; eauto using @ucmra_unit_validN.
-Qed.
-Global Instance plainly_proper :
- Proper ((⊣⊢) ==> (⊣⊢)) (@uPred_plainly 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, 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) :
- NonExpansive Ψ → a ≡ b ⊢ Ψ a → Ψ b.
-Proof. intros HΨ. unseal; split=> n x ?? n' x' ??? Ha. by apply HΨ with n a. 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_mono with n x; 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.
-
-(* The plainness modality *)
-Lemma plainly_mono P Q : (P ⊢ Q) → ■P ⊢ ■Q.
-Proof. intros HP; unseal; split=> n x ? /=. apply HP, ucmra_unit_validN. Qed.
-Lemma plainly_elim' P : ■P ⊢ □ P.
-Proof. unseal; split; simpl; eauto using uPred_mono, @ucmra_unit_leastN. Qed.
-Lemma plainly_idemp P : ■P ⊢ ■■P.
-Proof. unseal; split=> n x ?? //. Qed.
-
-Lemma plainly_forall_2 {A} (Ψ : A → uPred M) : (∀ a, ■Ψ a) ⊢ (■∀ a, Ψ a).
-Proof. by unseal. Qed.
-Lemma plainly_exist_1 {A} (Ψ : A → uPred M) : (■∃ a, Ψ a) ⊢ (∃ a, ■Ψ a).
-Proof. by unseal. Qed.
-
-Lemma prop_ext P Q : ■((P → Q) ∧ (Q → P)) ⊢ P ≡ Q.
-Proof.
- unseal; split=> n x ? /= HPQ; split=> n' x' ? HP;
- split; eapply HPQ; eauto using @ucmra_unit_least.
-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.
-
-(* The following two laws are very similar, and indeed they hold not just for â–¡
- and ■, but for any modality defined as `M P n x := ∀ y, R x y → P n y`. *)
-Lemma persistently_impl_plainly P Q : (■P → □ Q) ⊢ □ (■P → Q).
-Proof.
- unseal; split=> /= n x ? HPQ n' x' ????.
- eapply uPred_mono with n' (core x)=>//; [|by apply cmra_included_includedN].
- apply (HPQ n' x); eauto using cmra_validN_le.
-Qed.
-
-Lemma plainly_impl_plainly P Q : (■P → ■Q) ⊢ ■(■P → Q).
-Proof.
- unseal; split=> /= n x ? HPQ n' x' ????.
- eapply uPred_mono with n' ε=>//; [|by apply cmra_included_includedN].
- apply (HPQ n' x); eauto using cmra_validN_le.
-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_mono with (S n) x; 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' ????; eauto using uPred_mono, cmra_included_includedN.
-Qed.
-Lemma persistently_later P : □ ▷ P ⊣⊢ ▷ □ P.
-Proof. by unseal. Qed.
-Lemma plainly_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 plainly_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_mono with n x; 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. eauto using uPred_mono, 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.
-Lemma bupd_plainly P : (|==> ■P) ⊢ P.
-Proof.
- unseal; split => n x Hnx /= Hng.
- destruct (Hng n ε) as [? [_ Hng']]; try rewrite right_id; auto.
- eapply uPred_mono; eauto using ucmra_unit_leastN.
-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.
-
-(* Function extensionality *)
-Lemma ofe_morC_equivI {A B : ofeT} (f g : A -n> B) : f ≡ g ⊣⊢ ∀ x, f x ≡ g x.
-Proof. by unseal. Qed.
-Lemma ofe_fun_equivI `{B : A → ofeT} (g1 g2 : ofe_fun B) :
- g1 ≡ g2 ⊣⊢ ∀ i, g1 i ≡ g2 i.
-Proof. by uPred.unseal. Qed.
-
-Lemma ofe_fun_validI `{B : A → ucmraT} (g : ofe_fun B) : ✓ g ⊣⊢ ∀ i, ✓ g i.
-Proof. by uPred.unseal. Qed.
-
-(* Sigma OFE *)
-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 0000000000000000000000000000000000000000..6caa4627b3f435395fb0917bf1295258aff8c3db
--- /dev/null
+++ b/theories/base_logic/proofmode.v
@@ -0,0 +1,43 @@
+From iris.base_logic Require Export derived.
+From iris.algebra Require Import proofmode_classes.
+
+Import base_logic.bi.uPred.
+
+(* Setup of the proof mode *)
+Section class_instances.
+Context {M : ucmraT}.
+Implicit Types P Q R : uPred M.
+
+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_cmra_valid {A : cmraT} af (a : A) :
+ @FromPure (uPredI M) af (✓ a) (✓ a).
+Proof.
+ rewrite /FromPure. eapply bi.pure_elim; [by apply bi.affinely_if_elim|]=> ?.
+ rewrite -uPred.cmra_valid_intro //.
+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 bi.persistent_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 bi.intuitionistically_if_mono. by rewrite (is_op a) ownM_op bi.sep_and.
+Qed.
+
+Global Instance into_sep_ownM (a b1 b2 : M) :
+ IsOp a b1 b2 → IntoSep (uPred_ownM a) (uPred_ownM b1) (uPred_ownM b2).
+Proof. intros. by rewrite /IntoSep (is_op a) ownM_op. Qed.
+End class_instances.
diff --git a/theories/base_logic/soundness.v b/theories/base_logic/soundness.v
deleted file mode 100644
index 58b19d4d3880db8a329b32cb8ed12115d45e9c46..0000000000000000000000000000000000000000
--- a/theories/base_logic/soundness.v
+++ /dev/null
@@ -1,21 +0,0 @@
-From iris.base_logic Require Export base_logic.
-Set Default Proof Using "Type".
-Import uPred.
-
-Section adequacy.
-Context {M : ucmraT}.
-
-(** Consistency and adequancy statements *)
-Lemma soundness φ n : (▷^n ⌜ φ ⌠: uPred M)%I → φ.
-Proof.
- cut ((▷^n ⌜ φ ⌠: uPred M)%I n ε → φ).
- { intros help H. eapply help, H; eauto using ucmra_unit_validN. by unseal. }
- rewrite /uPred_laterN; unseal. induction n as [|n IH]=> H; auto.
-Qed.
-
-Corollary consistency_modal n : ¬ (▷^n False : uPred M)%I.
-Proof. exact (soundness False n). Qed.
-
-Corollary consistency : ¬ (False : uPred M)%I.
-Proof. exact (consistency_modal 0). Qed.
-End adequacy.
diff --git a/theories/base_logic/upred.v b/theories/base_logic/upred.v
index e17fe1dc8388e588fd1185f4b153f14654fc997e..6f04ccb5499337ada42a3eedcda6efbf1ac84db2 100644
--- a/theories/base_logic/upred.v
+++ b/theories/base_logic/upred.v
@@ -1,5 +1,11 @@
-From iris.algebra Require Export cmra.
+From iris.algebra Require Export cmra updates.
+From iris.bi Require Import notation.
+From stdpp Require Import finite.
+From Coq.Init Require Import Nat.
Set Default Proof Using "Type".
+Local Hint Extern 1 (_ ≼ _) => etrans; [eassumption|].
+Local Hint Extern 1 (_ ≼ _) => etrans; [|eassumption].
+Local Hint Extern 10 (_ ≤ _) => lia.
(** The basic definition of the uPred type, its metric and functor laws.
You probably do not want to import this file. Instead, import
@@ -47,14 +53,11 @@ Record uPred (M : ucmraT) : Type := IProp {
uPred_mono n1 n2 x1 x2 :
uPred_holds n1 x1 → x1 ≼{n1} x2 → n2 ≤ n1 → uPred_holds n2 x2
}.
-Arguments uPred_holds {_} _ _ _ : simpl never.
+Bind Scope bi_scope with uPred.
+Arguments uPred_holds {_} _%I _ _ : simpl never.
Add Printing Constructor uPred.
Instance: Params (@uPred_holds) 3.
-Delimit Scope uPred_scope with I.
-Bind Scope uPred_scope with uPred.
-Arguments uPred_holds {_} _%I _ _.
-
Section cofe.
Context {M : ucmraT}.
@@ -184,54 +187,217 @@ 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_def.
-(** Notations *)
-Notation "P ⊢ Q" := (uPred_entails P%I Q%I)
- (at level 99, Q at level 200, right associativity) : stdpp_scope.
-Notation "(⊢)" := uPred_entails (only parsing) : stdpp_scope.
-Notation "P ⊣⊢ Q" := (equiv (A:=uPred _) P%I Q%I)
- (at level 95, no associativity) : stdpp_scope.
-Notation "(⊣⊢)" := (equiv (A:=uPred _)) (only parsing) : stdpp_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} := uPred_pure_aux.(unseal) M.
+Definition uPred_pure_eq :
+ @uPred_pure = @uPred_pure_def := uPred_pure_aux.(seal_eq).
+
+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} := uPred_and_aux.(unseal) M.
+Definition uPred_and_eq: @uPred_and = @uPred_and_def := uPred_and_aux.(seal_eq).
+
+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} := uPred_or_aux.(unseal) M.
+Definition uPred_or_eq: @uPred_or = @uPred_or_def := uPred_or_aux.(seal_eq).
+
+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 n1' x1 x1' HPQ [x2 Hx1'] Hn1 n2 x3 [x4 Hx3] ?; simpl in *.
+ rewrite Hx3 (dist_le _ _ _ _ Hx1'); auto. intros ??.
+ eapply HPQ; auto. exists (x2 â‹… x4); by rewrite assoc.
+Qed.
+Definition uPred_impl_aux : seal (@uPred_impl_def). by eexists. Qed.
+Definition uPred_impl {M} := uPred_impl_aux.(unseal) M.
+Definition uPred_impl_eq :
+ @uPred_impl = @uPred_impl_def := uPred_impl_aux.(seal_eq).
+
+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} := uPred_forall_aux.(unseal) M A.
+Definition uPred_forall_eq :
+ @uPred_forall = @uPred_forall_def := uPred_forall_aux.(seal_eq).
+
+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} := uPred_exist_aux.(unseal) M A.
+Definition uPred_exist_eq: @uPred_exist = @uPred_exist_def := uPred_exist_aux.(seal_eq).
+
+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} := uPred_internal_eq_aux.(unseal) M A.
+Definition uPred_internal_eq_eq:
+ @uPred_internal_eq = @uPred_internal_eq_def := uPred_internal_eq_aux.(seal_eq).
+
+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 n1 n2 x y (x1&x2&Hx&?&?) [z Hy] Hn.
+ exists x1, (x2 â‹… z); split_and?; eauto using uPred_mono, cmra_includedN_l.
+ eapply dist_le, Hn. by rewrite Hy Hx assoc.
+Qed.
+Definition uPred_sep_aux : seal (@uPred_sep_def). by eexists. Qed.
+Definition uPred_sep {M} := uPred_sep_aux.(unseal) M.
+Definition uPred_sep_eq: @uPred_sep = @uPred_sep_def := uPred_sep_aux.(seal_eq).
+
+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 n1 n1' x1 x1' HPQ ? Hn n3 x3 ???; simpl in *.
+ eapply uPred_mono with n3 (x1 â‹… x3);
+ eauto using cmra_validN_includedN, cmra_monoN_r, cmra_includedN_le.
+Qed.
+Definition uPred_wand_aux : seal (@uPred_wand_def). by eexists. Qed.
+Definition uPred_wand {M} := uPred_wand_aux.(unseal) M.
+Definition uPred_wand_eq :
+ @uPred_wand = @uPred_wand_def := uPred_wand_aux.(seal_eq).
+
+(* Equivalently, this could be `∀ y, P n y`. That's closer to the intuition
+ of "embedding the step-indexed logic in Iris", but the two are equivalent
+ because Iris is afine. The following is easier to work with. *)
+Program Definition uPred_plainly_def {M} (P : uPred M) : uPred M :=
+ {| uPred_holds n x := P n ε |}.
+Solve Obligations with naive_solver eauto using uPred_mono, ucmra_unit_validN.
+Definition uPred_plainly_aux : seal (@uPred_plainly_def). by eexists. Qed.
+Definition uPred_plainly {M} := uPred_plainly_aux.(unseal) M.
+Definition uPred_plainly_eq :
+ @uPred_plainly = @uPred_plainly_def := uPred_plainly_aux.(seal_eq).
-Module uPred.
-Section entails.
+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.
+Definition uPred_persistently_aux : seal (@uPred_persistently_def). by eexists. Qed.
+Definition uPred_persistently {M} := uPred_persistently_aux.(unseal) M.
+Definition uPred_persistently_eq :
+ @uPred_persistently = @uPred_persistently_def := uPred_persistently_aux.(seal_eq).
+
+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 [|n1] [|n2] x1 x2; eauto using uPred_mono, cmra_includedN_S with lia.
+Qed.
+Definition uPred_later_aux : seal (@uPred_later_def). by eexists. Qed.
+Definition uPred_later {M} := uPred_later_aux.(unseal) M.
+Definition uPred_later_eq :
+ @uPred_later = @uPred_later_def := uPred_later_aux.(seal_eq).
+
+Program Definition uPred_ownM_def {M : ucmraT} (a : M) : uPred M :=
+ {| uPred_holds n x := a ≼{n} x |}.
+Next Obligation.
+ intros M a n1 n2 x1 x [a' Hx1] [x2 Hx] Hn. eapply cmra_includedN_le=>//.
+ exists (a' â‹… x2). by rewrite Hx(assoc op) Hx1.
+Qed.
+Definition uPred_ownM_aux : seal (@uPred_ownM_def). by eexists. Qed.
+Definition uPred_ownM {M} := uPred_ownM_aux.(unseal) M.
+Definition uPred_ownM_eq :
+ @uPred_ownM = @uPred_ownM_def := uPred_ownM_aux.(seal_eq).
+
+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} := uPred_cmra_valid_aux.(unseal) M A.
+Definition uPred_cmra_valid_eq :
+ @uPred_cmra_valid = @uPred_cmra_valid_def := uPred_cmra_valid_aux.(seal_eq).
+
+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 n1 n2 x1 x2 HQ [x3 Hx] Hn 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.
+ eauto using uPred_mono, cmra_includedN_l.
+Qed.
+Definition uPred_bupd_aux : seal (@uPred_bupd_def). by eexists. Qed.
+Definition uPred_bupd {M} := uPred_bupd_aux.(unseal) M.
+Definition uPred_bupd_eq :
+ @uPred_bupd = @uPred_bupd_def := uPred_bupd_aux.(seal_eq).
+
+(** Global uPred-specific Notation *)
+Notation "✓ x" := (uPred_cmra_valid x) (at level 20) : bi_scope.
+
+(** Promitive logical rules.
+ These are not directly usable later because they do not refer to the BI
+ connectives. *)
+Module uPred_primitive.
+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_plainly_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.
+Arguments uPred_holds {_} !_ _ _ /.
+Hint Immediate uPred_in_entails.
+
+Notation "P ⊢ Q" := (@uPred_entails M P%I Q%I) : stdpp_scope.
+Notation "(⊢)" := (@uPred_entails M) (only parsing) : stdpp_scope.
+Notation "P ⊣⊢ Q" := (@uPred_equiv M P%I Q%I) : stdpp_scope.
+Notation "(⊣⊢)" := (@uPred_equiv M) (only parsing) : stdpp_scope.
-Global Instance entails_po : PreOrder (@uPred_entails M).
+Notation "'True'" := (uPred_pure True) : bi_scope.
+Notation "'False'" := (uPred_pure False) : bi_scope.
+Notation "'⌜' φ 'âŒ'" := (uPred_pure φ%type%stdpp) : bi_scope.
+Infix "∧" := uPred_and : bi_scope.
+Infix "∨" := uPred_or : bi_scope.
+Infix "→" := uPred_impl : bi_scope.
+Notation "∀ x .. y , P" :=
+ (uPred_forall (λ x, .. (uPred_forall (λ y, P)) ..)) : bi_scope.
+Notation "∃ x .. y , P" :=
+ (uPred_exist (λ x, .. (uPred_exist (λ y, P)) ..)) : bi_scope.
+Infix "∗" := uPred_sep : bi_scope.
+Infix "-∗" := uPred_wand : bi_scope.
+Notation "â–¡ P" := (uPred_persistently P) : bi_scope.
+Notation "â– P" := (uPred_plainly P) : bi_scope.
+Notation "x ≡ y" := (uPred_internal_eq x y) : bi_scope.
+Notation "â–· P" := (uPred_later P) : bi_scope.
+Notation "|==> P" := (uPred_bupd P) : bi_scope.
+
+(** Entailment *)
+Lemma entails_po : PreOrder (⊢).
Proof.
split.
- by intros P; split=> x i.
- by intros P Q Q' HP HQ; split=> x i ??; apply HQ, HP.
Qed.
-Global Instance entails_anti_sym : AntiSymm (⊣⊢) (@uPred_entails M).
+Lemma entails_anti_sym : AntiSymm (⊣⊢) (⊢).
Proof. intros P Q HPQ HQP; split=> x n; by split; [apply HPQ|apply HQP]. Qed.
-
Lemma equiv_spec P Q : (P ⊣⊢ Q) ↔ (P ⊢ Q) ∧ (Q ⊢ P).
Proof.
- split; [|by intros [??]; apply (anti_symm (⊢))].
- intros HPQ; split; split=> x i; apply HPQ.
-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)).
-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].
+ split.
+ - intros HPQ; split; split=> x i; apply HPQ.
+ - intros [??]. exact: entails_anti_sym.
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.
-
Lemma entails_lim (cP cQ : chain (uPredC M)) :
(∀ n, cP n ⊢ cQ n) → compl cP ⊢ compl cQ.
Proof.
@@ -239,8 +405,408 @@ 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.
-End uPred.
+(** Non-expansiveness and setoid morphisms *)
+Lemma pure_ne n : Proper (iff ==> dist n) (@uPred_pure M).
+Proof. intros φ1 φ2 Hφ. by unseal; split=> -[|m] ?; try apply Hφ. Qed.
+
+Lemma 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.
+
+Lemma 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.
+
+Lemma 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.
+
+Lemma 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.
+
+Lemma 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.
+
+Lemma 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.
+
+Lemma 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.
+
+Lemma 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.
+
+Lemma later_contractive : Contractive (@uPred_later M).
+Proof.
+ unseal; intros [|n] P Q HPQ; split=> -[|n'] x ?? //=; try lia.
+ apply HPQ; eauto using cmra_validN_S.
+Qed.
+
+Lemma plainly_ne : NonExpansive (@uPred_plainly M).
+Proof.
+ intros n P1 P2 HP.
+ unseal; split=> n' x; split; apply HP; eauto using @ucmra_unit_validN.
+Qed.
+
+Lemma 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.
+
+Lemma ownM_ne : NonExpansive (@uPred_ownM M).
+Proof.
+ intros n a b Ha.
+ unseal; split=> n' x ? /=. by rewrite (dist_le _ _ _ _ Ha); last lia.
+Qed.
+
+Lemma 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.
+
+Lemma 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.
+
+(** 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, cmra_included_includedN.
+Qed.
+Lemma impl_elim_l' P Q R : (P ⊢ Q → R) → P ∧ Q ⊢ R.
+Proof. unseal; intros HP ; split=> n x ? [??]; apply HP with n x; auto. 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.
+
+(** 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_mono with n x; 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.
+
+(** Persistently *)
+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.
+Qed.
+
+(** Plainly *)
+Lemma plainly_mono P Q : (P ⊢ Q) → ■P ⊢ ■Q.
+Proof. intros HP; unseal; split=> n x ? /=. apply HP, ucmra_unit_validN. Qed.
+Lemma plainly_elim_persistently P : ■P ⊢ □ P.
+Proof. unseal; split; simpl; eauto using uPred_mono, @ucmra_unit_leastN. Qed.
+Lemma plainly_idemp_2 P : ■P ⊢ ■■P.
+Proof. unseal; split=> n x ?? //. Qed.
+
+Lemma plainly_forall_2 {A} (Ψ : A → uPred M) : (∀ a, ■Ψ a) ⊢ (■∀ a, Ψ a).
+Proof. by unseal. Qed.
+Lemma plainly_exist_1 {A} (Ψ : A → uPred M) : (■∃ a, Ψ a) ⊢ (∃ a, ■Ψ a).
+Proof. by unseal. Qed.
+
+Lemma prop_ext P Q : ■((P -∗ Q) ∧ (Q -∗ P)) ⊢ P ≡ Q.
+Proof.
+ unseal; split=> n x ? /= HPQ. split=> n' x' ??.
+ move: HPQ=> [] /(_ n' x'); rewrite !left_id=> ?.
+ move=> /(_ n' x'); rewrite !left_id=> ?. naive_solver.
+Qed.
+
+(* The following two laws are very similar, and indeed they hold not just for â–¡
+ and ■, but for any modality defined as `M P n x := ∀ y, R x y → P n y`. *)
+Lemma persistently_impl_plainly P Q : (■P → □ Q) ⊢ □ (■P → Q).
+Proof.
+ unseal; split=> /= n x ? HPQ n' x' ????.
+ eapply uPred_mono with n' (core x)=>//; [|by apply cmra_included_includedN].
+ apply (HPQ n' x); eauto using cmra_validN_le.
+Qed.
+
+Lemma plainly_impl_plainly P Q : (■P → ■Q) ⊢ ■(■P → Q).
+Proof.
+ unseal; split=> /= n x ? HPQ n' x' ????.
+ eapply uPred_mono with n' ε=>//; [|by apply cmra_included_includedN].
+ apply (HPQ n' x); eauto using cmra_validN_le.
+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 later_intro P : P ⊢ ▷ P.
+Proof.
+ unseal; split=> -[|n] /= x ? HP; first done.
+ apply uPred_mono with (S n) x; 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_1 P Q : ▷ (P ∗ Q) ⊢ ▷ P ∗ ▷ Q.
+Proof.
+ unseal; split=> n x ?.
+ 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].
+Qed.
+Lemma later_sep_2 P Q : ▷ P ∗ ▷ Q ⊢ ▷ (P ∗ Q).
+Proof.
+ unseal; split=> n x ?.
+ destruct n as [|n]; simpl; [done|intros (x1&x2&Hx&?&?)].
+ exists x1, x2; eauto using dist_S.
+Qed.
+
+Lemma later_false_em P : ▷ P ⊢ ▷ False ∨ (▷ False → P).
+Proof.
+ unseal; split=> -[|n] x ? /= HP; [by left|right].
+ intros [|n'] x' ????; eauto using uPred_mono, cmra_included_includedN.
+Qed.
+
+Lemma later_persistently_1 P : ▷ □ P ⊢ □ ▷ P.
+Proof. by unseal. Qed.
+Lemma later_persistently_2 P : □ ▷ P ⊢ ▷ □ P.
+Proof. by unseal. Qed.
+Lemma later_plainly_1 P : ▷ ■P ⊢ ■▷ P.
+Proof. by unseal. Qed.
+Lemma later_plainly_2 P : ■▷ P ⊢ ▷ ■P.
+Proof. by unseal. Qed.
+
+(** Internal equality *)
+Lemma internal_eq_refl {A : ofeT} P (a : A) : P ⊢ (a ≡ a).
+Proof. unseal; by split=> n x ??; simpl. Qed.
+Lemma internal_eq_rewrite {A : ofeT} a b (Ψ : A → uPred M) :
+ NonExpansive Ψ → a ≡ b ⊢ Ψ a → Ψ b.
+Proof. intros HΨ. unseal; split=> n x ?? n' x' ??? Ha. by apply HΨ with n a. Qed.
+
+Lemma fun_ext `{B : A → ofeT} (g1 g2 : ofe_fun B) :
+ (∀ i, g1 i ≡ g2 i) ⊢ g1 ≡ g2.
+Proof. by unseal. Qed.
+Lemma sig_eq {A : ofeT} (P : A → Prop) (x y : sigC P) :
+ proj1_sig x ≡ proj1_sig y ⊢ x ≡ y.
+Proof. by unseal. Qed.
+
+Lemma later_eq_1 {A : ofeT} (x y : A) : Next x ≡ Next y ⊢ ▷ (x ≡ y).
+Proof. by unseal. Qed.
+Lemma later_eq_2 {A : ofeT} (x y : A) : ▷ (x ≡ y) ⊢ Next x ≡ Next y.
+Proof. by unseal. Qed.
+
+Lemma discrete_eq_1 {A : ofeT} (a b : A) : Discrete a → a ≡ b ⊢ ⌜a ≡ bâŒ.
+Proof.
+ unseal=> ?. split=> n x ?. by apply (discrete_iff n).
+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_mono with n x; 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. eauto using uPred_mono, cmra_validN_op_l, cmra_validN_op_r.
+Qed.
+Lemma bupd_plainly P : (|==> ■P) ⊢ P.
+Proof.
+ unseal; split => n x Hnx /= Hng.
+ destruct (Hng n ε) as [? [_ Hng']]; try rewrite right_id; auto.
+ eapply uPred_mono; eauto using ucmra_unit_leastN.
+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 P : P ⊢ (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.
+
+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.
+
+(** 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} P (a : A) : ✓ a → P ⊢ (✓ 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 plainly_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.
+
+Lemma prod_validI {A B : cmraT} (x : A * B) : ✓ x ⊣⊢ ✓ x.1 ∧ ✓ x.2.
+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.
+
+Lemma discrete_valid {A : cmraT} `{!CmraDiscrete A} (a : A) : ✓ a ⊣⊢ ⌜✓ aâŒ.
+Proof. unseal; split=> n x _. by rewrite /= -cmra_discrete_valid_iff. Qed.
+
+Lemma ofe_fun_validI `{B : A → ucmraT} (g : ofe_fun B) : ✓ g ⊣⊢ ∀ i, ✓ g i.
+Proof. by unseal. Qed.
+
+(** Consistency/soundness statement *)
+Lemma soundness φ n : (True ⊢ iter n uPred_later (⌜ φ âŒ)%I) → φ.
+Proof.
+ cut (iter n (@uPred_later M) (⌜ φ âŒ)%I n ε → φ).
+ { intros help H. eapply help, H; eauto using ucmra_unit_validN. by unseal. }
+ unseal. induction n as [|n IH]=> H; auto.
+Qed.
+
+End primitive.
+End uPred_primitive.
diff --git a/theories/bi/bi.v b/theories/bi/bi.v
new file mode 100644
index 0000000000000000000000000000000000000000..9e9de7dbae24213b688f9705816f74f5d8fd6415
--- /dev/null
+++ b/theories/bi/bi.v
@@ -0,0 +1,9 @@
+From iris.bi Require Export derived_laws_bi derived_laws_sbi
+ big_op updates plainly embedding.
+Set Default Proof Using "Type".
+
+Module Import bi.
+ Export bi.interface.bi.
+ Export bi.derived_laws_bi.bi.
+ Export bi.derived_laws_sbi.bi.
+End bi.
diff --git a/theories/bi/big_op.v b/theories/bi/big_op.v
new file mode 100644
index 0000000000000000000000000000000000000000..db7dccbb1c6880b22cc108d58b9209a9c56a17fa
--- /dev/null
+++ b/theories/bi/big_op.v
@@ -0,0 +1,1162 @@
+From iris.algebra Require Export big_op.
+From iris.bi Require Import derived_laws_sbi plainly.
+From stdpp Require Import countable fin_collections functions.
+Set Default Proof Using "Type".
+Import interface.bi derived_laws_bi.bi derived_laws_sbi.bi.
+
+(** A version of the separating big operator that ranges over two lists. This
+version also ensures that both lists have the same length. Although this version
+can be defined in terms of the unary using a [zip] (see [big_sepL2_alt]), we do
+not define it that way to get better computational behavior (for [simpl]). *)
+Fixpoint big_sepL2 {PROP : bi} {A B}
+ (Φ : nat → A → B → PROP) (l1 : list A) (l2 : list B) : PROP :=
+ match l1, l2 with
+ | [], [] => emp
+ | x1 :: l1, x2 :: l2 => Φ 0 x1 x2 ∗ big_sepL2 (λ n, Φ (S n)) l1 l2
+ | _, _ => False
+ end%I.
+Instance: Params (@big_sepL2) 3.
+Arguments big_sepL2 {PROP A B} _ !_ !_ /.
+Typeclasses Opaque big_sepL2.
+
+(* Notations *)
+Notation "'[∗' 'list]' k ↦ x ∈ l , P" :=
+ (big_opL bi_sep (λ k x, P) l) : bi_scope.
+Notation "'[∗' 'list]' x ∈ l , P" :=
+ (big_opL bi_sep (λ _ x, P) l) : bi_scope.
+
+Notation "'[∗]' Ps" := (big_opL bi_sep (λ _ x, x) Ps) : bi_scope.
+
+Notation "'[∗' 'list]' k ↦ x1 ; x2 ∈ l1 ; l2 , P" :=
+ (big_sepL2 (λ k x1 x2, P) l1 l2) : bi_scope.
+Notation "'[∗' 'list]' x1 ; x2 ∈ l1 ; l2 , P" :=
+ (big_sepL2 (λ _ x1 x2, P) l1 l2) : bi_scope.
+
+Notation "'[∧' 'list]' k ↦ x ∈ l , P" :=
+ (big_opL bi_and (λ k x, P) l) : bi_scope.
+Notation "'[∧' 'list]' x ∈ l , P" :=
+ (big_opL bi_and (λ _ x, P) l) : bi_scope.
+
+Notation "'[∧]' Ps" := (big_opL bi_and (λ _ x, x) Ps) : bi_scope.
+
+Notation "'[∗' 'map]' k ↦ x ∈ m , P" := (big_opM bi_sep (λ k x, P) m) : bi_scope.
+Notation "'[∗' 'map]' x ∈ m , P" := (big_opM bi_sep (λ _ x, P) m) : bi_scope.
+
+Notation "'[∗' 'set]' x ∈ X , P" := (big_opS bi_sep (λ x, P) X) : bi_scope.
+
+Notation "'[∗' 'mset]' x ∈ X , P" := (big_opMS bi_sep (λ x, P) X) : bi_scope.
+
+(** * Properties *)
+Section bi_big_op.
+Context {PROP : bi}.
+Implicit Types Ps Qs : list PROP.
+Implicit Types A : Type.
+
+(** ** Big ops over lists *)
+Section sep_list.
+ Context {A : Type}.
+ Implicit Types l : list A.
+ Implicit Types Φ Ψ : nat → A → PROP.
+
+ Lemma big_sepL_nil Φ : ([∗ list] k↦y ∈ nil, Φ k y) ⊣⊢ emp.
+ Proof. done. Qed.
+ Lemma big_sepL_nil' `{BiAffine 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.
+ Lemma big_sepL_singleton Φ x : ([∗ list] k↦y ∈ [x], Φ k y) ⊣⊢ Φ 0 x.
+ Proof. by rewrite big_opL_singleton. Qed.
+ Lemma big_sepL_app Φ l1 l2 :
+ ([∗ list] k↦y ∈ l1 ++ l2, Φ k y)
+ ⊣⊢ ([∗ list] k↦y ∈ l1, Φ k y) ∗ ([∗ list] k↦y ∈ l2, Φ (length l1 + k) y).
+ Proof. by rewrite big_opL_app. Qed.
+
+ Lemma big_sepL_mono Φ Ψ l :
+ (∀ 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_forall; apply _. Qed.
+ Lemma big_sepL_proper Φ Ψ l :
+ (∀ 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 `{BiAffine 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.
+
+ Global Instance big_sepL_mono' :
+ Proper (pointwise_relation _ (pointwise_relation _ (⊢)) ==> (=) ==> (⊢))
+ (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_sepL_id_mono' :
+ 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) ⊣⊢@{PROP} emp.
+ 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)).
+ Proof.
+ intros Hli. rewrite -(take_drop_middle l i x) // big_sepL_app /=.
+ rewrite Nat.add_0_r take_length_le; eauto using lookup_lt_Some, Nat.lt_le_incl.
+ rewrite assoc -!(comm _ (Φ _ _)) -assoc. by apply sep_mono_r, wand_intro_l.
+ Qed.
+
+ Lemma big_sepL_lookup Φ l i x `{!Absorbing (Φ i x)} :
+ l !! i = Some x → ([∗ list] k↦y ∈ l, Φ k y) ⊢ Φ i x.
+ Proof. intros. rewrite big_sepL_lookup_acc //. by rewrite sep_elim_l. Qed.
+
+ 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 → PROP) l :
+ ([∗ list] k↦y ∈ f <$> l, Φ k y) ⊣⊢ ([∗ list] k↦y ∈ l, Φ k (f y)).
+ Proof. by rewrite big_opL_fmap. Qed.
+
+ Lemma big_sepL_sepL Φ Ψ l :
+ ([∗ list] k↦x ∈ l, Φ k x ∗ Ψ k x)
+ ⊣⊢ ([∗ list] k↦x ∈ l, Φ k x) ∗ ([∗ list] k↦x ∈ l, Ψ k x).
+ Proof. by rewrite big_opL_opL. Qed.
+
+ 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 and_intro, big_sepL_mono, and_elim_l, and_elim_r. Qed.
+
+ Lemma big_sepL_persistently `{BiAffine PROP} Φ l :
+ <pers> ([∗ list] k↦x ∈ l, Φ k x) ⊣⊢ [∗ list] k↦x ∈ l, <pers> (Φ k x).
+ Proof. apply (big_opL_commute _). Qed.
+
+ Lemma big_sepL_forall `{BiAffine 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Φ; [by auto using big_sepL_nil'|].
+ rewrite big_sepL_cons. rewrite -persistent_and_sep; 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 :
+ ([∗ list] k↦x ∈ l, Φ k x) -∗
+ □ (∀ k x, ⌜l !! k = Some x⌠→ Φ k x -∗ Ψ k x) -∗
+ [∗ list] k↦x ∈ l, Ψ k x.
+ Proof.
+ apply wand_intro_l. revert Φ Ψ. induction l as [|x l IH]=> Φ Ψ /=.
+ { by rewrite sep_elim_r. }
+ rewrite intuitionistically_sep_dup -assoc [(□ _ ∗ _)%I]comm -!assoc assoc.
+ apply sep_mono.
+ - rewrite (forall_elim 0) (forall_elim x) pure_True // True_impl.
+ by rewrite intuitionistically_elim wand_elim_l.
+ - rewrite comm -(IH (Φ ∘ S) (Ψ ∘ S)) /=.
+ apply sep_mono_l, affinely_mono, persistently_mono.
+ apply forall_intro=> k. by rewrite (forall_elim (S k)).
+ Qed.
+
+ Lemma big_sepL_delete Φ l i x :
+ l !! i = Some x →
+ ([∗ list] k↦y ∈ l, Φ k y)
+ ⊣⊢ Φ i x ∗ [∗ list] k↦y ∈ l, if decide (k = i) then emp else Φ k y.
+ Proof.
+ intros. rewrite -(take_drop_middle l i x) // !big_sepL_app /= Nat.add_0_r.
+ rewrite take_length_le; last eauto using lookup_lt_Some, Nat.lt_le_incl.
+ rewrite decide_True // left_id.
+ rewrite assoc -!(comm _ (Φ _ _)) -assoc. do 2 f_equiv.
+ - apply big_sepL_proper=> k y Hk. apply lookup_lt_Some in Hk.
+ rewrite take_length in Hk. by rewrite decide_False; last lia.
+ - apply big_sepL_proper=> k y _. by rewrite decide_False; last lia.
+ Qed.
+
+ Lemma big_sepL_delete' `{!BiAffine PROP} Φ l i x :
+ l !! i = Some x →
+ ([∗ list] k↦y ∈ l, Φ k y) ⊣⊢ Φ i x ∗ [∗ list] k↦y ∈ l, ⌜ k ≠i ⌠→ Φ k y.
+ Proof.
+ intros. rewrite big_sepL_delete //. (do 2 f_equiv)=> k y.
+ rewrite -decide_emp. by repeat case_decide.
+ Qed.
+
+ Global Instance big_sepL_nil_persistent Φ :
+ Persistent ([∗ list] k↦x ∈ [], Φ k x).
+ Proof. simpl; apply _. Qed.
+ Global Instance big_sepL_persistent Φ 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 :
+ TCForall Persistent Ps → Persistent ([∗] Ps).
+ Proof. induction 1; simpl; apply _. Qed.
+
+ Global Instance big_sepL_nil_affine Φ :
+ Affine ([∗ list] k↦x ∈ [], Φ k x).
+ Proof. simpl; apply _. Qed.
+ Global Instance big_sepL_affine Φ l :
+ (∀ k x, Affine (Φ k x)) → Affine ([∗ list] k↦x ∈ l, Φ k x).
+ Proof. revert Φ. induction l as [|x l IH]=> Φ ? /=; apply _. Qed.
+ Global Instance big_sepL_affine_id Ps : TCForall Affine Ps → Affine ([∗] Ps).
+ Proof. induction 1; simpl; apply _. Qed.
+End sep_list.
+
+Section sep_list_more.
+ Context {A : Type}.
+ Implicit Types l : list A.
+ 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, if l2 !! k is Some y then Φ k (f x y) else emp).
+ Proof.
+ revert Φ l2; induction l1 as [|x l1 IH]=> Φ [|y l2] //=.
+ - by rewrite big_sepL_emp left_id.
+ - by rewrite IH.
+ Qed.
+End sep_list_more.
+
+Lemma big_sepL2_alt {A B} (Φ : nat → A → B → PROP) l1 l2 :
+ ([∗ list] k↦y1;y2 ∈ l1; l2, Φ k y1 y2)
+ ⊣⊢ ⌜ length l1 = length l2 ⌠∧ [∗ list] k ↦ y ∈ zip l1 l2, Φ k (y.1) (y.2).
+Proof.
+ apply (anti_symm _).
+ - apply and_intro.
+ + revert Φ l2. induction l1 as [|x1 l1 IH]=> Φ -[|x2 l2] /=;
+ auto using pure_intro, False_elim.
+ rewrite IH sep_elim_r. apply pure_mono; auto.
+ + revert Φ l2. induction l1 as [|x1 l1 IH]=> Φ -[|x2 l2] /=;
+ auto using pure_intro, False_elim.
+ by rewrite IH.
+ - apply pure_elim_l=> /Forall2_same_length Hl. revert Φ.
+ induction Hl as [|x1 l1 x2 l2 _ _ IH]=> Φ //=. by rewrite -IH.
+Qed.
+
+(** ** Big ops over two lists *)
+Section sep_list2.
+ Context {A B : Type}.
+ Implicit Types Φ Ψ : nat → A → B → PROP.
+
+ Lemma big_sepL2_nil Φ : ([∗ list] k↦y1;y2 ∈ []; [], Φ k y1 y2) ⊣⊢ emp.
+ Proof. done. Qed.
+ Lemma big_sepL2_nil' `{BiAffine PROP} P Φ : P ⊢ [∗ list] k↦y1;y2 ∈ [];[], Φ k y1 y2.
+ Proof. apply (affine _). Qed.
+
+ Lemma big_sepL2_cons Φ x1 x2 l1 l2 :
+ ([∗ list] k↦y1;y2 ∈ x1 :: l1; x2 :: l2, Φ k y1 y2)
+ ⊣⊢ Φ 0 x1 x2 ∗ [∗ list] k↦y1;y2 ∈ l1;l2, Φ (S k) y1 y2.
+ Proof. done. Qed.
+ Lemma big_sepL2_cons_inv_l Φ x1 l1 l2 :
+ ([∗ list] k↦y1;y2 ∈ x1 :: l1; l2, Φ k y1 y2) -∗
+ ∃ x2 l2', ⌜ l2 = x2 :: l2' ⌠∧
+ Φ 0 x1 x2 ∗ [∗ list] k↦y1;y2 ∈ l1;l2', Φ (S k) y1 y2.
+ Proof.
+ destruct l2 as [|x2 l2]; simpl; auto using False_elim.
+ by rewrite -(exist_intro x2) -(exist_intro l2) pure_True // left_id.
+ Qed.
+ Lemma big_sepL2_cons_inv_r Φ x2 l1 l2 :
+ ([∗ list] k↦y1;y2 ∈ l1; x2 :: l2, Φ k y1 y2) -∗
+ ∃ x1 l1', ⌜ l1 = x1 :: l1' ⌠∧
+ Φ 0 x1 x2 ∗ [∗ list] k↦y1;y2 ∈ l1';l2, Φ (S k) y1 y2.
+ Proof.
+ destruct l1 as [|x1 l1]; simpl; auto using False_elim.
+ by rewrite -(exist_intro x1) -(exist_intro l1) pure_True // left_id.
+ Qed.
+
+ Lemma big_sepL2_singleton Φ x1 x2 :
+ ([∗ list] k↦y1;y2 ∈ [x1];[x2], Φ k y1 y2) ⊣⊢ Φ 0 x1 x2.
+ Proof. by rewrite /= right_id. Qed.
+
+ Lemma big_sepL2_length Φ l1 l2 :
+ ([∗ list] k↦y1;y2 ∈ l1; l2, Φ k y1 y2) -∗ ⌜ length l1 = length l2 âŒ.
+ Proof. by rewrite big_sepL2_alt and_elim_l. Qed.
+
+ Lemma big_sepL2_app Φ l1 l2 l1' l2' :
+ ([∗ list] k↦y1;y2 ∈ l1; l1', Φ k y1 y2) -∗
+ ([∗ list] k↦y1;y2 ∈ l2; l2', Φ (length l1 + k) y1 y2) -∗
+ ([∗ list] k↦y1;y2 ∈ l1 ++ l2; l1' ++ l2', Φ k y1 y2).
+ Proof.
+ apply wand_intro_r. revert Φ l1'. induction l1 as [|x1 l1 IH]=> Φ -[|x1' l1'] /=.
+ - by rewrite left_id.
+ - rewrite left_absorb. apply False_elim.
+ - rewrite left_absorb. apply False_elim.
+ - by rewrite -assoc IH.
+ Qed.
+ Lemma big_sepL2_app_inv_l Φ l1' l1'' l2 :
+ ([∗ list] k↦y1;y2 ∈ l1' ++ l1''; l2, Φ k y1 y2) -∗
+ ∃ l2' l2'', ⌜ l2 = l2' ++ l2'' ⌠∧
+ ([∗ list] k↦y1;y2 ∈ l1';l2', Φ k y1 y2) ∗
+ ([∗ list] k↦y1;y2 ∈ l1'';l2'', Φ (length l1' + k) y1 y2).
+ Proof.
+ rewrite -(exist_intro (take (length l1') l2))
+ -(exist_intro (drop (length l1') l2)) take_drop pure_True // left_id.
+ revert Φ l2. induction l1' as [|x1 l1' IH]=> Φ -[|x2 l2] /=;
+ [by rewrite left_id|by rewrite left_id|apply False_elim|].
+ by rewrite IH -assoc.
+ Qed.
+ Lemma big_sepL2_app_inv_r Φ l1 l2' l2'' :
+ ([∗ list] k↦y1;y2 ∈ l1; l2' ++ l2'', Φ k y1 y2) -∗
+ ∃ l1' l1'', ⌜ l1 = l1' ++ l1'' ⌠∧
+ ([∗ list] k↦y1;y2 ∈ l1';l2', Φ k y1 y2) ∗
+ ([∗ list] k↦y1;y2 ∈ l1'';l2'', Φ (length l2' + k) y1 y2).
+ Proof.
+ rewrite -(exist_intro (take (length l2') l1))
+ -(exist_intro (drop (length l2') l1)) take_drop pure_True // left_id.
+ revert Φ l1. induction l2' as [|x2 l2' IH]=> Φ -[|x1 l1] /=;
+ [by rewrite left_id|by rewrite left_id|apply False_elim|].
+ by rewrite IH -assoc.
+ Qed.
+
+ Lemma big_sepL2_mono Φ Ψ l1 l2 :
+ (∀ k y1 y2, l1 !! k = Some y1 → l2 !! k = Some y2 → Φ k y1 y2 ⊢ Ψ k y1 y2) →
+ ([∗ list] k ↦ y1;y2 ∈ l1;l2, Φ k y1 y2) ⊢ [∗ list] k ↦ y1;y2 ∈ l1;l2, Ψ k y1 y2.
+ Proof.
+ intros H. rewrite !big_sepL2_alt. f_equiv. apply big_sepL_mono=> k [y1 y2].
+ rewrite lookup_zip_with=> ?; simplify_option_eq; auto.
+ Qed.
+ Lemma big_sepL2_proper Φ Ψ l1 l2 :
+ (∀ k y1 y2, l1 !! k = Some y1 → l2 !! k = Some y2 → Φ k y1 y2 ⊣⊢ Ψ k y1 y2) →
+ ([∗ list] k ↦ y1;y2 ∈ l1;l2, Φ k y1 y2) ⊣⊢ [∗ list] k ↦ y1;y2 ∈ l1;l2, Ψ k y1 y2.
+ Proof.
+ intros; apply (anti_symm _);
+ apply big_sepL2_mono; auto using equiv_entails, equiv_entails_sym.
+ Qed.
+
+ Global Instance big_sepL2_ne n :
+ Proper (pointwise_relation _ (pointwise_relation _ (pointwise_relation _ (dist n)))
+ ==> (=) ==> (=) ==> (dist n))
+ (big_sepL2 (PROP:=PROP) (A:=A) (B:=B)).
+ Proof.
+ intros Φ1 Φ2 HΦ x1 ? <- x2 ? <-. rewrite !big_sepL2_alt. f_equiv.
+ f_equiv=> k [y1 y2]. apply HΦ.
+ Qed.
+ Global Instance big_sepL2_mono' :
+ Proper (pointwise_relation _ (pointwise_relation _ (pointwise_relation _ (⊢)))
+ ==> (=) ==> (=) ==> (⊢))
+ (big_sepL2 (PROP:=PROP) (A:=A) (B:=B)).
+ Proof. intros f g Hf l1 ? <- l2 ? <-. apply big_sepL2_mono; intros; apply Hf. Qed.
+ Global Instance big_sepL2_proper' :
+ Proper (pointwise_relation _ (pointwise_relation _ (pointwise_relation _ (⊣⊢)))
+ ==> (=) ==> (=) ==> (⊣⊢))
+ (big_sepL2 (PROP:=PROP) (A:=A) (B:=B)).
+ Proof. intros f g Hf l1 ? <- l2 ? <-. apply big_sepL2_proper; intros; apply Hf. Qed.
+
+ Lemma big_sepL2_lookup_acc Φ l1 l2 i x1 x2 :
+ l1 !! i = Some x1 → l2 !! i = Some x2 →
+ ([∗ list] k↦y1;y2 ∈ l1;l2, Φ k y1 y2) ⊢
+ Φ i x1 x2 ∗ (Φ i x1 x2 -∗ ([∗ list] k↦y1;y2 ∈ l1;l2, Φ k y1 y2)).
+ Proof.
+ intros Hl1 Hl2. rewrite big_sepL2_alt. apply pure_elim_l=> Hl.
+ rewrite {1}big_sepL_lookup_acc; last by rewrite lookup_zip_with; simplify_option_eq.
+ by rewrite pure_True // left_id.
+ Qed.
+
+ Lemma big_sepL2_lookup Φ l1 l2 i x1 x2 `{!Absorbing (Φ i x1 x2)} :
+ l1 !! i = Some x1 → l2 !! i = Some x2 →
+ ([∗ list] k↦y1;y2 ∈ l1;l2, Φ k y1 y2) ⊢ Φ i x1 x2.
+ Proof. intros. rewrite big_sepL2_lookup_acc //. by rewrite sep_elim_l. Qed.
+
+ Lemma big_sepL2_fmap_l {A'} (f : A → A') (Φ : nat → A' → B → PROP) l1 l2 :
+ ([∗ list] k↦y1;y2 ∈ f <$> l1; l2, Φ k y1 y2)
+ ⊣⊢ ([∗ list] k↦y1;y2 ∈ l1;l2, Φ k (f y1) y2).
+ Proof.
+ rewrite !big_sepL2_alt fmap_length zip_with_fmap_l zip_with_zip big_sepL_fmap.
+ by f_equiv; f_equiv=> k [??].
+ Qed.
+ Lemma big_sepL2_fmap_r {B'} (g : B → B') (Φ : nat → A → B' → PROP) l1 l2 :
+ ([∗ list] k↦y1;y2 ∈ l1; g <$> l2, Φ k y1 y2)
+ ⊣⊢ ([∗ list] k↦y1;y2 ∈ l1;l2, Φ k y1 (g y2)).
+ Proof.
+ rewrite !big_sepL2_alt fmap_length zip_with_fmap_r zip_with_zip big_sepL_fmap.
+ by f_equiv; f_equiv=> k [??].
+ Qed.
+
+ Lemma big_sepL2_sepL2 Φ Ψ l1 l2 :
+ ([∗ list] k↦y1;y2 ∈ l1;l2, Φ k y1 y2 ∗ Ψ k y1 y2)
+ ⊣⊢ ([∗ list] k↦y1;y2 ∈ l1;l2, Φ k y1 y2) ∗ ([∗ list] k↦y1;y2 ∈ l1;l2, Ψ k y1 y2).
+ Proof.
+ rewrite !big_sepL2_alt big_sepL_sepL !persistent_and_affinely_sep_l.
+ rewrite -assoc (assoc _ _ (<affine> _)%I). rewrite -(comm bi_sep (<affine> _)%I).
+ rewrite -assoc (assoc _ _ (<affine> _)%I) -!persistent_and_affinely_sep_l.
+ by rewrite affinely_and_r persistent_and_affinely_sep_l idemp.
+ Qed.
+
+ Lemma big_sepL2_and Φ Ψ l1 l2 :
+ ([∗ list] k↦y1;y2 ∈ l1;l2, Φ k y1 y2 ∧ Ψ k y1 y2)
+ ⊢ ([∗ list] k↦y1;y2 ∈ l1;l2, Φ k y1 y2) ∧ ([∗ list] k↦y1;y2 ∈ l1;l2, Ψ k y1 y2).
+ Proof. auto using and_intro, big_sepL2_mono, and_elim_l, and_elim_r. Qed.
+
+ Lemma big_sepL2_persistently `{BiAffine PROP} Φ l1 l2 :
+ <pers> ([∗ list] k↦y1;y2 ∈ l1;l2, Φ k y1 y2)
+ ⊣⊢ [∗ list] k↦y1;y2 ∈ l1;l2, <pers> (Φ k y1 y2).
+ Proof.
+ by rewrite !big_sepL2_alt persistently_and persistently_pure big_sepL_persistently.
+ Qed.
+
+ Lemma big_sepL2_impl Φ Ψ l1 l2 :
+ ([∗ list] k↦y1;y2 ∈ l1;l2, Φ k y1 y2) -∗
+ □ (∀ k x1 x2,
+ ⌜l1 !! k = Some x1⌠→ ⌜l2 !! k = Some x2⌠→ Φ k x1 x2 -∗ Ψ k x1 x2) -∗
+ [∗ list] k↦y1;y2 ∈ l1;l2, Ψ k y1 y2.
+ Proof.
+ apply wand_intro_l. revert Φ Ψ l2.
+ induction l1 as [|x1 l1 IH]=> Φ Ψ [|x2 l2] /=; [by rewrite sep_elim_r..|].
+ rewrite intuitionistically_sep_dup -assoc [(□ _ ∗ _)%I]comm -!assoc assoc.
+ apply sep_mono.
+ - rewrite (forall_elim 0) (forall_elim x1) (forall_elim x2) !pure_True // !True_impl.
+ by rewrite intuitionistically_elim wand_elim_l.
+ - rewrite comm -(IH (Φ ∘ S) (Ψ ∘ S)) /=.
+ apply sep_mono_l, affinely_mono, persistently_mono.
+ apply forall_intro=> k. by rewrite (forall_elim (S k)).
+ Qed.
+
+ Global Instance big_sepL2_nil_persistent Φ :
+ Persistent ([∗ list] k↦y1;y2 ∈ []; [], Φ k y1 y2).
+ Proof. simpl; apply _. Qed.
+ Global Instance big_sepL2_persistent Φ l1 l2 :
+ (∀ k x1 x2, Persistent (Φ k x1 x2)) →
+ Persistent ([∗ list] k↦y1;y2 ∈ l1;l2, Φ k y1 y2).
+ Proof. rewrite big_sepL2_alt. apply _. Qed.
+
+ Global Instance big_sepL2_nil_affine Φ :
+ Affine ([∗ list] k↦y1;y2 ∈ []; [], Φ k y1 y2).
+ Proof. simpl; apply _. Qed.
+ Global Instance big_sepL2_affine Φ l1 l2 :
+ (∀ k x1 x2, Affine (Φ k x1 x2)) →
+ Affine ([∗ list] k↦y1;y2 ∈ l1;l2, Φ k y1 y2).
+ Proof. rewrite big_sepL2_alt. apply _. Qed.
+End sep_list2.
+
+Section and_list.
+ Context {A : Type}.
+ Implicit Types l : list A.
+ Implicit Types Φ Ψ : nat → A → PROP.
+
+ Lemma big_andL_nil Φ : ([∧ list] k↦y ∈ nil, Φ k y) ⊣⊢ True.
+ Proof. done. Qed.
+ Lemma big_andL_nil' P Φ : P ⊢ [∧ list] k↦y ∈ nil, Φ k y.
+ Proof. by apply pure_intro. Qed.
+ Lemma big_andL_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.
+ Lemma big_andL_singleton Φ x : ([∧ list] k↦y ∈ [x], Φ k y) ⊣⊢ Φ 0 x.
+ Proof. by rewrite big_opL_singleton. Qed.
+ Lemma big_andL_app Φ l1 l2 :
+ ([∧ list] k↦y ∈ l1 ++ l2, Φ k y)
+ ⊣⊢ ([∧ list] k↦y ∈ l1, Φ k y) ∧ ([∧ list] k↦y ∈ l2, Φ (length l1 + k) y).
+ Proof. by rewrite big_opL_app. Qed.
+
+ Lemma big_andL_mono Φ Ψ l :
+ (∀ 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_forall; apply _. Qed.
+ Lemma big_andL_proper Φ Ψ l :
+ (∀ 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_andL_submseteq (Φ : A → PROP) l1 l2 :
+ l1 ⊆+ l2 → ([∧ list] y ∈ l2, Φ y) ⊢ [∧ list] y ∈ l1, Φ y.
+ Proof.
+ intros [l ->]%submseteq_Permutation. by rewrite big_andL_app and_elim_l.
+ Qed.
+
+ Global Instance big_andL_mono' :
+ Proper (pointwise_relation _ (pointwise_relation _ (⊢)) ==> (=) ==> (⊢))
+ (big_opL (@bi_and PROP) (A:=A)).
+ Proof. intros f g Hf m ? <-. apply big_opL_forall; apply _ || intros; apply Hf. Qed.
+ Global Instance big_andL_id_mono' :
+ Proper (Forall2 (⊢) ==> (⊢)) (big_opL (@bi_and M) (λ _ P, P)).
+ Proof. by induction 1 as [|P Q Ps Qs HPQ ? IH]; rewrite /= ?HPQ ?IH. Qed.
+
+ Lemma big_andL_lookup Φ l i x `{!Absorbing (Φ i x)} :
+ l !! i = Some x → ([∧ list] k↦y ∈ l, Φ k y) ⊢ Φ i x.
+ Proof.
+ intros. rewrite -(take_drop_middle l i x) // big_andL_app /=.
+ rewrite Nat.add_0_r take_length_le;
+ eauto using lookup_lt_Some, Nat.lt_le_incl, and_elim_l', and_elim_r'.
+ Qed.
+
+ Lemma big_andL_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_andL_lookup (λ _, Φ)).
+ Qed.
+
+ Lemma big_andL_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.
+
+ Lemma big_andL_andL Φ Ψ l :
+ ([∧ list] k↦x ∈ l, Φ k x ∧ Ψ k x)
+ ⊣⊢ ([∧ list] k↦x ∈ l, Φ k x) ∧ ([∧ list] k↦x ∈ l, Ψ k x).
+ Proof. by rewrite big_opL_opL. Qed.
+
+ Lemma big_andL_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 and_intro, big_andL_mono, and_elim_l, and_elim_r. Qed.
+
+ Lemma big_andL_persistently Φ l :
+ <pers> ([∧ list] k↦x ∈ l, Φ k x) ⊣⊢ [∧ list] k↦x ∈ l, <pers> (Φ k x).
+ Proof. apply (big_opL_commute _). Qed.
+
+ Lemma big_andL_forall `{BiAffine PROP} Φ l :
+ ([∧ list] k↦x ∈ l, Φ k x) ⊣⊢ (∀ k x, ⌜l !! k = Some x⌠→ Φ k x).
+ Proof.
+ apply (anti_symm _).
+ { apply forall_intro=> k; apply forall_intro=> x.
+ apply impl_intro_l, pure_elim_l=> ?; by apply: big_andL_lookup. }
+ revert Φ. induction l as [|x l IH]=> Φ; [by auto using big_andL_nil'|].
+ rewrite big_andL_cons. 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.
+
+ Global Instance big_andL_nil_persistent Φ :
+ Persistent ([∧ list] k↦x ∈ [], Φ k x).
+ Proof. simpl; apply _. Qed.
+ Global Instance big_andL_persistent Φ l :
+ (∀ k x, Persistent (Φ k x)) → Persistent ([∧ list] k↦x ∈ l, Φ k x).
+ Proof. revert Φ. induction l as [|x l IH]=> Φ ? /=; apply _. Qed.
+End and_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_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 `{BiAffine 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 (@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) ⊣⊢ emp.
+ Proof. by rewrite big_opM_empty. Qed.
+ Lemma big_sepM_empty' `{BiAffine 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 →
+ ([∗ map] k↦y ∈ <[i:=x]> m, Φ k y) ⊣⊢ Φ i x ∗ [∗ map] k↦y ∈ m, Φ k y.
+ Proof. apply big_opM_insert. Qed.
+
+ Lemma big_sepM_delete Φ m i x :
+ m !! i = Some x →
+ ([∗ map] k↦y ∈ m, Φ k y) ⊣⊢ Φ i x ∗ [∗ map] k↦y ∈ delete i m, Φ k y.
+ Proof. apply big_opM_delete. Qed.
+
+ Lemma big_sepM_lookup_acc Φ m i x :
+ m !! i = Some x →
+ ([∗ map] k↦y ∈ m, Φ k y) ⊢ Φ i x ∗ (Φ i x -∗ ([∗ map] k↦y ∈ m, Φ k y)).
+ Proof.
+ intros. rewrite big_sepM_delete //. by apply sep_mono_r, wand_intro_l.
+ Qed.
+
+ Lemma big_sepM_lookup Φ m i x `{!Absorbing (Φ i x)} :
+ m !! i = Some x → ([∗ map] k↦y ∈ m, Φ k y) ⊢ Φ i x.
+ Proof. intros. rewrite big_sepM_lookup_acc //. by rewrite sep_elim_l. Qed.
+
+ 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 → PROP) m :
+ ([∗ map] k↦y ∈ f <$> m, Φ k y) ⊣⊢ ([∗ map] k↦y ∈ m, Φ k (f y)).
+ Proof. by rewrite big_opM_fmap. Qed.
+
+ Lemma big_sepM_insert_override Φ m i x x' :
+ m !! i = Some x → (Φ i x ⊣⊢ Φ i x') →
+ ([∗ map] k↦y ∈ <[i:=x']> m, Φ k y) ⊣⊢ ([∗ map] k↦y ∈ m, Φ k y).
+ Proof. apply big_opM_insert_override. Qed.
+
+ Lemma big_sepM_insert_override_1 Φ m i x x' :
+ m !! i = Some x →
+ ([∗ map] k↦y ∈ <[i:=x']> m, Φ k y) ⊢
+ (Φ i x' -∗ Φ i x) -∗ ([∗ map] k↦y ∈ m, Φ k y).
+ Proof.
+ intros ?. apply wand_intro_l.
+ rewrite -insert_delete big_sepM_insert ?lookup_delete //.
+ by rewrite assoc wand_elim_l -big_sepM_delete.
+ Qed.
+
+ Lemma big_sepM_insert_override_2 Φ m i x x' :
+ m !! i = Some x →
+ ([∗ map] k↦y ∈ m, Φ k y) ⊢
+ (Φ i x -∗ Φ i x') -∗ ([∗ map] k↦y ∈ <[i:=x']> m, Φ k y).
+ Proof.
+ intros ?. apply wand_intro_l.
+ rewrite {1}big_sepM_delete //; rewrite assoc wand_elim_l.
+ rewrite -insert_delete big_sepM_insert ?lookup_delete //.
+ Qed.
+
+ 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 → 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.
+
+ Lemma big_sepM_sepM Φ Ψ m :
+ ([∗ map] k↦x ∈ m, Φ k x ∗ Ψ k x)
+ ⊣⊢ ([∗ map] k↦x ∈ m, Φ k x) ∗ ([∗ map] k↦x ∈ m, Ψ k x).
+ Proof. apply big_opM_opM. Qed.
+
+ 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 and_intro, big_sepM_mono, and_elim_l, and_elim_r. Qed.
+
+ Lemma big_sepM_persistently `{BiAffine PROP} Φ m :
+ (<pers> ([∗ map] k↦x ∈ m, Φ k x)) ⊣⊢ ([∗ map] k↦x ∈ m, <pers> (Φ k x)).
+ Proof. apply (big_opM_commute _). Qed.
+
+ Lemma big_sepM_forall `{BiAffine 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; auto using big_sepM_empty'.
+ rewrite big_sepM_insert // -persistent_and_sep. 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.
+ apply impl_intro_l, pure_elim_l=> ?.
+ rewrite lookup_insert_ne; last by intros ?; simplify_map_eq.
+ by rewrite pure_True // True_impl.
+ Qed.
+
+ Lemma big_sepM_impl Φ Ψ m :
+ ([∗ map] k↦x ∈ m, Φ k x) -∗
+ □ (∀ k x, ⌜m !! k = Some x⌠→ Φ k x -∗ Ψ k x) -∗
+ [∗ map] k↦x ∈ m, Ψ k x.
+ Proof.
+ apply wand_intro_l. induction m as [|i x m ? IH] using map_ind.
+ { by rewrite sep_elim_r. }
+ rewrite !big_sepM_insert // intuitionistically_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 intuitionistically_elim wand_elim_l.
+ - rewrite comm -IH /=.
+ apply sep_mono_l, affinely_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 Φ :
+ Persistent ([∗ map] k↦x ∈ ∅, Φ k x).
+ Proof. rewrite /big_opM map_to_list_empty. apply _. Qed.
+ Global Instance big_sepM_persistent Φ 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_empty_affine Φ :
+ Affine ([∗ map] k↦x ∈ ∅, Φ k x).
+ Proof. rewrite /big_opM map_to_list_empty. apply _. Qed.
+ Global Instance big_sepM_affine Φ m :
+ (∀ k x, Affine (Φ k x)) → Affine ([∗ map] k↦x ∈ m, Φ k x).
+ Proof. intros. apply big_sepL_affine=> _ [??]; 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_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 `{BiAffine 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 (@bi_sep PROP) (A:=A)).
+ Proof. intros f g Hf m ? <-. by apply big_sepS_mono. Qed.
+
+ Lemma big_sepS_empty Φ : ([∗ set] x ∈ ∅, Φ x) ⊣⊢ emp.
+ Proof. by rewrite big_opS_empty. Qed.
+ Lemma big_sepS_empty' `{!BiAffine 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 → PROP) f X x b :
+ x ∉ X →
+ ([∗ set] y ∈ {[ x ]} ∪ X, Ψ y (<[x:=b]> f y))
+ ⊣⊢ (Ψ x b ∗ [∗ set] y ∈ X, Ψ y (f y)).
+ Proof. apply big_opS_fn_insert. Qed.
+
+ Lemma big_sepS_fn_insert' Φ X x P :
+ x ∉ X → ([∗ set] y ∈ {[ x ]} ∪ X, <[x:=P]> Φ y) ⊣⊢ (P ∗ [∗ set] y ∈ X, Φ y).
+ Proof. apply big_opS_fn_insert'. Qed.
+
+ Lemma big_sepS_union Φ X Y :
+ X ## Y →
+ ([∗ set] y ∈ X ∪ Y, Φ y) ⊣⊢ ([∗ set] y ∈ X, Φ y) ∗ ([∗ set] y ∈ Y, Φ y).
+ Proof. apply big_opS_union. Qed.
+
+ Lemma big_sepS_delete Φ X x :
+ 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 `{!Absorbing (Φ x)} :
+ x ∈ X → ([∗ set] y ∈ X, Φ y) ⊢ Φ x.
+ Proof. intros. rewrite big_sepS_delete //. by rewrite sep_elim_l. Qed.
+
+ Lemma big_sepS_elem_of_acc Φ X x :
+ x ∈ X →
+ ([∗ set] y ∈ X, Φ y) ⊢ Φ x ∗ (Φ x -∗ ([∗ set] y ∈ X, Φ y)).
+ Proof.
+ intros. rewrite big_sepS_delete //. by apply sep_mono_r, wand_intro_l.
+ Qed.
+
+ 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, 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 decide_True // IH.
+ - rewrite filter_union_L filter_singleton_not_L // left_id_L.
+ 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 :
+ (∀ y, y ∈ Y → P y → y ∈ X) →
+ ([∗ 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.
+ Qed.
+
+ Lemma big_sepS_filter `{BiAffine 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 `{BiAffine 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 and_intro, big_sepS_mono, and_elim_l, and_elim_r. Qed.
+
+ Lemma big_sepS_persistently `{BiAffine PROP} Φ X :
+ <pers> ([∗ set] y ∈ X, Φ y) ⊣⊢ [∗ set] y ∈ X, <pers> (Φ y).
+ Proof. apply (big_opS_commute _). Qed.
+
+ Lemma big_sepS_forall `{BiAffine 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; auto using big_sepS_empty'.
+ rewrite big_sepS_insert // -persistent_and_sep. 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 :
+ ([∗ set] x ∈ X, Φ x) -∗
+ □ (∀ x, ⌜x ∈ X⌠→ Φ x -∗ Ψ x) -∗
+ [∗ set] x ∈ X, Ψ x.
+ Proof.
+ apply wand_intro_l. induction X as [|x X ? IH] using collection_ind_L.
+ { by rewrite sep_elim_r. }
+ rewrite !big_sepS_insert // intuitionistically_sep_dup.
+ rewrite -assoc [(□ _ ∗ _)%I]comm -!assoc assoc. apply sep_mono.
+ - rewrite (forall_elim x) pure_True; last set_solver.
+ by rewrite True_impl intuitionistically_elim wand_elim_l.
+ - rewrite comm -IH /=. apply sep_mono_l, affinely_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).
+ Proof. rewrite /big_opS elements_empty. apply _. Qed.
+ Global Instance big_sepS_persistent Φ X :
+ (∀ x, Persistent (Φ x)) → Persistent ([∗ set] x ∈ X, Φ x).
+ Proof. rewrite /big_opS. apply _. Qed.
+
+ Global Instance big_sepS_empty_affine Φ : Affine ([∗ set] x ∈ ∅, Φ x).
+ Proof. rewrite /big_opS elements_empty. apply _. Qed.
+ Global Instance big_sepS_affine Φ X :
+ (∀ x, Affine (Φ x)) → Affine ([∗ set] x ∈ X, Φ x).
+ Proof. rewrite /big_opS. apply _. Qed.
+End gset.
+
+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.
+
+(** ** Big ops over finite multisets *)
+Section gmultiset.
+ Context `{Countable A}.
+ Implicit Types X : gmultiset A.
+ Implicit Types Φ : A → PROP.
+
+ 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 `{BiAffine 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 (@bi_sep PROP) (A:=A)).
+ Proof. intros f g Hf m ? <-. by apply big_sepMS_mono. Qed.
+
+ Lemma big_sepMS_empty Φ : ([∗ mset] x ∈ ∅, Φ x) ⊣⊢ emp.
+ Proof. by rewrite big_opMS_empty. Qed.
+ Lemma big_sepMS_empty' `{!BiAffine 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.
+ Proof. apply big_opMS_union. Qed.
+
+ Lemma big_sepMS_delete Φ X x :
+ 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 `{!Absorbing (Φ x)} :
+ x ∈ X → ([∗ mset] y ∈ X, Φ y) ⊢ Φ x.
+ Proof. intros. rewrite big_sepMS_delete //. by rewrite sep_elim_l. Qed.
+
+ Lemma big_sepMS_elem_of_acc Φ X x :
+ x ∈ X →
+ ([∗ mset] y ∈ X, Φ y) ⊢ Φ x ∗ (Φ x -∗ ([∗ mset] y ∈ X, Φ y)).
+ Proof.
+ intros. rewrite big_sepMS_delete //. by apply sep_mono_r, wand_intro_l.
+ Qed.
+
+ Lemma big_sepMS_singleton Φ x : ([∗ mset] y ∈ {[ x ]}, Φ y) ⊣⊢ Φ x.
+ Proof. apply big_opMS_singleton. Qed.
+
+ Lemma big_sepMS_sepMS Φ Ψ X :
+ ([∗ mset] y ∈ X, Φ y ∗ Ψ y) ⊣⊢ ([∗ mset] y ∈ X, Φ y) ∗ ([∗ mset] y ∈ X, Ψ y).
+ Proof. apply big_opMS_opMS. Qed.
+
+ Lemma big_sepMS_and Φ Ψ X :
+ ([∗ mset] y ∈ X, Φ y ∧ Ψ y) ⊢ ([∗ mset] y ∈ X, Φ y) ∧ ([∗ mset] y ∈ X, Ψ y).
+ Proof. auto using and_intro, big_sepMS_mono, and_elim_l, and_elim_r. Qed.
+
+ Lemma big_sepMS_persistently `{BiAffine PROP} Φ X :
+ <pers> ([∗ mset] y ∈ X, Φ y) ⊣⊢ [∗ mset] y ∈ X, <pers> (Φ 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_empty_affine Φ : Affine ([∗ mset] x ∈ ∅, Φ x).
+ Proof. rewrite /big_opMS gmultiset_elements_empty. apply _. Qed.
+ Global Instance big_sepMS_affine Φ X :
+ (∀ x, Affine (Φ x)) → Affine ([∗ 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 `{BiAffine PROP} Φ l :
+ ▷ ([∗ list] k↦x ∈ l, Φ k x) ⊣⊢ ([∗ list] k↦x ∈ l, ▷ Φ k x).
+ Proof. apply (big_opL_commute _). Qed.
+ Lemma big_sepL_later_2 Φ l :
+ ([∗ list] k↦x ∈ l, ▷ Φ k x) ⊢ ▷ [∗ list] k↦x ∈ l, Φ k x.
+ Proof. by rewrite (big_opL_commute _). Qed.
+
+ Lemma big_sepL_laterN `{BiAffine PROP} Φ n l :
+ ▷^n ([∗ list] k↦x ∈ l, Φ k x) ⊣⊢ ([∗ list] k↦x ∈ l, ▷^n Φ k x).
+ Proof. apply (big_opL_commute _). Qed.
+ Lemma big_sepL_laterN_2 Φ n l :
+ ([∗ list] k↦x ∈ l, ▷^n Φ k x) ⊢ ▷^n [∗ list] k↦x ∈ l, Φ k x.
+ Proof. by rewrite (big_opL_commute _). Qed.
+
+ Global Instance big_sepL_nil_timeless `{!Timeless (emp%I : PROP)} Φ :
+ Timeless ([∗ list] k↦x ∈ [], Φ k x).
+ Proof. simpl; apply _. Qed.
+ Global Instance big_sepL_timeless `{!Timeless (emp%I : PROP)} Φ 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.
+
+ Section plainly.
+ Context `{!BiPlainly PROP}.
+
+ Lemma big_sepL_plainly `{!BiAffine PROP} Φ l :
+ ■([∗ list] k↦x ∈ l, Φ k x) ⊣⊢ [∗ list] k↦x ∈ l, ■(Φ k x).
+ Proof. apply (big_opL_commute _). Qed.
+
+ Global Instance big_sepL_nil_plain `{!BiAffine PROP} Φ :
+ Plain ([∗ list] k↦x ∈ [], Φ k x).
+ Proof. simpl; apply _. Qed.
+
+ Global Instance big_sepL_plain `{!BiAffine PROP} Φ l :
+ (∀ k x, Plain (Φ k x)) → Plain ([∗ list] k↦x ∈ l, Φ k x).
+ Proof. revert Φ. induction l as [|x l IH]=> Φ ? /=; apply _. Qed.
+
+ Lemma big_andL_plainly Φ l :
+ ■([∧ list] k↦x ∈ l, Φ k x) ⊣⊢ [∧ list] k↦x ∈ l, ■(Φ k x).
+ Proof. apply (big_opL_commute _). Qed.
+
+ Global Instance big_andL_nil_plain Φ :
+ Plain ([∧ list] k↦x ∈ [], Φ k x).
+ Proof. simpl; apply _. Qed.
+
+ Global Instance big_andL_plain Φ l :
+ (∀ k x, Plain (Φ k x)) → Plain ([∧ list] k↦x ∈ l, Φ k x).
+ Proof. revert Φ. induction l as [|x l IH]=> Φ ? /=; apply _. Qed.
+ End plainly.
+End list.
+
+Section list2.
+ Context {A B : Type}.
+ Implicit Types Φ Ψ : nat → A → B → PROP.
+
+ Lemma big_sepL2_later_2 Φ l1 l2 :
+ ([∗ list] k↦y1;y2 ∈ l1;l2, ▷ Φ k y1 y2) ⊢ ▷ [∗ list] k↦y1;y2 ∈ l1;l2, Φ k y1 y2.
+ Proof.
+ rewrite !big_sepL2_alt bi.later_and big_sepL_later_2.
+ auto using and_mono, later_intro.
+ Qed.
+
+ Lemma big_sepL2_laterN_2 Φ n l1 l2 :
+ ([∗ list] k↦y1;y2 ∈ l1;l2, ▷^n Φ k y1 y2) ⊢ ▷^n [∗ list] k↦y1;y2 ∈ l1;l2, Φ k y1 y2.
+ Proof.
+ rewrite !big_sepL2_alt bi.laterN_and big_sepL_laterN_2.
+ auto using and_mono, laterN_intro.
+ Qed.
+
+ Global Instance big_sepL2_nil_timeless `{!Timeless (emp%I : PROP)} Φ :
+ Timeless ([∗ list] k↦y1;y2 ∈ []; [], Φ k y1 y2).
+ Proof. simpl; apply _. Qed.
+ Global Instance big_sepL2_timeless `{!Timeless (emp%I : PROP)} Φ l1 l2 :
+ (∀ k x1 x2, Timeless (Φ k x1 x2)) →
+ Timeless ([∗ list] k↦y1;y2 ∈ l1;l2, Φ k y1 y2).
+ Proof. rewrite big_sepL2_alt. apply _. Qed.
+
+ Section plainly.
+ Context `{!BiPlainly PROP}.
+
+ Lemma big_sepL2_plainly `{!BiAffine PROP} Φ l1 l2 :
+ ■([∗ list] k↦y1;y2 ∈ l1;l2, Φ k y1 y2)
+ ⊣⊢ [∗ list] k↦y1;y2 ∈ l1;l2, ■(Φ k y1 y2).
+ Proof. by rewrite !big_sepL2_alt plainly_and plainly_pure big_sepL_plainly. Qed.
+
+ Global Instance big_sepL2_nil_plain `{!BiAffine PROP} Φ :
+ Plain ([∗ list] k↦y1;y2 ∈ []; [], Φ k y1 y2).
+ Proof. simpl; apply _. Qed.
+
+ Global Instance big_sepL2_plain `{!BiAffine PROP} Φ l1 l2 :
+ (∀ k x1 x2, Plain (Φ k x1 x2)) →
+ Plain ([∗ list] k↦y1;y2 ∈ l1;l2, Φ k y1 y2).
+ Proof. rewrite big_sepL2_alt. apply _. Qed.
+ End plainly.
+End list2.
+
+(** ** 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_sepM_later `{BiAffine PROP} Φ m :
+ ▷ ([∗ map] k↦x ∈ m, Φ k x) ⊣⊢ ([∗ map] k↦x ∈ m, ▷ Φ k x).
+ Proof. apply (big_opM_commute _). Qed.
+ Lemma big_sepM_later_2 Φ m :
+ ([∗ map] k↦x ∈ m, ▷ Φ k x) ⊢ ▷ [∗ map] k↦x ∈ m, Φ k x.
+ Proof. by rewrite big_opM_commute. Qed.
+
+ Lemma big_sepM_laterN `{BiAffine PROP} Φ 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_laterN_2 Φ n m :
+ ([∗ map] k↦x ∈ m, ▷^n Φ k x) ⊢ ▷^n [∗ map] k↦x ∈ m, Φ k x.
+ Proof. by rewrite big_opM_commute. Qed.
+
+ Global Instance big_sepM_nil_timeless `{!Timeless (emp%I : PROP)} Φ :
+ Timeless ([∗ map] k↦x ∈ ∅, Φ k x).
+ Proof. rewrite /big_opM map_to_list_empty. apply _. Qed.
+ Global Instance big_sepM_timeless `{!Timeless (emp%I : PROP)} Φ m :
+ (∀ k x, Timeless (Φ k x)) → Timeless ([∗ map] k↦x ∈ m, Φ k x).
+ Proof. intros. apply big_sepL_timeless=> _ [??]; apply _. Qed.
+
+ Section plainly.
+ Context `{!BiPlainly PROP}.
+
+ Lemma big_sepM_plainly `{BiAffine PROP} Φ m :
+ ■([∗ map] k↦x ∈ m, Φ k x) ⊣⊢ [∗ map] k↦x ∈ m, ■(Φ k x).
+ Proof. apply (big_opM_commute _). Qed.
+
+ Global Instance big_sepM_empty_plain `{BiAffine PROP} Φ :
+ Plain ([∗ map] k↦x ∈ ∅, Φ k x).
+ Proof. rewrite /big_opM map_to_list_empty. apply _. Qed.
+ Global Instance big_sepM_plain `{BiAffine PROP} Φ m :
+ (∀ k x, Plain (Φ k x)) → Plain ([∗ map] k↦x ∈ m, Φ k x).
+ Proof. intros. apply (big_sepL_plain _ _)=> _ [??]; apply _. Qed.
+ End plainly.
+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 `{BiAffine PROP} Φ X :
+ ▷ ([∗ set] y ∈ X, Φ y) ⊣⊢ ([∗ set] y ∈ X, ▷ Φ y).
+ Proof. apply (big_opS_commute _). Qed.
+ Lemma big_sepS_later_2 Φ X :
+ ([∗ set] y ∈ X, ▷ Φ y) ⊢ ▷ ([∗ set] y ∈ X, Φ y).
+ Proof. by rewrite big_opS_commute. Qed.
+
+ Lemma big_sepS_laterN `{BiAffine PROP} Φ n X :
+ ▷^n ([∗ set] y ∈ X, Φ y) ⊣⊢ ([∗ set] y ∈ X, ▷^n Φ y).
+ Proof. apply (big_opS_commute _). Qed.
+ Lemma big_sepS_laterN_2 Φ n X :
+ ([∗ set] y ∈ X, ▷^n Φ y) ⊢ ▷^n ([∗ set] y ∈ X, Φ y).
+ Proof. by rewrite big_opS_commute. Qed.
+
+ Global Instance big_sepS_nil_timeless `{!Timeless (emp%I : PROP)} Φ :
+ Timeless ([∗ set] x ∈ ∅, Φ x).
+ Proof. rewrite /big_opS elements_empty. apply _. Qed.
+ Global Instance big_sepS_timeless `{!Timeless (emp%I : PROP)} Φ X :
+ (∀ x, Timeless (Φ x)) → Timeless ([∗ set] x ∈ X, Φ x).
+ Proof. rewrite /big_opS. apply _. Qed.
+
+ Section plainly.
+ Context `{!BiPlainly PROP}.
+
+ Lemma big_sepS_plainly `{BiAffine PROP} Φ X :
+ ■([∗ set] y ∈ X, Φ y) ⊣⊢ [∗ set] y ∈ X, ■(Φ y).
+ Proof. apply (big_opS_commute _). Qed.
+
+ Global Instance big_sepS_empty_plain `{BiAffine PROP} Φ : Plain ([∗ set] x ∈ ∅, Φ x).
+ Proof. rewrite /big_opS elements_empty. apply _. Qed.
+ Global Instance big_sepS_plain `{BiAffine PROP} Φ X :
+ (∀ x, Plain (Φ x)) → Plain ([∗ set] x ∈ X, Φ x).
+ Proof. rewrite /big_opS. apply _. Qed.
+ End plainly.
+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 `{BiAffine PROP} Φ X :
+ ▷ ([∗ mset] y ∈ X, Φ y) ⊣⊢ ([∗ mset] y ∈ X, ▷ Φ y).
+ Proof. apply (big_opMS_commute _). Qed.
+ Lemma big_sepMS_later_2 Φ X :
+ ([∗ mset] y ∈ X, ▷ Φ y) ⊢ ▷ [∗ mset] y ∈ X, Φ y.
+ Proof. by rewrite big_opMS_commute. Qed.
+
+ Lemma big_sepMS_laterN `{BiAffine PROP} Φ n X :
+ ▷^n ([∗ mset] y ∈ X, Φ y) ⊣⊢ ([∗ mset] y ∈ X, ▷^n Φ y).
+ Proof. apply (big_opMS_commute _). Qed.
+ Lemma big_sepMS_laterN_2 Φ n X :
+ ([∗ mset] y ∈ X, ▷^n Φ y) ⊢ ▷^n [∗ mset] y ∈ X, Φ y.
+ Proof. by rewrite big_opMS_commute. Qed.
+
+ Global Instance big_sepMS_nil_timeless `{!Timeless (emp%I : PROP)} Φ :
+ Timeless ([∗ mset] x ∈ ∅, Φ x).
+ Proof. rewrite /big_opMS gmultiset_elements_empty. apply _. Qed.
+ Global Instance big_sepMS_timeless `{!Timeless (emp%I : PROP)} Φ X :
+ (∀ x, Timeless (Φ x)) → Timeless ([∗ mset] x ∈ X, Φ x).
+ Proof. rewrite /big_opMS. apply _. Qed.
+
+ Section plainly.
+ Context `{!BiPlainly PROP}.
+
+ Lemma big_sepMS_plainly `{BiAffine PROP} Φ X :
+ ■([∗ mset] y ∈ X, Φ y) ⊣⊢ [∗ mset] y ∈ X, ■(Φ y).
+ Proof. apply (big_opMS_commute _). Qed.
+
+ Global Instance big_sepMS_empty_plain `{BiAffine PROP} Φ : Plain ([∗ mset] x ∈ ∅, Φ x).
+ Proof. rewrite /big_opMS gmultiset_elements_empty. apply _. Qed.
+ Global Instance big_sepMS_plain `{BiAffine PROP} Φ X :
+ (∀ x, Plain (Φ x)) → Plain ([∗ mset] x ∈ X, Φ x).
+ Proof. rewrite /big_opMS. apply _. Qed.
+ End plainly.
+End gmultiset.
+End sbi_big_op.
diff --git a/theories/bi/derived_connectives.v b/theories/bi/derived_connectives.v
new file mode 100644
index 0000000000000000000000000000000000000000..b6128cb5a1a52c783be801496f9065b13855dcd9
--- /dev/null
+++ b/theories/bi/derived_connectives.v
@@ -0,0 +1,123 @@
+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 : bi_scope.
+
+Class Persistent {PROP : bi} (P : PROP) := persistent : P ⊢ <pers> P.
+Arguments Persistent {_} _%I : simpl never.
+Arguments persistent {_} _%I {_}.
+Hint Mode Persistent + ! : typeclass_instances.
+Instance: Params (@Persistent) 1.
+
+Definition bi_affinely {PROP : bi} (P : PROP) : PROP := (emp ∧ P)%I.
+Arguments bi_affinely {_} _%I : simpl never.
+Instance: Params (@bi_affinely) 1.
+Typeclasses Opaque bi_affinely.
+Notation "'<affine>' P" := (bi_affinely P) : 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 BiAffine (PROP : bi) := absorbing_bi (Q : PROP) : Affine Q.
+Hint Mode BiAffine ! : typeclass_instances.
+Existing Instance absorbing_bi | 0.
+
+Class BiPositive (PROP : bi) :=
+ bi_positive (P Q : PROP) : <affine> (P ∗ Q) ⊢ <affine> P ∗ Q.
+Hint Mode BiPositive ! : typeclass_instances.
+
+Definition bi_absorbingly {PROP : bi} (P : PROP) : PROP := (True ∗ P)%I.
+Arguments bi_absorbingly {_} _%I : simpl never.
+Instance: Params (@bi_absorbingly) 1.
+Typeclasses Opaque bi_absorbingly.
+Notation "'<absorb>' P" := (bi_absorbingly P) : bi_scope.
+
+Class Absorbing {PROP : bi} (P : PROP) := absorbing : <absorb> P ⊢ P.
+Arguments Absorbing {_} _%I : simpl never.
+Arguments absorbing {_} _%I.
+Hint Mode Absorbing + ! : typeclass_instances.
+
+Definition bi_persistently_if {PROP : bi} (p : bool) (P : PROP) : PROP :=
+ (if p then <pers> P else P)%I.
+Arguments bi_persistently_if {_} !_ _%I /.
+Instance: Params (@bi_persistently_if) 2.
+Typeclasses Opaque bi_persistently_if.
+Notation "'<pers>?' p P" := (bi_persistently_if p P) : bi_scope.
+
+Definition bi_affinely_if {PROP : bi} (p : bool) (P : PROP) : PROP :=
+ (if p then <affine> P else P)%I.
+Arguments bi_affinely_if {_} !_ _%I /.
+Instance: Params (@bi_affinely_if) 2.
+Typeclasses Opaque bi_affinely_if.
+Notation "'<affine>?' p P" := (bi_affinely_if p P) : bi_scope.
+
+Definition bi_intuitionistically {PROP : bi} (P : PROP) : PROP :=
+ (<affine> <pers> P)%I.
+Arguments bi_intuitionistically {_} _%I : simpl never.
+Instance: Params (@bi_intuitionistically) 1.
+Typeclasses Opaque bi_intuitionistically.
+Notation "â–¡ P" := (bi_intuitionistically P) : bi_scope.
+
+Definition bi_intuitionistically_if {PROP : bi} (p : bool) (P : PROP) : PROP :=
+ (if p then â–¡ P else P)%I.
+Arguments bi_intuitionistically_if {_} !_ _%I /.
+Instance: Params (@bi_intuitionistically_if) 2.
+Typeclasses Opaque bi_intuitionistically_if.
+Notation "'â–¡?' p P" := (bi_intuitionistically_if 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.
+
+Fixpoint sbi_laterN {PROP : sbi} (n : nat) (P : PROP) : PROP :=
+ match n with
+ | O => P
+ | S n' => â–· sbi_laterN n' P
+ end%I.
+Arguments sbi_laterN {_} !_%nat_scope _%I.
+Instance: Params (@sbi_laterN) 2.
+Notation "â–·^ n P" := (sbi_laterN n P) : bi_scope.
+Notation "â–·? p P" := (sbi_laterN (Nat.b2n p) P) : bi_scope.
+
+Definition sbi_except_0 {PROP : sbi} (P : PROP) : PROP := (▷ False ∨ P)%I.
+Arguments sbi_except_0 {_} _%I : simpl never.
+Notation "â—‡ P" := (sbi_except_0 P) : bi_scope.
+Instance: Params (@sbi_except_0) 1.
+Typeclasses Opaque sbi_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.
+
+(** An optional precondition [mP] to [Q].
+ TODO: We may actually consider generalizing this to a list of preconditions,
+ and e.g. also using it for texan triples. *)
+Definition bi_wandM {PROP : bi} (mP : option PROP) (Q : PROP) : PROP :=
+ match mP with
+ | None => Q
+ | Some P => (P -∗ Q)%I
+ end.
+Arguments bi_wandM {_} !_%I _%I /.
+Notation "mP -∗? Q" := (bi_wandM mP Q)
+ (at level 99, Q at level 200, right associativity) : bi_scope.
diff --git a/theories/bi/derived_laws_bi.v b/theories/bi/derived_laws_bi.v
new file mode 100644
index 0000000000000000000000000000000000000000..b78d0fe7e99f1ee9e76a822b2a7e5452a7ab893d
--- /dev/null
+++ b/theories/bi/derived_laws_bi.v
@@ -0,0 +1,1496 @@
+From iris.bi Require Export derived_connectives.
+From iris.algebra Require Import monoid.
+From stdpp Require Import hlist.
+
+(** Naming schema for lemmas about modalities:
+ M1_into_M2: M1 P ⊢ M2 P
+ M1_M2_elim: M1 (M2 P) ⊣⊢ M1 P
+ M1_elim_M2: M1 (M2 P) ⊣⊢ M2 P
+ M1_M2: M1 (M2 P) ⊣⊢ M2 (M1 P)
+*)
+
+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" := (P ⊢@{PROP} Q).
+Notation "P ⊣⊢ Q" := (P ⊣⊢@{PROP} Q).
+
+(* 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_emp_valid_proper : Proper ((⊣⊢) ==> iff) (@bi_emp_valid PROP).
+Proof. solve_proper. Qed.
+Global Instance bi_emp_valid_mono : Proper ((⊢) ==> impl) (@bi_emp_valid PROP).
+Proof. solve_proper. Qed.
+Global Instance bi_emp_valid_flip_mono :
+ Proper (flip (⊢) ==> flip impl) (@bi_emp_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 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 entails_eq_True P Q : (P ⊢ Q) ↔ ((P → Q)%I ≡ True%I).
+Proof.
+ split=>EQ.
+ - apply bi.equiv_spec; split; [by apply True_intro|].
+ apply impl_intro_r. rewrite and_elim_r //.
+ - trans (P ∧ True)%I.
+ + apply and_intro; first done. by apply pure_intro.
+ + rewrite -EQ impl_elim_r. done.
+Qed.
+Lemma entails_impl_True P Q : (P ⊢ Q) ↔ (True ⊢ (P → Q)).
+Proof. rewrite entails_eq_True equiv_spec; naive_solver. 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 → 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 exist_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 forall_unit (Ψ : unit → PROP) :
+ (∀ x, Ψ x) ⊣⊢ Ψ ().
+Proof.
+ apply (anti_symm (⊢)).
+ - rewrite (forall_elim ()) //.
+ - apply forall_intro=>[[]]. done.
+Qed.
+Lemma exist_unit (Ψ : unit → PROP) :
+ (∃ x, Ψ x) ⊣⊢ Ψ ().
+Proof.
+ apply (anti_symm (⊢)).
+ - apply exist_elim=>[[]]. done.
+ - rewrite -(exist_intro ()). done.
+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.
+
+
+(* 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_emp_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_emp_valid_r P Q R : (R ⊢ P) → Q → R ⊢ P ∗ Q.
+Proof. intros -> ?. rewrite comm. by apply sep_intro_emp_valid_l. Qed.
+Lemma sep_elim_emp_valid_l P Q R : P → (P ∗ R ⊢ Q) → R ⊢ Q.
+Proof. intros <- <-. by rewrite left_id. Qed.
+Lemma sep_elim_emp_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.
+
+Global Instance emp_wand : LeftId (⊣⊢) emp%I (@bi_wand PROP).
+Proof.
+ intros P. 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]emp_sep. 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_emp_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_emp_valid HPQ /bi_iff; auto.
+Qed.
+
+Lemma and_parallel P1 P2 Q1 Q2 :
+ (P1 ∧ P2) -∗ ((P1 -∗ Q1) ∧ (P2 -∗ Q2)) -∗ Q1 ∧ Q2.
+Proof.
+ apply wand_intro_r, and_intro.
+ - rewrite !and_elim_l wand_elim_r. done.
+ - rewrite !and_elim_r wand_elim_r. done.
+Qed.
+
+Lemma wandM_sound (mP : option PROP) Q :
+ (mP -∗? Q) ⊣⊢ (default emp mP -∗ Q).
+Proof. destruct mP; simpl; first done. rewrite emp_wand //. 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φ.
+ rewrite -(pure_intro φ emp%I) // emp_wand //.
+ - apply wand_intro_l, wand_elim_l', pure_elim'=> Hφ.
+ apply wand_intro_l. rewrite (forall_elim Hφ) comm. by apply absorbing.
+Qed.
+
+(* Properties of the affinely modality *)
+Global Instance affinely_ne : NonExpansive (@bi_affinely PROP).
+Proof. solve_proper. Qed.
+Global Instance affinely_proper : Proper ((⊣⊢) ==> (⊣⊢)) (@bi_affinely PROP).
+Proof. solve_proper. Qed.
+Global Instance affinely_mono' : Proper ((⊢) ==> (⊢)) (@bi_affinely PROP).
+Proof. solve_proper. Qed.
+Global Instance affinely_flip_mono' :
+ Proper (flip (⊢) ==> flip (⊢)) (@bi_affinely PROP).
+Proof. solve_proper. Qed.
+
+Lemma affinely_elim_emp P : <affine> P ⊢ emp.
+Proof. rewrite /bi_affinely; auto. Qed.
+Lemma affinely_elim P : <affine> P ⊢ P.
+Proof. rewrite /bi_affinely; auto. Qed.
+Lemma affinely_mono P Q : (P ⊢ Q) → <affine> P ⊢ <affine> Q.
+Proof. by intros ->. Qed.
+Lemma affinely_idemp P : <affine> <affine> P ⊣⊢ <affine> P.
+Proof. by rewrite /bi_affinely assoc idemp. Qed.
+
+Lemma affinely_intro' P Q : (<affine> P ⊢ Q) → <affine> P ⊢ <affine> Q.
+Proof. intros <-. by rewrite affinely_idemp. Qed.
+
+Lemma affinely_False : <affine> False ⊣⊢ False.
+Proof. by rewrite /bi_affinely right_absorb. Qed.
+Lemma affinely_emp : <affine> emp ⊣⊢ emp.
+Proof. by rewrite /bi_affinely (idemp bi_and). Qed.
+Lemma affinely_or P Q : <affine> (P ∨ Q) ⊣⊢ <affine> P ∨ <affine> Q.
+Proof. by rewrite /bi_affinely and_or_l. Qed.
+Lemma affinely_and P Q : <affine> (P ∧ Q) ⊣⊢ <affine> P ∧ <affine> Q.
+Proof.
+ rewrite /bi_affinely -(comm _ P) (assoc _ (_ ∧ _)%I) -!(assoc _ P).
+ by rewrite idemp !assoc (comm _ P).
+Qed.
+Lemma affinely_sep_2 P Q : <affine> P ∗ <affine> Q ⊢ <affine> (P ∗ Q).
+Proof.
+ rewrite /bi_affinely. apply and_intro.
+ - by rewrite !and_elim_l right_id.
+ - by rewrite !and_elim_r.
+Qed.
+Lemma affinely_sep `{BiPositive PROP} P Q :
+ <affine> (P ∗ Q) ⊣⊢ <affine> P ∗ <affine> Q.
+Proof.
+ apply (anti_symm _), affinely_sep_2.
+ by rewrite -{1}affinely_idemp bi_positive !(comm _ (<affine> P)%I) bi_positive.
+Qed.
+Lemma affinely_forall {A} (Φ : A → PROP) : <affine> (∀ a, Φ a) ⊢ ∀ a, <affine> (Φ a).
+Proof. apply forall_intro=> a. by rewrite (forall_elim a). Qed.
+Lemma affinely_exist {A} (Φ : A → PROP) : <affine> (∃ a, Φ a) ⊣⊢ ∃ a, <affine> (Φ a).
+Proof. by rewrite /bi_affinely and_exist_l. Qed.
+
+Lemma affinely_True_emp : <affine> True ⊣⊢ <affine> emp.
+Proof. apply (anti_symm _); rewrite /bi_affinely; auto. Qed.
+
+Lemma affinely_and_l P Q : <affine> P ∧ Q ⊣⊢ <affine> (P ∧ Q).
+Proof. by rewrite /bi_affinely assoc. Qed.
+Lemma affinely_and_r P Q : P ∧ <affine> Q ⊣⊢ <affine> (P ∧ Q).
+Proof. by rewrite /bi_affinely !assoc (comm _ P). Qed.
+Lemma affinely_and_lr P Q : <affine> P ∧ Q ⊣⊢ P ∧ <affine> Q.
+Proof. by rewrite affinely_and_l affinely_and_r. Qed.
+
+(* Properties of the absorbingly modality *)
+Global Instance absorbingly_ne : NonExpansive (@bi_absorbingly PROP).
+Proof. solve_proper. Qed.
+Global Instance absorbingly_proper : Proper ((⊣⊢) ==> (⊣⊢)) (@bi_absorbingly PROP).
+Proof. solve_proper. Qed.
+Global Instance absorbingly_mono' : Proper ((⊢) ==> (⊢)) (@bi_absorbingly PROP).
+Proof. solve_proper. Qed.
+Global Instance absorbingly_flip_mono' :
+ Proper (flip (⊢) ==> flip (⊢)) (@bi_absorbingly PROP).
+Proof. solve_proper. Qed.
+
+Lemma absorbingly_intro P : P ⊢ <absorb> P.
+Proof. by rewrite /bi_absorbingly -True_sep_2. Qed.
+Lemma absorbingly_mono P Q : (P ⊢ Q) → <absorb> P ⊢ <absorb> Q.
+Proof. by intros ->. Qed.
+Lemma absorbingly_idemp P : <absorb> <absorb> P ⊣⊢ <absorb> P.
+Proof.
+ apply (anti_symm _), absorbingly_intro.
+ rewrite /bi_absorbingly assoc. apply sep_mono; auto.
+Qed.
+
+Lemma absorbingly_pure φ : <absorb> ⌜ φ ⌠⊣⊢ ⌜ φ âŒ.
+Proof.
+ apply (anti_symm _), absorbingly_intro.
+ apply wand_elim_r', pure_elim'=> ?. apply wand_intro_l; auto.
+Qed.
+Lemma absorbingly_or P Q : <absorb> (P ∨ Q) ⊣⊢ <absorb> P ∨ <absorb> Q.
+Proof. by rewrite /bi_absorbingly sep_or_l. Qed.
+Lemma absorbingly_and_1 P Q : <absorb> (P ∧ Q) ⊢ <absorb> P ∧ <absorb> Q.
+Proof. apply and_intro; apply absorbingly_mono; auto. Qed.
+Lemma absorbingly_forall {A} (Φ : A → PROP) : <absorb> (∀ a, Φ a) ⊢ ∀ a, <absorb> (Φ a).
+Proof. apply forall_intro=> a. by rewrite (forall_elim a). Qed.
+Lemma absorbingly_exist {A} (Φ : A → PROP) : <absorb> (∃ a, Φ a) ⊣⊢ ∃ a, <absorb> (Φ a).
+Proof. by rewrite /bi_absorbingly sep_exist_l. Qed.
+
+Lemma absorbingly_sep P Q : <absorb> (P ∗ Q) ⊣⊢ <absorb> P ∗ <absorb> Q.
+Proof. by rewrite -{1}absorbingly_idemp /bi_absorbingly !assoc -!(comm _ P) !assoc. Qed.
+Lemma absorbingly_True_emp : <absorb> True ⊣⊢ <absorb> emp.
+Proof. by rewrite absorbingly_pure /bi_absorbingly right_id. Qed.
+Lemma absorbingly_wand P Q : <absorb> (P -∗ Q) ⊢ <absorb> P -∗ <absorb> Q.
+Proof. apply wand_intro_l. by rewrite -absorbingly_sep wand_elim_r. Qed.
+
+Lemma absorbingly_sep_l P Q : <absorb> P ∗ Q ⊣⊢ <absorb> (P ∗ Q).
+Proof. by rewrite /bi_absorbingly assoc. Qed.
+Lemma absorbingly_sep_r P Q : P ∗ <absorb> Q ⊣⊢ <absorb> (P ∗ Q).
+Proof. by rewrite /bi_absorbingly !assoc (comm _ P). Qed.
+Lemma absorbingly_sep_lr P Q : <absorb> P ∗ Q ⊣⊢ P ∗ <absorb> Q.
+Proof. by rewrite absorbingly_sep_l absorbingly_sep_r. Qed.
+
+Lemma affinely_absorbingly_elim `{!BiPositive PROP} P : <affine> <absorb> P ⊣⊢ <affine> P.
+Proof.
+ apply (anti_symm _), affinely_mono, absorbingly_intro.
+ by rewrite /bi_absorbingly affinely_sep affinely_True_emp affinely_emp left_id.
+Qed.
+
+(* Affine and absorbing propositions *)
+Global Instance Affine_proper : Proper ((⊣⊢) ==> iff) (@Affine PROP).
+Proof. solve_proper. Qed.
+Global Instance Absorbing_proper : Proper ((⊣⊢) ==> iff) (@Absorbing PROP).
+Proof. solve_proper. Qed.
+
+Lemma affine_affinely P `{!Affine P} : <affine> P ⊣⊢ P.
+Proof. rewrite /bi_affinely. apply (anti_symm _); auto. Qed.
+Lemma absorbing_absorbingly P `{!Absorbing P} : <absorb> P ⊣⊢ P.
+Proof. by apply (anti_symm _), absorbingly_intro. Qed.
+
+Lemma True_affine_all_affine P : Affine (PROP:=PROP) True → Affine P.
+Proof. rewrite /Affine=> <-; auto. Qed.
+Lemma emp_absorbing_all_absorbing P : Absorbing (PROP:=PROP) emp → Absorbing P.
+Proof.
+ intros. rewrite /Absorbing -{2}(emp_sep P).
+ rewrite -(absorbing emp) absorbingly_sep_l left_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 (True_intro Q) comm.
+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 (Absorbing P) (Affine Q) →
+ P ∗ Q ⊢ P ∧ Q.
+Proof.
+ intros [?|?] [?|?];
+ apply and_intro; apply: sep_elim_l || apply: sep_elim_r.
+Qed.
+
+Lemma affinely_intro P Q `{!Affine P} : (P ⊢ Q) → P ⊢ <affine> Q.
+Proof. intros <-. by rewrite affine_affinely. 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. Qed.
+Lemma sep_True P `{!Absorbing P} : P ∗ True ⊣⊢ P.
+Proof. by rewrite comm True_sep. Qed.
+
+Lemma True_emp_iff_BiAffine :
+ BiAffine PROP ↔ (True ⊢ emp).
+Proof.
+ split.
+ - intros ?. exact: affine.
+ - rewrite /BiAffine /Affine=>Hemp ?. rewrite -Hemp.
+ exact: True_intro.
+Qed.
+
+Section bi_affine.
+ Context `{BiAffine PROP}.
+
+ Global Instance bi_affine_absorbing P : Absorbing P | 0.
+ Proof. by rewrite /Absorbing /bi_absorbingly (affine True%I) left_id. Qed.
+ Global Instance bi_affine_positive : BiPositive PROP.
+ Proof. intros P Q. by rewrite !affine_affinely. 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 bi_affine.
+
+(* Properties of the persistence 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.
+
+Lemma absorbingly_elim_persistently P : <absorb> <pers> P ⊣⊢ <pers> P.
+Proof.
+ apply (anti_symm _), absorbingly_intro.
+ by rewrite /bi_absorbingly comm persistently_absorbing.
+Qed.
+
+Lemma persistently_forall {A} (Ψ : A → PROP) :
+ <pers> (∀ a, Ψ a) ⊣⊢ ∀ a, <pers> (Ψ 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) :
+ <pers> (∃ a, Ψ a) ⊣⊢ ∃ a, <pers> (Ψ 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 : <pers> (P ∧ Q) ⊣⊢ <pers> P ∧ <pers> Q.
+Proof. rewrite !and_alt persistently_forall. by apply forall_proper=> -[]. Qed.
+Lemma persistently_or P Q : <pers> (P ∨ Q) ⊣⊢ <pers> P ∨ <pers> Q.
+Proof. rewrite !or_alt persistently_exist. by apply exist_proper=> -[]. Qed.
+Lemma persistently_impl P Q : <pers> (P → Q) ⊢ <pers> P → <pers> Q.
+Proof.
+ apply impl_intro_l; rewrite -persistently_and.
+ apply persistently_mono, impl_elim with P; auto.
+Qed.
+
+Lemma persistently_emp_intro P : P ⊢ <pers> emp.
+Proof.
+ by rewrite -(left_id emp%I bi_sep P) {1}persistently_emp_2 persistently_absorbing.
+Qed.
+
+Lemma persistently_True_emp : <pers> True ⊣⊢ <pers> emp.
+Proof. apply (anti_symm _); auto using persistently_emp_intro. Qed.
+
+Lemma persistently_and_emp P : <pers> P ⊣⊢ <pers> (emp ∧ P).
+Proof.
+ apply (anti_symm (⊢)); last by rewrite and_elim_r.
+ rewrite persistently_and. apply and_intro; last done.
+ apply persistently_emp_intro.
+Qed.
+
+Lemma persistently_and_sep_elim_emp P Q : <pers> P ∧ Q ⊢ (emp ∧ P) ∗ Q.
+Proof.
+ rewrite persistently_and_emp.
+ apply persistently_and_sep_elim.
+Qed.
+
+Lemma persistently_and_sep_assoc P Q R : <pers> P ∧ (Q ∗ R) ⊣⊢ (<pers> P ∧ Q) ∗ R.
+Proof.
+ apply (anti_symm (⊢)).
+ - rewrite {1}persistently_idemp_2 persistently_and_sep_elim_emp assoc.
+ apply sep_mono_l, and_intro.
+ + by rewrite and_elim_r persistently_absorbing.
+ + by rewrite and_elim_l left_id.
+ - apply and_intro.
+ + by rewrite and_elim_l persistently_absorbing.
+ + by rewrite and_elim_r.
+Qed.
+Lemma persistently_and_emp_elim P : emp ∧ <pers> P ⊢ P.
+Proof. by rewrite comm persistently_and_sep_elim_emp right_id and_elim_r. Qed.
+Lemma persistently_into_absorbingly P : <pers> P ⊢ <absorb> P.
+Proof.
+ rewrite -(right_id True%I _ (<pers> _)%I) -{1}(emp_sep True%I).
+ rewrite persistently_and_sep_assoc (comm bi_and) persistently_and_emp_elim comm //.
+Qed.
+Lemma persistently_elim P `{!Absorbing P} : <pers> P ⊢ P.
+Proof. by rewrite persistently_into_absorbingly absorbing_absorbingly. Qed.
+
+Lemma persistently_idemp_1 P : <pers> <pers> P ⊢ <pers> P.
+Proof. by rewrite persistently_into_absorbingly absorbingly_elim_persistently. Qed.
+Lemma persistently_idemp P : <pers> <pers> P ⊣⊢ <pers> P.
+Proof. apply (anti_symm _); auto using persistently_idemp_1, persistently_idemp_2. Qed.
+
+Lemma persistently_intro' P Q : (<pers> P ⊢ Q) → <pers> P ⊢ <pers> Q.
+Proof. intros <-. apply persistently_idemp_2. Qed.
+
+Lemma persistently_pure φ : <pers> ⌜φ⌠⊣⊢ ⌜φâŒ.
+Proof.
+ apply (anti_symm _).
+ { by rewrite persistently_into_absorbingly absorbingly_pure. }
+ apply pure_elim'=> Hφ.
+ trans (∀ x : False, <pers> True : PROP)%I; [by apply forall_intro|].
+ rewrite persistently_forall_2. auto using persistently_mono, pure_intro.
+Qed.
+
+Lemma persistently_sep_dup P : <pers> P ⊣⊢ <pers> P ∗ <pers> P.
+Proof.
+ apply (anti_symm _).
+ - rewrite -{1}(idemp bi_and (<pers> _)%I).
+ by rewrite -{2}(emp_sep (<pers> _)%I)
+ persistently_and_sep_assoc and_elim_l.
+ - by rewrite persistently_absorbing.
+Qed.
+
+Lemma persistently_and_sep_l_1 P Q : <pers> P ∧ Q ⊢ <pers> P ∗ Q.
+Proof.
+ by rewrite -{1}(emp_sep Q%I) persistently_and_sep_assoc and_elim_l.
+Qed.
+Lemma persistently_and_sep_r_1 P Q : P ∧ <pers> Q ⊢ P ∗ <pers> Q.
+Proof. by rewrite !(comm _ P) persistently_and_sep_l_1. Qed.
+
+Lemma persistently_and_sep P Q : <pers> (P ∧ Q) ⊢ <pers> (P ∗ Q).
+Proof.
+ rewrite persistently_and.
+ rewrite -{1}persistently_idemp -persistently_and -{1}(emp_sep Q%I).
+ by rewrite persistently_and_sep_assoc (comm bi_and) persistently_and_emp_elim.
+Qed.
+
+Lemma persistently_affinely_elim P : <pers> <affine> P ⊣⊢ <pers> P.
+Proof.
+ by rewrite /bi_affinely persistently_and -persistently_True_emp
+ persistently_pure left_id.
+Qed.
+
+Lemma and_sep_persistently P Q : <pers> P ∧ <pers> Q ⊣⊢ <pers> P ∗ <pers> Q.
+Proof.
+ apply (anti_symm _); auto using persistently_and_sep_l_1.
+ apply and_intro.
+ - by rewrite persistently_absorbing.
+ - by rewrite comm persistently_absorbing.
+Qed.
+Lemma persistently_sep_2 P Q : <pers> P ∗ <pers> Q ⊢ <pers> (P ∗ Q).
+Proof. by rewrite -persistently_and_sep persistently_and -and_sep_persistently. Qed.
+Lemma persistently_sep `{BiPositive PROP} P Q : <pers> (P ∗ Q) ⊣⊢ <pers> P ∗ <pers> Q.
+Proof.
+ apply (anti_symm _); auto using persistently_sep_2.
+ rewrite -persistently_affinely_elim affinely_sep -and_sep_persistently. apply and_intro.
+ - by rewrite (affinely_elim_emp Q) right_id affinely_elim.
+ - by rewrite (affinely_elim_emp P) left_id affinely_elim.
+Qed.
+
+Lemma persistently_alt_fixpoint P :
+ <pers> P ⊣⊢ P ∗ <pers> P.
+Proof.
+ apply (anti_symm _).
+ - rewrite -persistently_and_sep_elim. apply and_intro; done.
+ - rewrite comm persistently_absorbing. done.
+Qed.
+
+Lemma persistently_alt_fixpoint' P :
+ <pers> P ⊣⊢ <affine> P ∗ <pers> P.
+Proof.
+ rewrite -{1}persistently_affinely_elim {1}persistently_alt_fixpoint
+ persistently_affinely_elim //.
+Qed.
+
+Lemma persistently_wand P Q : <pers> (P -∗ Q) ⊢ <pers> P -∗ <pers> Q.
+Proof. apply wand_intro_r. by rewrite persistently_sep_2 wand_elim_l. Qed.
+
+Lemma persistently_entails_l P Q : (P ⊢ <pers> Q) → P ⊢ <pers> Q ∗ P.
+Proof. intros; rewrite -persistently_and_sep_l_1; auto. Qed.
+Lemma persistently_entails_r P Q : (P ⊢ <pers> Q) → P ⊢ P ∗ <pers> Q.
+Proof. intros; rewrite -persistently_and_sep_r_1; auto. Qed.
+
+Lemma persistently_impl_wand_2 P Q : <pers> (P -∗ Q) ⊢ <pers> (P → Q).
+Proof.
+ apply persistently_intro', impl_intro_r.
+ rewrite -{2}(emp_sep P%I) persistently_and_sep_assoc.
+ by rewrite (comm bi_and) persistently_and_emp_elim wand_elim_l.
+Qed.
+
+Lemma impl_wand_persistently_2 P Q : (<pers> P -∗ Q) ⊢ (<pers> P → Q).
+Proof. apply impl_intro_l. by rewrite persistently_and_sep_l_1 wand_elim_r. Qed.
+
+Section persistently_affine_bi.
+ Context `{BiAffine PROP}.
+
+ Lemma persistently_emp : <pers> emp ⊣⊢ emp.
+ Proof. by rewrite -!True_emp persistently_pure. Qed.
+
+ Lemma persistently_and_sep_l P Q : <pers> P ∧ Q ⊣⊢ <pers> 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 ∧ <pers> Q ⊣⊢ P ∗ <pers> Q.
+ Proof. by rewrite !(comm _ P) persistently_and_sep_l. Qed.
+
+ Lemma persistently_impl_wand P Q : <pers> (P → Q) ⊣⊢ <pers> (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 impl_elim_r.
+ Qed.
+
+ Lemma impl_wand_persistently P Q : (<pers> P → Q) ⊣⊢ (<pers> P -∗ Q).
+ Proof.
+ apply (anti_symm (⊢)). by rewrite -impl_wand_1. apply impl_wand_persistently_2.
+ Qed.
+
+ Lemma wand_alt P Q : (P -∗ Q) ⊣⊢ ∃ R, R ∗ <pers> (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 impl_elim_r.
+ Qed.
+ Lemma impl_alt P Q : (P → Q) ⊣⊢ ∃ R, R ∧ <pers> (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.
+ by rewrite assoc persistently_and_sep_r persistently_elim wand_elim_r.
+ Qed.
+End persistently_affine_bi.
+
+(* The intuitionistic modality *)
+Global Instance intuitionistically_ne : NonExpansive (@bi_intuitionistically PROP).
+Proof. solve_proper. Qed.
+Global Instance intuitionistically_proper : Proper ((⊣⊢) ==> (⊣⊢)) (@bi_intuitionistically PROP).
+Proof. solve_proper. Qed.
+Global Instance intuitionistically_mono' : Proper ((⊢) ==> (⊢)) (@bi_intuitionistically PROP).
+Proof. solve_proper. Qed.
+Global Instance intuitionistically_flip_mono' :
+ Proper (flip (⊢) ==> flip (⊢)) (@bi_intuitionistically PROP).
+Proof. solve_proper. Qed.
+
+Lemma intuitionistically_elim P : □ P ⊢ P.
+Proof. apply persistently_and_emp_elim. Qed.
+Lemma intuitionistically_elim_emp P : □ P ⊢ emp.
+Proof. rewrite /bi_intuitionistically affinely_elim_emp //. Qed.
+Lemma intuitionistically_intro' P Q : (□ P ⊢ Q) → □ P ⊢ □ Q.
+Proof.
+ intros <-.
+ by rewrite /bi_intuitionistically persistently_affinely_elim persistently_idemp.
+Qed.
+
+Lemma intuitionistically_emp : □ emp ⊣⊢ emp.
+Proof.
+ by rewrite /bi_intuitionistically -persistently_True_emp persistently_pure
+ affinely_True_emp affinely_emp.
+Qed.
+Lemma intuitionistically_False : □ False ⊣⊢ False.
+Proof. by rewrite /bi_intuitionistically persistently_pure affinely_False. Qed.
+Lemma intuitionistically_True_emp : □ True ⊣⊢ emp.
+Proof.
+ rewrite -intuitionistically_emp /bi_intuitionistically
+ persistently_True_emp //.
+Qed.
+Lemma intuitionistically_and P Q : □ (P ∧ Q) ⊣⊢ □ P ∧ □ Q.
+Proof. by rewrite /bi_intuitionistically persistently_and affinely_and. Qed.
+Lemma intuitionistically_forall {A} (Φ : A → PROP) : □ (∀ x, Φ x) ⊢ ∀ x, □ Φ x.
+Proof. by rewrite /bi_intuitionistically persistently_forall affinely_forall. Qed.
+Lemma intuitionistically_or P Q : □ (P ∨ Q) ⊣⊢ □ P ∨ □ Q.
+Proof. by rewrite /bi_intuitionistically persistently_or affinely_or. Qed.
+Lemma intuitionistically_exist {A} (Φ : A → PROP) : □ (∃ x, Φ x) ⊣⊢ ∃ x, □ Φ x.
+Proof. by rewrite /bi_intuitionistically persistently_exist affinely_exist. Qed.
+Lemma intuitionistically_sep_2 P Q : □ P ∗ □ Q ⊢ □ (P ∗ Q).
+Proof. by rewrite /bi_intuitionistically affinely_sep_2 persistently_sep_2. Qed.
+Lemma intuitionistically_sep `{BiPositive PROP} P Q : □ (P ∗ Q) ⊣⊢ □ P ∗ □ Q.
+Proof. by rewrite /bi_intuitionistically -affinely_sep -persistently_sep. Qed.
+
+Lemma intuitionistically_idemp P : □ □ P ⊣⊢ □ P.
+Proof. by rewrite /bi_intuitionistically persistently_affinely_elim persistently_idemp. Qed.
+
+Lemma intuitionistically_into_persistently_1 P : □ P ⊢ <pers> P.
+Proof. rewrite /bi_intuitionistically affinely_elim //. Qed.
+Lemma intuitionistically_persistently_elim P : □ <pers> P ⊣⊢ □ P.
+Proof. rewrite /bi_intuitionistically persistently_idemp //. Qed.
+
+Lemma intuitionistic_intuitionistically P :
+ Affine P → Persistent P → □ P ⊣⊢ P.
+Proof.
+ intros. apply (anti_symm _); first exact: intuitionistically_elim.
+ rewrite -{1}(affine_affinely P) {1}(persistent P) //.
+Qed.
+Lemma intuitionistically_affinely P : □ P ⊢ <affine> P.
+Proof.
+ rewrite /bi_intuitionistically /bi_affinely. apply and_intro.
+ - rewrite and_elim_l //.
+ - apply persistently_and_emp_elim.
+Qed.
+Lemma intuitionistically_affinely_elim P : □ <affine> P ⊣⊢ □ P.
+Proof. rewrite /bi_intuitionistically persistently_affinely_elim //. Qed.
+
+Lemma persistently_and_intuitionistically_sep_l P Q : <pers> P ∧ Q ⊣⊢ □ P ∗ Q.
+Proof.
+ rewrite /bi_intuitionistically. apply (anti_symm _).
+ - by rewrite /bi_affinely -(comm bi_and (<pers> P)%I)
+ -persistently_and_sep_assoc left_id.
+ - apply and_intro.
+ + by rewrite affinely_elim persistently_absorbing.
+ + by rewrite affinely_elim_emp left_id.
+Qed.
+Lemma persistently_and_intuitionistically_sep_r P Q : P ∧ <pers> Q ⊣⊢ P ∗ □ Q.
+Proof. by rewrite !(comm _ P) persistently_and_intuitionistically_sep_l. Qed.
+Lemma and_sep_intuitionistically P Q : □ P ∧ □ Q ⊣⊢ □ P ∗ □ Q.
+Proof.
+ by rewrite -persistently_and_intuitionistically_sep_l -affinely_and affinely_and_r.
+Qed.
+
+Lemma intuitionistically_sep_dup P : □ P ⊣⊢ □ P ∗ □ P.
+Proof.
+ by rewrite -persistently_and_intuitionistically_sep_l affinely_and_r idemp.
+Qed.
+
+Lemma impl_wand_intuitionistically P Q : (<pers> P → Q) ⊣⊢ (□ P -∗ Q).
+Proof.
+ apply (anti_symm (⊢)).
+ - apply wand_intro_l. by rewrite -persistently_and_intuitionistically_sep_l impl_elim_r.
+ - apply impl_intro_l. by rewrite persistently_and_intuitionistically_sep_l wand_elim_r.
+Qed.
+
+Lemma intuitionistically_alt_fixpoint P :
+ □ P ⊣⊢ emp ∧ (P ∗ □ P).
+Proof.
+ apply (anti_symm (⊢)).
+ - apply and_intro; first exact: affinely_elim_emp.
+ rewrite {1}intuitionistically_sep_dup. apply sep_mono; last done.
+ apply intuitionistically_elim.
+ - apply and_mono; first done. rewrite /bi_intuitionistically {2}persistently_alt_fixpoint.
+ apply sep_mono; first done. apply and_elim_r.
+Qed.
+
+
+Section bi_affine_intuitionistically.
+ Context `{BiAffine PROP}.
+
+ Lemma intuitionistically_into_persistently P : □ P ⊣⊢ <pers> P.
+ Proof. rewrite /bi_intuitionistically affine_affinely //. Qed.
+End bi_affine_intuitionistically.
+
+(* Conditional affinely modality *)
+Global Instance affinely_if_ne p : NonExpansive (@bi_affinely_if PROP p).
+Proof. solve_proper. Qed.
+Global Instance affinely_if_proper p : Proper ((⊣⊢) ==> (⊣⊢)) (@bi_affinely_if PROP p).
+Proof. solve_proper. Qed.
+Global Instance affinely_if_mono' p : Proper ((⊢) ==> (⊢)) (@bi_affinely_if PROP p).
+Proof. solve_proper. Qed.
+Global Instance affinely_if_flip_mono' p :
+ Proper (flip (⊢) ==> flip (⊢)) (@bi_affinely_if PROP p).
+Proof. solve_proper. Qed.
+
+Lemma affinely_if_mono p P Q : (P ⊢ Q) → <affine>?p P ⊢ <affine>?p Q.
+Proof. by intros ->. Qed.
+Lemma affinely_if_flag_mono (p q : bool) P : (q → p) → <affine>?p P ⊢ <affine>?q P.
+Proof. destruct p, q; naive_solver auto using affinely_elim. Qed.
+
+Lemma affinely_if_elim p P : <affine>?p P ⊢ P.
+Proof. destruct p; simpl; auto using affinely_elim. Qed.
+Lemma affinely_affinely_if p P : <affine> P ⊢ <affine>?p P.
+Proof. destruct p; simpl; auto using affinely_elim. Qed.
+Lemma affinely_if_intro' p P Q : (<affine>?p P ⊢ Q) → <affine>?p P ⊢ <affine>?p Q.
+Proof. destruct p; simpl; auto using affinely_intro'. Qed.
+
+Lemma affinely_if_emp p : <affine>?p emp ⊣⊢ emp.
+Proof. destruct p; simpl; auto using affinely_emp. Qed.
+Lemma affinely_if_and p P Q : <affine>?p (P ∧ Q) ⊣⊢ <affine>?p P ∧ <affine>?p Q.
+Proof. destruct p; simpl; auto using affinely_and. Qed.
+Lemma affinely_if_or p P Q : <affine>?p (P ∨ Q) ⊣⊢ <affine>?p P ∨ <affine>?p Q.
+Proof. destruct p; simpl; auto using affinely_or. Qed.
+Lemma affinely_if_exist {A} p (Ψ : A → PROP) :
+ <affine>?p (∃ a, Ψ a) ⊣⊢ ∃ a, <affine>?p (Ψ a).
+Proof. destruct p; simpl; auto using affinely_exist. Qed.
+Lemma affinely_if_sep_2 p P Q : <affine>?p P ∗ <affine>?p Q ⊢ <affine>?p (P ∗ Q).
+Proof. destruct p; simpl; auto using affinely_sep_2. Qed.
+Lemma affinely_if_sep `{BiPositive PROP} p P Q :
+ <affine>?p (P ∗ Q) ⊣⊢ <affine>?p P ∗ <affine>?p Q.
+Proof. destruct p; simpl; auto using affinely_sep. Qed.
+
+Lemma affinely_if_idemp p P : <affine>?p <affine>?p P ⊣⊢ <affine>?p P.
+Proof. destruct p; simpl; auto using affinely_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) → <pers>?p P ⊢ <pers>?p Q.
+Proof. by intros ->. Qed.
+
+Lemma persistently_if_pure p φ : <pers>?p ⌜φ⌠⊣⊢ ⌜φâŒ.
+Proof. destruct p; simpl; auto using persistently_pure. Qed.
+Lemma persistently_if_and p P Q : <pers>?p (P ∧ Q) ⊣⊢ <pers>?p P ∧ <pers>?p Q.
+Proof. destruct p; simpl; auto using persistently_and. Qed.
+Lemma persistently_if_or p P Q : <pers>?p (P ∨ Q) ⊣⊢ <pers>?p P ∨ <pers>?p Q.
+Proof. destruct p; simpl; auto using persistently_or. Qed.
+Lemma persistently_if_exist {A} p (Ψ : A → PROP) :
+ (<pers>?p (∃ a, Ψ a)) ⊣⊢ ∃ a, <pers>?p (Ψ a).
+Proof. destruct p; simpl; auto using persistently_exist. Qed.
+Lemma persistently_if_sep_2 p P Q : <pers>?p P ∗ <pers>?p Q ⊢ <pers>?p (P ∗ Q).
+Proof. destruct p; simpl; auto using persistently_sep_2. Qed.
+Lemma persistently_if_sep `{BiPositive PROP} p P Q :
+ <pers>?p (P ∗ Q) ⊣⊢ <pers>?p P ∗ <pers>?p Q.
+Proof. destruct p; simpl; auto using persistently_sep. Qed.
+
+Lemma persistently_if_idemp p P : <pers>?p <pers>?p P ⊣⊢ <pers>?p P.
+Proof. destruct p; simpl; auto using persistently_idemp. Qed.
+
+(* Conditional intuitionistically *)
+Global Instance intuitionistically_if_ne p : NonExpansive (@bi_intuitionistically_if PROP p).
+Proof. solve_proper. Qed.
+Global Instance intuitionistically_if_proper p :
+ Proper ((⊣⊢) ==> (⊣⊢)) (@bi_intuitionistically_if PROP p).
+Proof. solve_proper. Qed.
+Global Instance intuitionistically_if_mono' p :
+ Proper ((⊢) ==> (⊢)) (@bi_intuitionistically_if PROP p).
+Proof. solve_proper. Qed.
+Global Instance intuitionistically_if_flip_mono' p :
+ Proper (flip (⊢) ==> flip (⊢)) (@bi_intuitionistically_if PROP p).
+Proof. solve_proper. Qed.
+
+Lemma intuitionistically_if_mono p P Q : (P ⊢ Q) → □?p P ⊢ □?p Q.
+Proof. by intros ->. Qed.
+Lemma intuitionistically_if_flag_mono (p q : bool) P :
+ (q → p) → □?p P ⊢ □?q P.
+Proof. destruct p, q; naive_solver auto using intuitionistically_elim. Qed.
+
+Lemma intuitionistically_if_elim p P : □?p P ⊢ P.
+Proof. destruct p; simpl; auto using intuitionistically_elim. Qed.
+Lemma intuitionistically_intuitionistically_if p P : □ P ⊢ □?p P.
+Proof. destruct p; simpl; auto using intuitionistically_elim. Qed.
+Lemma intuitionistically_if_intro' p P Q : (□?p P ⊢ Q) → □?p P ⊢ □?p Q.
+Proof. destruct p; simpl; auto using intuitionistically_intro'. Qed.
+
+Lemma intuitionistically_if_emp p : □?p emp ⊣⊢ emp.
+Proof. destruct p; simpl; auto using intuitionistically_emp. Qed.
+Lemma intuitionistically_if_False p : □?p False ⊣⊢ False.
+Proof. destruct p; simpl; auto using intuitionistically_False. Qed.
+Lemma intuitionistically_if_and p P Q : □?p (P ∧ Q) ⊣⊢ □?p P ∧ □?p Q.
+Proof. destruct p; simpl; auto using intuitionistically_and. Qed.
+Lemma intuitionistically_if_or p P Q : □?p (P ∨ Q) ⊣⊢ □?p P ∨ □?p Q.
+Proof. destruct p; simpl; auto using intuitionistically_or. Qed.
+Lemma intuitionistically_if_exist {A} p (Ψ : A → PROP) :
+ (□?p ∃ a, Ψ a) ⊣⊢ ∃ a, □?p Ψ a.
+Proof. destruct p; simpl; auto using intuitionistically_exist. Qed.
+Lemma intuitionistically_if_sep_2 p P Q : □?p P ∗ □?p Q ⊢ □?p (P ∗ Q).
+Proof. destruct p; simpl; auto using intuitionistically_sep_2. Qed.
+Lemma intuitionistically_if_sep `{BiPositive PROP} p P Q :
+ □?p (P ∗ Q) ⊣⊢ □?p P ∗ □?p Q.
+Proof. destruct p; simpl; auto using intuitionistically_sep. Qed.
+
+Lemma intuitionistically_if_idemp p P : □?p □?p P ⊣⊢ □?p P.
+Proof. destruct p; simpl; auto using intuitionistically_idemp. Qed.
+
+Lemma intuitionistically_if_unfold p P : □?p P ⊣⊢ <affine>?p <pers>?p P.
+Proof. by destruct p. Qed.
+
+(* Properties of persistent propositions *)
+Global Instance Persistent_proper : Proper ((≡) ==> iff) (@Persistent PROP).
+Proof. solve_proper. Qed.
+
+Lemma persistent_persistently_2 P `{!Persistent P} : P ⊢ <pers> P.
+Proof. done. Qed.
+Lemma persistent_persistently P `{!Persistent P, !Absorbing P} : <pers> P ⊣⊢ P.
+Proof.
+ apply (anti_symm _); auto using persistent_persistently_2, persistently_elim.
+Qed.
+
+Lemma persistently_intro P Q `{!Persistent P} : (P ⊢ Q) → P ⊢ <pers> Q.
+Proof. intros HP. by rewrite (persistent P) HP. Qed.
+Lemma persistent_and_affinely_sep_l_1 P Q `{!Persistent P} : P ∧ Q ⊢ <affine> P ∗ Q.
+Proof.
+ rewrite {1}(persistent_persistently_2 P) persistently_and_intuitionistically_sep_l.
+ rewrite intuitionistically_affinely //.
+Qed.
+Lemma persistent_and_affinely_sep_r_1 P Q `{!Persistent Q} : P ∧ Q ⊢ P ∗ <affine> Q.
+Proof. by rewrite !(comm _ P) persistent_and_affinely_sep_l_1. Qed.
+
+Lemma persistent_and_affinely_sep_l P Q `{!Persistent P, !Absorbing P} :
+ P ∧ Q ⊣⊢ <affine> P ∗ Q.
+Proof. by rewrite -(persistent_persistently P) persistently_and_intuitionistically_sep_l. Qed.
+Lemma persistent_and_affinely_sep_r P Q `{!Persistent Q, !Absorbing Q} :
+ P ∧ Q ⊣⊢ P ∗ <affine> Q.
+Proof. by rewrite -(persistent_persistently Q) persistently_and_intuitionistically_sep_r. Qed.
+
+Lemma persistent_and_sep_1 P Q `{HPQ : !TCOr (Persistent P) (Persistent Q)} :
+ P ∧ Q ⊢ P ∗ Q.
+Proof.
+ destruct HPQ.
+ - by rewrite persistent_and_affinely_sep_l_1 affinely_elim.
+ - by rewrite persistent_and_affinely_sep_r_1 affinely_elim.
+Qed.
+
+Lemma persistent_sep_dup P `{!Persistent P, !Absorbing 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. intros. rewrite -persistent_and_sep_1; auto. Qed.
+Lemma persistent_entails_r P Q `{!Persistent Q} : (P ⊢ Q) → P ⊢ P ∗ Q.
+Proof. intros. rewrite -persistent_and_sep_1; auto. Qed.
+
+Lemma absorbingly_intuitionistically_into_persistently P :
+ <absorb> □ P ⊣⊢ <pers> P.
+Proof.
+ apply (anti_symm _).
+ - by rewrite intuitionistically_into_persistently_1 absorbingly_elim_persistently.
+ - rewrite -{1}(idemp bi_and (<pers> _)%I) persistently_and_intuitionistically_sep_r.
+ by rewrite {1} (True_intro (<pers> _)%I).
+Qed.
+
+Lemma persistent_absorbingly_affinely_2 P `{!Persistent P} :
+ P ⊢ <absorb> <affine> P.
+Proof.
+ rewrite {1}(persistent P) -absorbingly_intuitionistically_into_persistently.
+ by rewrite intuitionistically_affinely.
+Qed.
+Lemma persistent_absorbingly_affinely P `{!Persistent P, !Absorbing P} :
+ <absorb> <affine> P ⊣⊢ P.
+Proof.
+ by rewrite -(persistent_persistently P) absorbingly_intuitionistically_into_persistently.
+Qed.
+
+Lemma persistent_and_sep_assoc P `{!Persistent P, !Absorbing P} Q R :
+ P ∧ (Q ∗ R) ⊣⊢ (P ∧ Q) ∗ R.
+Proof. by rewrite -(persistent_persistently 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_1 wand_elim_r. Qed.
+
+Section persistent_bi_absorbing.
+ Context `{BiAffine PROP}.
+
+ Lemma persistent_and_sep P Q `{HPQ : !TCOr (Persistent P) (Persistent Q)} :
+ P ∧ Q ⊣⊢ P ∗ Q.
+ Proof.
+ destruct HPQ.
+ - by rewrite -(persistent_persistently P) persistently_and_sep_l.
+ - 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.
+
+(* Affine instances *)
+Global Instance emp_affine : Affine (PROP:=PROP) emp.
+Proof. by rewrite /Affine. Qed.
+Global Instance False_affine : Affine (PROP:=PROP) False.
+Proof. by rewrite /Affine False_elim. 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 affinely_affine P : Affine (<affine> P).
+Proof. rewrite /bi_affinely. apply _. Qed.
+Global Instance affinely_if_affine p P : Affine P → Affine (<affine>?p P).
+Proof. destruct p; simpl; apply _. Qed.
+Global Instance intuitionistically_affine P : Affine (â–¡ P).
+Proof. rewrite /bi_intuitionistically. apply _. Qed.
+
+(* Absorbing instances *)
+Global Instance pure_absorbing φ : Absorbing (PROP:=PROP) ⌜φâŒ.
+Proof. by rewrite /Absorbing absorbingly_pure. Qed.
+Global Instance and_absorbing P Q : Absorbing P → Absorbing Q → Absorbing (P ∧ Q).
+Proof. intros. by rewrite /Absorbing absorbingly_and_1 !absorbing. Qed.
+Global Instance or_absorbing P Q : Absorbing P → Absorbing Q → Absorbing (P ∨ Q).
+Proof. intros. by rewrite /Absorbing absorbingly_or !absorbing. Qed.
+Global Instance forall_absorbing {A} (Φ : A → PROP) :
+ (∀ x, Absorbing (Φ x)) → Absorbing (∀ x, Φ x).
+Proof. rewrite /Absorbing=> ?. rewrite absorbingly_forall. auto using forall_mono. Qed.
+Global Instance exist_absorbing {A} (Φ : A → PROP) :
+ (∀ x, Absorbing (Φ x)) → Absorbing (∃ x, Φ x).
+Proof. rewrite /Absorbing=> ?. rewrite absorbingly_exist. auto using exist_mono. Qed.
+
+Global Instance impl_absorbing P Q :
+ Persistent P → Absorbing P → Absorbing Q → Absorbing (P → Q).
+Proof.
+ intros. rewrite /Absorbing. apply impl_intro_l.
+ rewrite persistent_and_affinely_sep_l_1 absorbingly_sep_r.
+ by rewrite -persistent_and_affinely_sep_l impl_elim_r.
+Qed.
+
+Global Instance sep_absorbing_l P Q : Absorbing P → Absorbing (P ∗ Q).
+Proof. intros. by rewrite /Absorbing -absorbingly_sep_l absorbing. Qed.
+Global Instance sep_absorbing_r P Q : Absorbing Q → Absorbing (P ∗ Q).
+Proof. intros. by rewrite /Absorbing -absorbingly_sep_r absorbing. Qed.
+
+Global Instance wand_absorbing_l P Q : Absorbing P → Absorbing (P -∗ Q).
+Proof.
+ intros. rewrite /Absorbing /bi_absorbingly. apply wand_intro_l.
+ by rewrite assoc (sep_elim_l P) wand_elim_r.
+Qed.
+Global Instance wand_absorbing_r P Q : Absorbing Q → Absorbing (P -∗ Q).
+Proof. intros. by rewrite /Absorbing absorbingly_wand !absorbing -absorbingly_intro. Qed.
+
+
+Global Instance absorbingly_absorbing P : Absorbing (<absorb> P).
+Proof. rewrite /bi_absorbingly. apply _. Qed.
+Global Instance persistently_absorbing P : Absorbing (<pers> P).
+Proof. by rewrite /Absorbing absorbingly_elim_persistently. Qed.
+Global Instance persistently_if_absorbing P p :
+ Absorbing P → Absorbing (<pers>?p P).
+Proof. intros; destruct p; simpl; apply _. Qed.
+
+(* Persistence instances *)
+Global Instance pure_persistent φ : Persistent (PROP:=PROP) ⌜φâŒ.
+Proof. by rewrite /Persistent persistently_pure. Qed.
+Global Instance emp_persistent : Persistent (PROP:=PROP) emp.
+Proof. rewrite /Persistent. apply persistently_emp_intro. 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_mono=> 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_mono=> x. by rewrite -!persistent.
+Qed.
+
+Global Instance sep_persistent P Q :
+ Persistent P → Persistent Q → Persistent (P ∗ Q).
+Proof. intros. by rewrite /Persistent -persistently_sep_2 -!persistent. Qed.
+
+Global Instance persistently_persistent P : Persistent (<pers> P).
+Proof. by rewrite /Persistent persistently_idemp. Qed.
+Global Instance affinely_persistent P : Persistent P → Persistent (<affine> P).
+Proof. rewrite /bi_affinely. apply _. Qed.
+Global Instance intuitionistically_persistent P : Persistent (â–¡ P).
+Proof. rewrite /bi_intuitionistically. apply _. Qed.
+Global Instance absorbingly_persistent P : Persistent P → Persistent (<absorb> P).
+Proof. rewrite /bi_absorbingly. apply _. 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.
+
+(* 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 :
+ MonoidHomomorphism bi_and bi_and (≡) (@bi_persistently PROP).
+Proof.
+ split; [split|]; try apply _. apply persistently_and. apply persistently_pure.
+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 `{BiPositive PROP} :
+ WeakMonoidHomomorphism bi_sep bi_sep (≡) (@bi_persistently PROP).
+Proof. split; try apply _. apply persistently_sep. Qed.
+
+Global Instance bi_persistently_sep_homomorphism `{BiAffine 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_2. 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.
+
+(* Limits *)
+Lemma limit_preserving_entails {A : ofeT} `{Cofe A} (Φ Ψ : A → PROP) :
+ NonExpansive Φ → NonExpansive Ψ → LimitPreserving (λ x, Φ x ⊢ Ψ x).
+Proof.
+ intros HΦ HΨ c Hc. apply entails_eq_True, equiv_dist=>n.
+ rewrite conv_compl. apply equiv_dist, entails_eq_True. done.
+Qed.
+Lemma limit_preserving_equiv {A : ofeT} `{Cofe A} (Φ Ψ : A → PROP) :
+ NonExpansive Φ → NonExpansive Ψ → LimitPreserving (λ x, Φ x ⊣⊢ Ψ x).
+Proof.
+ intros HΦ HΨ. eapply limit_preserving_ext.
+ { intros x. symmetry; apply equiv_spec. }
+ apply limit_preserving_and; by apply limit_preserving_entails.
+Qed.
+Global Instance limit_preserving_Persistent {A:ofeT} `{Cofe A} (Φ : A → PROP) :
+ NonExpansive Φ → LimitPreserving (λ x, Persistent (Φ x)).
+Proof. intros. apply limit_preserving_entails; solve_proper. Qed.
+End bi_derived.
+
+End bi.
diff --git a/theories/bi/derived_laws_sbi.v b/theories/bi/derived_laws_sbi.v
new file mode 100644
index 0000000000000000000000000000000000000000..e1e93317e3141335110f5f980bfefd8ee4254eb2
--- /dev/null
+++ b/theories/bi/derived_laws_sbi.v
@@ -0,0 +1,520 @@
+From iris.bi Require Export derived_laws_bi.
+From iris.algebra Require Import monoid.
+
+Module bi.
+Import interface.bi.
+Import derived_laws_bi.bi.
+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" := (P ⊢@{PROP} Q).
+Notation "P ⊣⊢ Q" := (P ⊣⊢@{PROP} Q).
+
+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 internal_eq_proper (A : ofeT) :
+ Proper ((≡) ==> (≡) ==> (⊣⊢)) (@sbi_internal_eq PROP A) := ne_proper_2 _.
+Global Instance later_proper :
+ Proper ((⊣⊢) ==> (⊣⊢)) (@sbi_later PROP) := ne_proper _.
+
+(* Equality *)
+Hint Resolve internal_eq_refl.
+Hint Extern 100 (NonExpansive _) => solve_proper.
+
+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_fun_equivI {A} {B : A → ofeT} (f g : ofe_fun 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_fun_equivI (ofe_mor_car _ _ f) (ofe_mor_car _ _ g)).
+ set (h1 (f : A -n> B) :=
+ exist (λ f : A -c> B, NonExpansive (f : A → B)) f (ofe_mor_ne A B f)).
+ set (h2 (f : sigC (λ f : A -c> B, NonExpansive (f : A → B))) :=
+ @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.
+
+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.
+
+Lemma absorbingly_internal_eq {A : ofeT} (x y : A) : <absorb> (x ≡ y) ⊣⊢ x ≡ y.
+Proof.
+ apply (anti_symm _), absorbingly_intro.
+ apply wand_elim_r', (internal_eq_rewrite' x y (λ y, True -∗ x ≡ y)%I); auto.
+ apply wand_intro_l, internal_eq_refl.
+Qed.
+Lemma persistently_internal_eq {A : ofeT} (a b : A) : <pers> (a ≡ b) ⊣⊢ a ≡ b.
+Proof.
+ apply (anti_symm (⊢)).
+ { by rewrite persistently_into_absorbingly absorbingly_internal_eq. }
+ apply (internal_eq_rewrite' a b (λ b, <pers> (a ≡ b))%I); auto.
+ rewrite -(internal_eq_refl emp%I a). apply persistently_emp_intro.
+Qed.
+
+Global Instance internal_eq_absorbing {A : ofeT} (x y : A) :
+ Absorbing (PROP:=PROP) (x ≡ y).
+Proof. by rewrite /Absorbing absorbingly_internal_eq. Qed.
+Global Instance internal_eq_persistent {A : ofeT} (a b : A) :
+ Persistent (PROP:=PROP) (a ≡ b).
+Proof. by intros; rewrite /Persistent persistently_internal_eq. Qed.
+
+(* Equality under a later. *)
+Lemma internal_eq_rewrite_contractive {A : ofeT} a b (Ψ : A → PROP)
+ {HΨ : Contractive Ψ} : ▷ (a ≡ b) ⊢ Ψ a → Ψ b.
+Proof.
+ rewrite later_eq_2. move: HΨ=>/contractive_alt [g [? HΨ]]. rewrite !HΨ.
+ by apply internal_eq_rewrite.
+Qed.
+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 *)
+Hint Resolve later_mono.
+Global Instance later_mono' : Proper ((⊢) ==> (⊢)) (@sbi_later PROP).
+Proof. intros P Q; apply later_mono. Qed.
+Global Instance later_flip_mono' :
+ Proper (flip (⊢) ==> flip (⊢)) (@sbi_later PROP).
+Proof. intros P Q; apply later_mono. Qed.
+
+Lemma later_True : ▷ True ⊣⊢ True.
+Proof. apply (anti_symm (⊢)); auto using later_intro. Qed.
+Lemma later_emp `{!BiAffine 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 : ▷ <pers> P ⊣⊢ <pers> ▷ P.
+Proof. apply (anti_symm _); auto using later_persistently_1, later_persistently_2. Qed.
+Lemma later_affinely_2 P : <affine> ▷ P ⊢ ▷ <affine> P.
+Proof. rewrite /bi_affinely later_and. auto using later_intro. Qed.
+Lemma later_intuitionistically_2 P : □ ▷ P ⊢ ▷ □ P.
+Proof. by rewrite /bi_intuitionistically -later_persistently later_affinely_2. Qed.
+Lemma later_intuitionistically_if_2 p P : □?p ▷ P ⊢ ▷ □?p P.
+Proof. destruct p; simpl; auto using later_intuitionistically_2. Qed.
+Lemma later_absorbingly P : ▷ <absorb> P ⊣⊢ <absorb> ▷ P.
+Proof. by rewrite /bi_absorbingly later_sep later_True. Qed.
+
+Global Instance later_persistent P : Persistent P → Persistent (▷ P).
+Proof. intros. by rewrite /Persistent -later_persistently {1}(persistent P). Qed.
+Global Instance later_absorbing P : Absorbing P → Absorbing (▷ P).
+Proof. intros ?. by rewrite /Absorbing -later_absorbingly absorbing. Qed.
+
+Section löb.
+ (* Proof following https://en.wikipedia.org/wiki/L%C3%B6b's_theorem#Proof_of_L%C3%B6b's_theorem.
+ Their Ψ is called Q in our proof. *)
+ Lemma weak_löb P : (▷ P ⊢ P) → (True ⊢ P).
+ Proof.
+ pose (flöb_pre (P Q : PROP) := (▷ Q → P)%I).
+ assert (∀ P, Contractive (flöb_pre P)) by solve_contractive.
+ set (Q := fixpoint (flöb_pre P)).
+ assert (Q ⊣⊢ (▷ Q → P)) as HQ by (exact: fixpoint_unfold).
+ intros HP. rewrite -HP.
+ assert (▷ Q ⊢ P) as HQP.
+ { rewrite -HP. rewrite -(idemp (∧) (▷ Q))%I {2}(later_intro (▷ Q))%I.
+ by rewrite {1}HQ {1}later_impl impl_elim_l. }
+ rewrite -HQP HQ -2!later_intro.
+ apply (entails_impl_True _ P). done.
+ Qed.
+
+ Lemma löb P : (▷ P → P) ⊢ P.
+ Proof.
+ apply entails_impl_True, weak_löb. apply impl_intro_r.
+ rewrite -{2}(idemp (∧) (▷ P → P))%I.
+ rewrite {2}(later_intro (▷ P → P))%I.
+ rewrite later_impl.
+ rewrite assoc impl_elim_l.
+ rewrite impl_elim_r. done.
+ Qed.
+End löb.
+
+(* Iterated later modality *)
+Global Instance laterN_ne m : NonExpansive (@sbi_laterN PROP m).
+Proof. induction m; simpl. by intros ???. solve_proper. Qed.
+Global Instance laterN_proper m :
+ Proper ((⊣⊢) ==> (⊣⊢)) (@sbi_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; f_equiv/=; auto. Qed.
+Lemma laterN_plus n1 n2 P : ▷^(n1 + n2) P ⊣⊢ ▷^n1 ▷^n2 P.
+Proof. induction n1; f_equiv/=; 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_iter n P : (â–·^n P)%I = Nat.iter n sbi_later P.
+Proof. induction n; f_equal/=; auto. 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 ((⊢) ==> (⊢)) (@sbi_laterN PROP n).
+Proof. intros P Q; apply laterN_mono. Qed.
+Global Instance laterN_flip_mono' n :
+ Proper (flip (⊢) ==> flip (⊢)) (@sbi_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 `{!BiAffine 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 ?IH; 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 ?IH; 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 ?IH; 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 ?IH; 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 ?IH; 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 <pers> P ⊣⊢ <pers> ▷^n P.
+Proof. induction n as [|n IH]; simpl; auto. by rewrite IH later_persistently. Qed.
+Lemma laterN_affinely_2 n P : <affine> ▷^n P ⊢ ▷^n <affine> P.
+Proof. rewrite /bi_affinely laterN_and. auto using laterN_intro. Qed.
+Lemma laterN_intuitionistically_2 n P : □ ▷^n P ⊢ ▷^n □ P.
+Proof. by rewrite /bi_intuitionistically -laterN_persistently laterN_affinely_2. Qed.
+Lemma laterN_intuitionistically_if_2 n p P : □?p ▷^n P ⊢ ▷^n □?p P.
+Proof. destruct p; simpl; auto using laterN_intuitionistically_2. Qed.
+Lemma laterN_absorbingly n P : ▷^n <absorb> P ⊣⊢ <absorb> ▷^n P.
+Proof. by rewrite /bi_absorbingly laterN_sep laterN_True. 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 (@sbi_except_0 PROP).
+Proof. solve_proper. Qed.
+Global Instance except_0_proper : Proper ((⊣⊢) ==> (⊣⊢)) (@sbi_except_0 PROP).
+Proof. solve_proper. Qed.
+Global Instance except_0_mono' : Proper ((⊢) ==> (⊢)) (@sbi_except_0 PROP).
+Proof. solve_proper. Qed.
+Global Instance except_0_flip_mono' :
+ Proper (flip (⊢) ==> flip (⊢)) (@sbi_except_0 PROP).
+Proof. solve_proper. Qed.
+
+Lemma except_0_intro P : P ⊢ ◇ P.
+Proof. rewrite /sbi_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 /sbi_except_0; auto. Qed.
+
+Lemma except_0_True : ◇ True ⊣⊢ True.
+Proof. rewrite /sbi_except_0. apply (anti_symm _); auto. Qed.
+Lemma except_0_emp `{!BiAffine PROP} : ◇ emp ⊣⊢ emp.
+Proof. by rewrite -True_emp except_0_True. Qed.
+Lemma except_0_or P Q : ◇ (P ∨ Q) ⊣⊢ ◇ P ∨ ◇ Q.
+Proof. rewrite /sbi_except_0. apply (anti_symm _); auto. Qed.
+Lemma except_0_and P Q : ◇ (P ∧ Q) ⊣⊢ ◇ P ∧ ◇ Q.
+Proof. by rewrite /sbi_except_0 or_and_l. Qed.
+Lemma except_0_sep P Q : ◇ (P ∗ Q) ⊣⊢ ◇ P ∗ ◇ Q.
+Proof.
+ rewrite /sbi_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 {A} (Φ : A → PROP) : ◇ (∀ a, Φ a) ⊣⊢ ∀ a, ◇ Φ a.
+Proof.
+ apply (anti_symm _).
+ { apply forall_intro=> a. by rewrite (forall_elim a). }
+ trans (▷ (∀ a : A, Φ a) ∧ (∀ a : A, ◇ Φ a))%I.
+ { apply and_intro, reflexivity. rewrite later_forall. apply forall_mono=> a.
+ apply or_elim; auto using later_intro. }
+ rewrite later_false_em and_or_r. apply or_elim.
+ { rewrite and_elim_l. apply or_intro_l. }
+ apply or_intro_r', forall_intro=> a. rewrite !(forall_elim a).
+ by rewrite and_or_l impl_elim_l and_elim_r idemp.
+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 /sbi_except_0 -later_or False_or. Qed.
+Lemma except_0_persistently P : ◇ <pers> P ⊣⊢ <pers> ◇ P.
+Proof.
+ by rewrite /sbi_except_0 persistently_or -later_persistently persistently_pure.
+Qed.
+Lemma except_0_affinely_2 P : <affine> ◇ P ⊢ ◇ <affine> P.
+Proof. rewrite /bi_affinely except_0_and. auto using except_0_intro. Qed.
+Lemma except_0_intuitionistically_2 P : □ ◇ P ⊢ ◇ □ P.
+Proof. by rewrite /bi_intuitionistically -except_0_persistently except_0_affinely_2. Qed.
+Lemma except_0_intuitionistically_if_2 p P : □?p ◇ P ⊢ ◇ □?p P.
+Proof. destruct p; simpl; auto using except_0_intuitionistically_2. Qed.
+Lemma except_0_absorbingly P : ◇ <absorb> P ⊣⊢ <absorb> ◇ P.
+Proof. by rewrite /bi_absorbingly except_0_sep except_0_True. 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.
+
+Lemma later_affinely_1 `{!Timeless (PROP:=PROP) emp} P : ▷ <affine> P ⊢ ◇ <affine> ▷ P.
+Proof.
+ rewrite /bi_affinely later_and (timeless emp%I) except_0_and.
+ by apply and_mono, except_0_intro.
+Qed.
+
+Global Instance except_0_persistent P : Persistent P → Persistent (◇ P).
+Proof. rewrite /sbi_except_0; apply _. Qed.
+Global Instance except_0_absorbing P : Absorbing P → Absorbing (◇ P).
+Proof. rewrite /sbi_except_0; apply _. Qed.
+
+(* Timeless instances *)
+Global Instance Timeless_proper : Proper ((≡) ==> iff) (@Timeless PROP).
+Proof. solve_proper. Qed.
+
+Global Instance pure_timeless φ : Timeless (PROP:=PROP) ⌜φâŒ.
+Proof.
+ rewrite /Timeless /sbi_except_0 pure_alt later_exist_false.
+ apply or_elim, exist_elim; [auto|]=> Hφ. rewrite -(exist_intro Hφ). auto.
+Qed.
+Global Instance emp_timeless `{BiAffine PROP} : Timeless (PROP:=PROP) emp.
+Proof. rewrite -True_emp. apply _. 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 /sbi_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 /sbi_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 except_0_forall later_forall.
+ apply forall_mono; auto.
+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 /sbi_except_0; auto.
+ - apply exist_elim=> x. rewrite -(exist_intro x); auto.
+Qed.
+Global Instance persistently_timeless P : Timeless P → Timeless (<pers> P).
+Proof.
+ intros. rewrite /Timeless /sbi_except_0 later_persistently_1.
+ by rewrite (timeless P) /sbi_except_0 persistently_or {1}persistently_elim.
+Qed.
+
+Global Instance affinely_timeless P :
+ Timeless (PROP:=PROP) emp → Timeless P → Timeless (<affine> P).
+Proof. rewrite /bi_affinely; apply _. Qed.
+Global Instance absorbingly_timeless P : Timeless P → Timeless (<absorb> P).
+Proof. rewrite /bi_absorbingly; apply _. Qed.
+
+Global Instance eq_timeless {A : ofeT} (a b : A) :
+ Discrete a → Timeless (PROP:=PROP) (a ≡ b).
+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 sbi_later_monoid_and_homomorphism :
+ MonoidHomomorphism bi_and bi_and (≡) (@sbi_later PROP).
+Proof. split; [split|]; try apply _. apply later_and. apply later_True. Qed.
+Global Instance sbi_laterN_and_homomorphism n :
+ MonoidHomomorphism bi_and bi_and (≡) (@sbi_laterN PROP n).
+Proof. split; [split|]; try apply _. apply laterN_and. apply laterN_True. Qed.
+Global Instance sbi_except_0_and_homomorphism :
+ MonoidHomomorphism bi_and bi_and (≡) (@sbi_except_0 PROP).
+Proof. split; [split|]; try apply _. apply except_0_and. apply except_0_True. Qed.
+
+Global Instance sbi_later_monoid_or_homomorphism :
+ WeakMonoidHomomorphism bi_or bi_or (≡) (@sbi_later PROP).
+Proof. split; try apply _. apply later_or. Qed.
+Global Instance sbi_laterN_or_homomorphism n :
+ WeakMonoidHomomorphism bi_or bi_or (≡) (@sbi_laterN PROP n).
+Proof. split; try apply _. apply laterN_or. Qed.
+Global Instance sbi_except_0_or_homomorphism :
+ WeakMonoidHomomorphism bi_or bi_or (≡) (@sbi_except_0 PROP).
+Proof. split; try apply _. apply except_0_or. Qed.
+
+Global Instance sbi_later_monoid_sep_weak_homomorphism :
+ WeakMonoidHomomorphism bi_sep bi_sep (≡) (@sbi_later PROP).
+Proof. split; try apply _. apply later_sep. Qed.
+Global Instance sbi_laterN_sep_weak_homomorphism n :
+ WeakMonoidHomomorphism bi_sep bi_sep (≡) (@sbi_laterN PROP n).
+Proof. split; try apply _. apply laterN_sep. Qed.
+Global Instance sbi_except_0_sep_weak_homomorphism :
+ WeakMonoidHomomorphism bi_sep bi_sep (≡) (@sbi_except_0 PROP).
+Proof. split; try apply _. apply except_0_sep. Qed.
+
+Global Instance sbi_later_monoid_sep_homomorphism `{!BiAffine PROP} :
+ MonoidHomomorphism bi_sep bi_sep (≡) (@sbi_later PROP).
+Proof. split; try apply _. apply later_emp. Qed.
+Global Instance sbi_laterN_sep_homomorphism `{!BiAffine PROP} n :
+ MonoidHomomorphism bi_sep bi_sep (≡) (@sbi_laterN PROP n).
+Proof. split; try apply _. apply laterN_emp. Qed.
+Global Instance sbi_except_0_sep_homomorphism `{!BiAffine PROP} :
+ MonoidHomomorphism bi_sep bi_sep (≡) (@sbi_except_0 PROP).
+Proof. split; try apply _. apply except_0_emp. Qed.
+
+Global Instance sbi_later_monoid_sep_entails_weak_homomorphism :
+ WeakMonoidHomomorphism bi_sep bi_sep (flip (⊢)) (@sbi_later PROP).
+Proof. split; try apply _. intros P Q. by rewrite later_sep. Qed.
+Global Instance sbi_laterN_sep_entails_weak_homomorphism n :
+ WeakMonoidHomomorphism bi_sep bi_sep (flip (⊢)) (@sbi_laterN PROP n).
+Proof. split; try apply _. intros P Q. by rewrite laterN_sep. Qed.
+Global Instance sbi_except_0_sep_entails_weak_homomorphism :
+ WeakMonoidHomomorphism bi_sep bi_sep (flip (⊢)) (@sbi_except_0 PROP).
+Proof. split; try apply _. intros P Q. by rewrite except_0_sep. Qed.
+
+Global Instance sbi_later_monoid_sep_entails_homomorphism :
+ MonoidHomomorphism bi_sep bi_sep (flip (⊢)) (@sbi_later PROP).
+Proof. split; try apply _. apply later_intro. Qed.
+Global Instance sbi_laterN_sep_entails_homomorphism n :
+ MonoidHomomorphism bi_sep bi_sep (flip (⊢)) (@sbi_laterN PROP n).
+Proof. split; try apply _. apply laterN_intro. Qed.
+Global Instance sbi_except_0_sep_entails_homomorphism :
+ MonoidHomomorphism bi_sep bi_sep (flip (⊢)) (@sbi_except_0 PROP).
+Proof. split; try apply _. apply except_0_intro. Qed.
+End sbi_derived.
+End bi.
diff --git a/theories/bi/embedding.v b/theories/bi/embedding.v
new file mode 100644
index 0000000000000000000000000000000000000000..4201349f1703af21d348286ce1acc84704fd1a5a
--- /dev/null
+++ b/theories/bi/embedding.v
@@ -0,0 +1,326 @@
+From iris.algebra Require Import monoid.
+From iris.bi Require Import interface derived_laws_sbi big_op plainly updates.
+From stdpp Require Import hlist.
+
+Class Embed (A B : Type) := embed : A → B.
+Arguments embed {_ _ _} _%I : simpl never.
+Notation "⎡ P ⎤" := (embed P) : bi_scope.
+Instance: Params (@embed) 3.
+Typeclasses Opaque embed.
+
+Hint Mode Embed ! - : typeclass_instances.
+Hint Mode Embed - ! : typeclass_instances.
+
+(* Mixins allow us to create instances easily without having to use Program *)
+Record BiEmbedMixin (PROP1 PROP2 : bi) `(Embed PROP1 PROP2) := {
+ bi_embed_mixin_ne : NonExpansive embed;
+ bi_embed_mixin_mono : Proper ((⊢) ==> (⊢)) embed;
+ bi_embed_mixin_emp_valid_inj (P : PROP1) :
+ bi_emp_valid (PROP:=PROP2) ⎡P⎤ → bi_emp_valid P;
+ bi_embed_mixin_emp_2 : emp ⊢ ⎡emp⎤;
+ bi_embed_mixin_impl_2 P Q : (⎡P⎤ → ⎡Q⎤) ⊢ ⎡P → Q⎤;
+ bi_embed_mixin_forall_2 A (Φ : A → PROP1) : (∀ x, ⎡Φ x⎤) ⊢ ⎡∀ x, Φ x⎤;
+ bi_embed_mixin_exist_1 A (Φ : A → PROP1) : ⎡∃ x, Φ x⎤ ⊢ ∃ x, ⎡Φ x⎤;
+ bi_embed_mixin_sep P Q : ⎡P ∗ Q⎤ ⊣⊢ ⎡P⎤ ∗ ⎡Q⎤;
+ bi_embed_mixin_wand_2 P Q : (⎡P⎤ -∗ ⎡Q⎤) ⊢ ⎡P -∗ Q⎤;
+ bi_embed_mixin_persistently P : ⎡<pers> P⎤ ⊣⊢ <pers> ⎡P⎤
+}.
+
+Class BiEmbed (PROP1 PROP2 : bi) := {
+ bi_embed_embed :> Embed PROP1 PROP2;
+ bi_embed_mixin : BiEmbedMixin PROP1 PROP2 bi_embed_embed;
+}.
+Hint Mode BiEmbed ! - : typeclass_instances.
+Hint Mode BiEmbed - ! : typeclass_instances.
+Arguments bi_embed_embed : simpl never.
+
+Class BiEmbedEmp (PROP1 PROP2 : bi) `{BiEmbed PROP1 PROP2} := {
+ embed_emp_1 : ⎡ emp : PROP1 ⎤ ⊢ emp;
+}.
+Hint Mode BiEmbedEmp ! - - : typeclass_instances.
+Hint Mode BiEmbedEmp - ! - : typeclass_instances.
+
+Class SbiEmbed (PROP1 PROP2 : sbi) `{BiEmbed PROP1 PROP2} := {
+ embed_internal_eq_1 (A : ofeT) (x y : A) : ⎡x ≡ y⎤ ⊢ x ≡ y;
+ embed_later P : ⎡▷ P⎤ ⊣⊢ ▷ ⎡P⎤;
+ embed_interal_inj (PROP' : sbi) (P Q : PROP1) : ⎡P⎤ ≡ ⎡Q⎤ ⊢@{PROP'} (P ≡ Q);
+}.
+Hint Mode SbiEmbed ! - - : typeclass_instances.
+Hint Mode SbiEmbed - ! - : typeclass_instances.
+
+Class BiEmbedBUpd (PROP1 PROP2 : bi)
+ `{BiEmbed PROP1 PROP2, BiBUpd PROP1, BiBUpd PROP2} := {
+ embed_bupd P : ⎡|==> P⎤ ⊣⊢@{PROP2} |==> ⎡P⎤
+}.
+Hint Mode BiEmbedBUpd - ! - - - : typeclass_instances.
+Hint Mode BiEmbedBUpd ! - - - - : typeclass_instances.
+
+Class BiEmbedFUpd (PROP1 PROP2 : sbi)
+ `{BiEmbed PROP1 PROP2, BiFUpd PROP1, BiFUpd PROP2} := {
+ embed_fupd E1 E2 P : ⎡|={E1,E2}=> P⎤ ⊣⊢@{PROP2} |={E1,E2}=> ⎡P⎤
+}.
+Hint Mode BiEmbedFUpd - ! - - - : typeclass_instances.
+Hint Mode BiEmbedFUpd ! - - - - : typeclass_instances.
+
+Class BiEmbedPlainly (PROP1 PROP2 : sbi)
+ `{BiEmbed PROP1 PROP2, BiPlainly PROP1, BiPlainly PROP2} := {
+ embed_plainly_2 (P : PROP1) : ■⎡P⎤ ⊢ (⎡■P⎤ : PROP2)
+}.
+Hint Mode BiEmbedPlainly - ! - - - : typeclass_instances.
+Hint Mode BiEmbedPlainly ! - - - - : typeclass_instances.
+
+Section embed_laws.
+ Context `{BiEmbed PROP1 PROP2}.
+ Local Notation embed := (embed (A:=PROP1) (B:=PROP2)).
+ Local Notation "⎡ P ⎤" := (embed P) : bi_scope.
+ Implicit Types P : PROP1.
+
+ Global Instance embed_ne : NonExpansive embed.
+ Proof. eapply bi_embed_mixin_ne, bi_embed_mixin. Qed.
+ Global Instance embed_mono : Proper ((⊢) ==> (⊢)) embed.
+ Proof. eapply bi_embed_mixin_mono, bi_embed_mixin. Qed.
+ Lemma embed_emp_valid_inj P : (⎡P⎤ : PROP2)%I → P.
+ Proof. eapply bi_embed_mixin_emp_valid_inj, bi_embed_mixin. Qed.
+ Lemma embed_emp_2 : emp ⊢ ⎡emp⎤.
+ Proof. eapply bi_embed_mixin_emp_2, bi_embed_mixin. Qed.
+ Lemma embed_impl_2 P Q : (⎡P⎤ → ⎡Q⎤) ⊢ ⎡P → Q⎤.
+ Proof. eapply bi_embed_mixin_impl_2, bi_embed_mixin. Qed.
+ Lemma embed_forall_2 A (Φ : A → PROP1) : (∀ x, ⎡Φ x⎤) ⊢ ⎡∀ x, Φ x⎤.
+ Proof. eapply bi_embed_mixin_forall_2, bi_embed_mixin. Qed.
+ Lemma embed_exist_1 A (Φ : A → PROP1) : ⎡∃ x, Φ x⎤ ⊢ ∃ x, ⎡Φ x⎤.
+ Proof. eapply bi_embed_mixin_exist_1, bi_embed_mixin. Qed.
+ Lemma embed_sep P Q : ⎡P ∗ Q⎤ ⊣⊢ ⎡P⎤ ∗ ⎡Q⎤.
+ Proof. eapply bi_embed_mixin_sep, bi_embed_mixin. Qed.
+ Lemma embed_wand_2 P Q : (⎡P⎤ -∗ ⎡Q⎤) ⊢ ⎡P -∗ Q⎤.
+ Proof. eapply bi_embed_mixin_wand_2, bi_embed_mixin. Qed.
+ Lemma embed_persistently P : ⎡<pers> P⎤ ⊣⊢ <pers> ⎡P⎤.
+ Proof. eapply bi_embed_mixin_persistently, bi_embed_mixin. Qed.
+End embed_laws.
+
+Section embed.
+ Context `{BiEmbed PROP1 PROP2}.
+ Local Notation embed := (embed (A:=PROP1) (B:=PROP2)).
+ Local Notation "⎡ P ⎤" := (embed P) : bi_scope.
+ Implicit Types P Q R : PROP1.
+
+ Global Instance embed_proper : Proper ((≡) ==> (≡)) embed.
+ Proof. apply (ne_proper _). Qed.
+ Global Instance embed_flip_mono : Proper (flip (⊢) ==> flip (⊢)) embed.
+ Proof. solve_proper. Qed.
+ Global Instance embed_entails_inj : Inj (⊢) (⊢) embed.
+ Proof.
+ move=> P Q /bi.entails_wand. rewrite embed_wand_2.
+ by move=> /embed_emp_valid_inj /bi.wand_entails.
+ Qed.
+
+ Global Instance embed_inj : Inj (≡) (≡) embed.
+ Proof.
+ intros P Q EQ. apply bi.equiv_spec, conj; apply (inj embed); rewrite EQ //.
+ Qed.
+
+ Lemma embed_emp_valid (P : PROP1) : ⎡P⎤%I ↔ P.
+ Proof.
+ rewrite /bi_emp_valid. split=> HP.
+ - by apply embed_emp_valid_inj.
+ - by rewrite embed_emp_2 HP.
+ Qed.
+
+ Lemma embed_emp `{!BiEmbedEmp PROP1 PROP2} : ⎡ emp ⎤ ⊣⊢ emp.
+ Proof. apply (anti_symm _); eauto using embed_emp_1, embed_emp_2. Qed.
+
+ Lemma embed_forall A (Φ : A → PROP1) : ⎡∀ x, Φ x⎤ ⊣⊢ ∀ x, ⎡Φ x⎤.
+ Proof.
+ apply bi.equiv_spec; split; [|apply embed_forall_2].
+ apply bi.forall_intro=>?. by rewrite bi.forall_elim.
+ Qed.
+ Lemma embed_exist A (Φ : A → PROP1) : ⎡∃ x, Φ x⎤ ⊣⊢ ∃ x, ⎡Φ x⎤.
+ Proof.
+ apply bi.equiv_spec; split; [apply embed_exist_1|].
+ apply bi.exist_elim=>?. by rewrite -bi.exist_intro.
+ Qed.
+ Lemma embed_and P Q : ⎡P ∧ Q⎤ ⊣⊢ ⎡P⎤ ∧ ⎡Q⎤.
+ Proof. rewrite !bi.and_alt embed_forall. by f_equiv=>-[]. Qed.
+ Lemma embed_or P Q : ⎡P ∨ Q⎤ ⊣⊢ ⎡P⎤ ∨ ⎡Q⎤.
+ Proof. rewrite !bi.or_alt embed_exist. by f_equiv=>-[]. Qed.
+ Lemma embed_impl P Q : ⎡P → Q⎤ ⊣⊢ (⎡P⎤ → ⎡Q⎤).
+ Proof.
+ apply bi.equiv_spec; split; [|apply embed_impl_2].
+ apply bi.impl_intro_l. by rewrite -embed_and bi.impl_elim_r.
+ Qed.
+ Lemma embed_wand P Q : ⎡P -∗ Q⎤ ⊣⊢ (⎡P⎤ -∗ ⎡Q⎤).
+ Proof.
+ apply bi.equiv_spec; split; [|apply embed_wand_2].
+ apply bi.wand_intro_l. by rewrite -embed_sep bi.wand_elim_r.
+ Qed.
+ Lemma embed_pure φ : ⎡⌜φâŒâŽ¤ ⊣⊢ ⌜φâŒ.
+ Proof.
+ rewrite (@bi.pure_alt PROP1) (@bi.pure_alt PROP2) embed_exist.
+ do 2 f_equiv. apply bi.equiv_spec. split; [apply bi.True_intro|].
+ rewrite -(_ : (emp → emp : PROP1) ⊢ True) ?embed_impl;
+ last apply bi.True_intro.
+ apply bi.impl_intro_l. by rewrite right_id.
+ Qed.
+
+ Lemma embed_iff P Q : ⎡P ↔ Q⎤ ⊣⊢ (⎡P⎤ ↔ ⎡Q⎤).
+ Proof. by rewrite embed_and !embed_impl. Qed.
+ Lemma embed_wand_iff P Q : ⎡P ∗-∗ Q⎤ ⊣⊢ (⎡P⎤ ∗-∗ ⎡Q⎤).
+ Proof. by rewrite embed_and !embed_wand. Qed.
+ Lemma embed_affinely_2 P : <affine> ⎡P⎤ ⊢ ⎡<affine> P⎤.
+ Proof. by rewrite embed_and -embed_emp_2. Qed.
+ Lemma embed_affinely `{!BiEmbedEmp PROP1 PROP2} P : ⎡<affine> P⎤ ⊣⊢ <affine> ⎡P⎤.
+ Proof. by rewrite /bi_intuitionistically embed_and embed_emp. Qed.
+ Lemma embed_absorbingly P : ⎡<absorb> P⎤ ⊣⊢ <absorb> ⎡P⎤.
+ Proof. by rewrite embed_sep embed_pure. Qed.
+ Lemma embed_intuitionistically_2 P : □ ⎡P⎤ ⊢ ⎡□ P⎤.
+ Proof. by rewrite /bi_intuitionistically -embed_affinely_2 embed_persistently. Qed.
+ Lemma embed_intuitionistically `{!BiEmbedEmp PROP1 PROP2} P : ⎡□ P⎤ ⊣⊢ □ ⎡P⎤.
+ Proof. by rewrite /bi_intuitionistically embed_affinely embed_persistently. Qed.
+
+ Lemma embed_persistently_if P b : ⎡<pers>?b P⎤ ⊣⊢ <pers>?b ⎡P⎤.
+ Proof. destruct b; simpl; auto using embed_persistently. Qed.
+ Lemma embed_affinely_if_2 P b : <affine>?b ⎡P⎤ ⊢ ⎡<affine>?b P⎤.
+ Proof. destruct b; simpl; auto using embed_affinely_2. Qed.
+ Lemma embed_affinely_if `{!BiEmbedEmp PROP1 PROP2} P b :
+ ⎡<affine>?b P⎤ ⊣⊢ <affine>?b ⎡P⎤.
+ Proof. destruct b; simpl; auto using embed_affinely. Qed.
+ Lemma embed_intuitionistically_if_2 P b : □?b ⎡P⎤ ⊢ ⎡□?b P⎤.
+ Proof. destruct b; simpl; auto using embed_intuitionistically_2. Qed.
+ Lemma embed_intuitionistically_if `{!BiEmbedEmp PROP1 PROP2} P b :
+ ⎡□?b P⎤ ⊣⊢ □?b ⎡P⎤.
+ Proof. destruct b; simpl; auto using embed_intuitionistically. Qed.
+
+ Lemma embed_hforall {As} (Φ : himpl As PROP1):
+ ⎡bi_hforall Φ⎤ ⊣⊢ bi_hforall (hcompose embed Φ).
+ Proof. induction As=>//. rewrite /= embed_forall. by do 2 f_equiv. Qed.
+ Lemma embed_hexist {As} (Φ : himpl As PROP1):
+ ⎡bi_hexist Φ⎤ ⊣⊢ bi_hexist (hcompose embed Φ).
+ Proof. induction As=>//. rewrite /= embed_exist. by do 2 f_equiv. Qed.
+
+ Global Instance embed_persistent P : Persistent P → Persistent ⎡P⎤.
+ Proof. intros ?. by rewrite /Persistent -embed_persistently -persistent. Qed.
+ Global Instance embed_affine `{!BiEmbedEmp PROP1 PROP2} P : Affine P → Affine ⎡P⎤.
+ Proof. intros ?. by rewrite /Affine (affine P) embed_emp. Qed.
+ Global Instance embed_absorbing P : Absorbing P → Absorbing ⎡P⎤.
+ Proof. intros ?. by rewrite /Absorbing -embed_absorbingly absorbing. Qed.
+
+ Global Instance embed_and_homomorphism :
+ MonoidHomomorphism bi_and bi_and (≡) embed.
+ Proof.
+ by split; [split|]; try apply _;
+ [setoid_rewrite embed_and|rewrite embed_pure].
+ Qed.
+ Global Instance embed_or_homomorphism :
+ MonoidHomomorphism bi_or bi_or (≡) embed.
+ Proof.
+ by split; [split|]; try apply _;
+ [setoid_rewrite embed_or|rewrite embed_pure].
+ Qed.
+
+ Global Instance embed_sep_entails_homomorphism :
+ MonoidHomomorphism bi_sep bi_sep (flip (⊢)) embed.
+ Proof.
+ split; [split|]; simpl; try apply _;
+ [by setoid_rewrite embed_sep|by rewrite embed_emp_2].
+ Qed.
+
+ Lemma embed_big_sepL_2 {A} (Φ : nat → A → PROP1) l :
+ ([∗ list] k↦x ∈ l, ⎡Φ k x⎤) ⊢ ⎡[∗ list] k↦x ∈ l, Φ k x⎤.
+ Proof. apply (big_opL_commute (R:=flip (⊢)) _). Qed.
+ Lemma embed_big_sepM_2 `{Countable K} {A} (Φ : K → A → PROP1) (m : gmap K A) :
+ ([∗ map] k↦x ∈ m, ⎡Φ k x⎤) ⊢ ⎡[∗ map] k↦x ∈ m, Φ k x⎤.
+ Proof. apply (big_opM_commute (R:=flip (⊢)) _). Qed.
+ Lemma embed_big_sepS_2 `{Countable A} (Φ : A → PROP1) (X : gset A) :
+ ([∗ set] y ∈ X, ⎡Φ y⎤) ⊢ ⎡[∗ set] y ∈ X, Φ y⎤.
+ Proof. apply (big_opS_commute (R:=flip (⊢)) _). Qed.
+ Lemma embed_big_sepMS_2 `{Countable A} (Φ : A → PROP1) (X : gmultiset A) :
+ ([∗ mset] y ∈ X, ⎡Φ y⎤) ⊢ ⎡[∗ mset] y ∈ X, Φ y⎤.
+ Proof. apply (big_opMS_commute (R:=flip (⊢)) _). Qed.
+
+ Section big_ops_emp.
+ Context `{!BiEmbedEmp PROP1 PROP2}.
+
+ Global Instance embed_sep_homomorphism :
+ MonoidHomomorphism bi_sep bi_sep (≡) embed.
+ Proof.
+ by split; [split|]; try apply _;
+ [setoid_rewrite embed_sep|rewrite embed_emp].
+ Qed.
+
+ Lemma embed_big_sepL {A} (Φ : nat → A → PROP1) l :
+ ⎡[∗ list] k↦x ∈ l, Φ k x⎤ ⊣⊢ [∗ list] k↦x ∈ l, ⎡Φ k x⎤.
+ Proof. apply (big_opL_commute _). Qed.
+ Lemma embed_big_sepM `{Countable K} {A} (Φ : K → A → PROP1) (m : gmap K A) :
+ ⎡[∗ map] k↦x ∈ m, Φ k x⎤ ⊣⊢ [∗ map] k↦x ∈ m, ⎡Φ k x⎤.
+ Proof. apply (big_opM_commute _). Qed.
+ Lemma embed_big_sepS `{Countable A} (Φ : A → PROP1) (X : gset A) :
+ ⎡[∗ set] y ∈ X, Φ y⎤ ⊣⊢ [∗ set] y ∈ X, ⎡Φ y⎤.
+ Proof. apply (big_opS_commute _). Qed.
+ Lemma embed_big_sepMS `{Countable A} (Φ : A → PROP1) (X : gmultiset A) :
+ ⎡[∗ mset] y ∈ X, Φ y⎤ ⊣⊢ [∗ mset] y ∈ X, ⎡Φ y⎤.
+ Proof. apply (big_opMS_commute _). Qed.
+ End big_ops_emp.
+End embed.
+
+Section sbi_embed.
+ Context `{SbiEmbed PROP1 PROP2}.
+ Implicit Types P Q R : PROP1.
+
+ Lemma embed_internal_eq (A : ofeT) (x y : A) : ⎡x ≡ y⎤ ⊣⊢ x ≡ y.
+ Proof.
+ apply bi.equiv_spec; split; [apply embed_internal_eq_1|].
+ etrans; [apply (bi.internal_eq_rewrite x y (λ y, ⎡x ≡ y⎤%I)); solve_proper|].
+ rewrite -(bi.internal_eq_refl True%I) embed_pure.
+ eapply bi.impl_elim; [done|]. apply bi.True_intro.
+ Qed.
+ Lemma embed_laterN n P : ⎡▷^n P⎤ ⊣⊢ ▷^n ⎡P⎤.
+ Proof. induction n=>//=. rewrite embed_later. by f_equiv. Qed.
+ Lemma embed_except_0 P : ⎡◇ P⎤ ⊣⊢ ◇ ⎡P⎤.
+ Proof. by rewrite embed_or embed_later embed_pure. Qed.
+
+ (* Not an instance, since it may cause overlap *)
+ Lemma bi_embed_plainly_emp `{!BiPlainly PROP1, !BiPlainly PROP2} :
+ BiEmbedEmp PROP1 PROP2 → BiEmbedPlainly PROP1 PROP2.
+ Proof.
+ intros. constructor=> P. rewrite !plainly_alt embed_internal_eq.
+ by rewrite -embed_affinely -embed_emp embed_interal_inj.
+ Qed.
+
+ Lemma embed_plainly_1 `{!BiPlainly PROP1, !BiPlainly PROP2} P : ⎡■P⎤ ⊢ ■⎡P⎤.
+ Proof.
+ assert (∀ P, <affine> ⎡ P ⎤ ⊣⊢ (<affine> ⎡ <affine> P ⎤ : PROP2)) as Hhelp.
+ { intros P'. apply (anti_symm _).
+ - by rewrite -bi.affinely_idemp (embed_affinely_2 P').
+ - by rewrite (bi.affinely_elim P'). }
+ assert (<affine> ⎡ emp ⎤ ⊣⊢ (emp : PROP2)) as Hemp.
+ { apply (anti_symm _).
+ - apply bi.affinely_elim_emp.
+ - apply bi.and_intro; auto using embed_emp_2. }
+ rewrite !plainly_alt embed_internal_eq. by rewrite Hhelp -Hemp -!bi.f_equiv.
+ Qed.
+ Lemma embed_plainly `{!BiPlainly PROP1, !BiPlainly PROP2,
+ !BiEmbedPlainly PROP1 PROP2} P : ⎡■P⎤ ⊣⊢ ■⎡P⎤.
+ Proof.
+ apply (anti_symm _). by apply embed_plainly_1. by apply embed_plainly_2.
+ Qed.
+
+ Lemma embed_plainly_if `{!BiPlainly PROP1, !BiPlainly PROP2,
+ !BiEmbedPlainly PROP1 PROP2} p P : ⎡■?p P⎤ ⊣⊢ ■?p ⎡P⎤.
+ Proof. destruct p; simpl; auto using embed_plainly. Qed.
+ Lemma embed_plainly_if_1 `{!BiPlainly PROP1, !BiPlainly PROP2} p P :
+ ⎡■?p P⎤ ⊢ ■?p ⎡P⎤.
+ Proof. destruct p; simpl; auto using embed_plainly_1. Qed.
+
+ Lemma embed_plain `{!BiPlainly PROP1, !BiPlainly PROP2} P : Plain P → Plain ⎡P⎤.
+ Proof. intros ?. by rewrite /Plain {1}(plain P) embed_plainly_1. Qed.
+
+ Global Instance embed_timeless P : Timeless P → Timeless ⎡P⎤.
+ Proof.
+ intros ?. by rewrite /Timeless -embed_except_0 -embed_later timeless.
+ Qed.
+End sbi_embed.
+
+(* Not defined using an ordinary [Instance] because the default
+[class_apply @bi_embed_plainly] shelves the [BiPlainly] premise, making proof
+search for the other premises fail. See the proof of [monPred_objectively_plain]
+for an example where it would fail with a regular [Instance].*)
+Hint Extern 4 (Plain ⎡_⎤) => eapply @embed_plain : typeclass_instances.
diff --git a/theories/bi/interface.v b/theories/bi/interface.v
new file mode 100644
index 0000000000000000000000000000000000000000..fb475c79d14e0cff196709c17b32e39bb2af41c0
--- /dev/null
+++ b/theories/bi/interface.v
@@ -0,0 +1,468 @@
+From iris.algebra Require Export ofe.
+From iris.bi Require Export notation.
+Set Primitive Projections.
+
+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_sep : PROP → PROP → PROP).
+ Context (bi_wand : PROP → PROP → PROP).
+ Context (bi_persistently : PROP → PROP).
+ Context (sbi_internal_eq : ∀ A : ofeT, A → A → PROP).
+ Context (sbi_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%stdpp).
+ 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 Infix "∗" := bi_sep.
+ Local Infix "-∗" := bi_wand.
+ Local Notation "'<pers>' P" := (bi_persistently P).
+ Local Notation "x ≡ y" := (sbi_internal_eq _ x y).
+ Local Notation "â–· P" := (sbi_later P).
+
+ (** * Axioms for a general BI (logic of bunched implications) *)
+
+ (** The following axioms are satisifed by both affine and linear BIs, and BIs
+ that combine both kinds of resources. In particular, we have an "ordered RA"
+ model satisfying all these axioms. For this model, we extend RAs with an
+ arbitrary partial order, and up-close resources wrt. that order (instead of
+ extension order). We demand composition to be monotone wrt. the order: [x1 ≼
+ x2 → x1 ⋅ y ≼ x2 ⋅ y]. We define [emp := λ r, ε ≼ r]; persistently is still
+ defined with the core: [persistently P := λ r, P (core r)]. This is uplcosed
+ because the core is monotone. *)
+
+ 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;
+
+ (** Higher-order logic *)
+ bi_mixin_pure_intro (φ : Prop) P : φ → P ⊢ ⌜ φ âŒ;
+ bi_mixin_pure_elim' (φ : Prop) P : (φ → True ⊢ P) → ⌜ φ ⌠⊢ P;
+ (* This is actually derivable if we assume excluded middle in Coq,
+ via [(∀ a, φ a) ∨ (∃ a, ¬φ a)]. *)
+ 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;
+
+ (** 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;
+
+ (** Persistently *)
+ (* In the ordered RA model: Holds without further assumptions. *)
+ bi_mixin_persistently_mono P Q : (P ⊢ Q) → <pers> P ⊢ <pers> Q;
+ (* In the ordered RA model: `core` is idempotent *)
+ bi_mixin_persistently_idemp_2 P : <pers> P ⊢ <pers> <pers> P;
+
+ (* In the ordered RA model: [ε ≼ core x]. *)
+ bi_mixin_persistently_emp_2 : emp ⊢ <pers> emp;
+
+ bi_mixin_persistently_forall_2 {A} (Ψ : A → PROP) :
+ (∀ a, <pers> (Ψ a)) ⊢ <pers> (∀ a, Ψ a);
+ bi_mixin_persistently_exist_1 {A} (Ψ : A → PROP) :
+ <pers> (∃ a, Ψ a) ⊢ ∃ a, <pers> (Ψ a);
+
+ (* In the ordered RA model: [core x ≼ core (x ⋅ y)]. *)
+ bi_mixin_persistently_absorbing P Q : <pers> P ∗ Q ⊢ <pers> P;
+ (* In the ordered RA model: [x â‹… core x = x]. *)
+ bi_mixin_persistently_and_sep_elim P Q : <pers> P ∧ Q ⊢ P ∗ Q;
+ }.
+
+ Record SbiMixin := {
+ sbi_mixin_later_contractive : Contractive sbi_later;
+ sbi_mixin_internal_eq_ne (A : ofeT) : NonExpansive2 (sbi_internal_eq A);
+
+ (* Equality *)
+ sbi_mixin_internal_eq_refl {A : ofeT} P (a : A) : P ⊢ a ≡ a;
+ sbi_mixin_internal_eq_rewrite {A : ofeT} a b (Ψ : A → PROP) :
+ NonExpansive Ψ → a ≡ b ⊢ Ψ a → Ψ b;
+ sbi_mixin_fun_ext {A} {B : A → ofeT} (f g : ofe_fun B) : (∀ x, f x ≡ g x) ⊢ f ≡ g;
+ sbi_mixin_sig_eq {A : ofeT} (P : A → Prop) (x y : sig P) : `x ≡ `y ⊢ x ≡ y;
+ sbi_mixin_discrete_eq_1 {A : ofeT} (a b : A) : Discrete a → a ≡ b ⊢ ⌜a ≡ bâŒ;
+
+ (* 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_later_intro 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_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 : ▷ <pers> P ⊢ <pers> ▷ P;
+ sbi_mixin_later_persistently_2 P : <pers> ▷ P ⊢ ▷ <pers> 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_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_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_sep) 1.
+Instance: Params (@bi_wand) 1.
+Instance: Params (@bi_persistently) 1.
+
+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} _%stdpp : 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_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_sep : sbi_car → sbi_car → sbi_car;
+ sbi_wand : sbi_car → sbi_car → sbi_car;
+ sbi_persistently : sbi_car → sbi_car;
+ sbi_internal_eq : ∀ A : ofeT, A → A → sbi_car;
+ sbi_later : sbi_car → sbi_car;
+ sbi_ofe_mixin : OfeMixin sbi_car;
+ sbi_cofe : Cofe (OfeT sbi_car sbi_ofe_mixin);
+ sbi_bi_mixin : BiMixin sbi_entails sbi_emp sbi_pure sbi_and sbi_or sbi_impl
+ sbi_forall sbi_exist sbi_sep sbi_wand sbi_persistently;
+ sbi_sbi_mixin : SbiMixin sbi_entails sbi_pure sbi_or sbi_impl
+ sbi_forall sbi_exist sbi_sep
+ sbi_persistently sbi_internal_eq sbi_later;
+}.
+
+Instance: Params (@sbi_later) 1.
+Instance: Params (@sbi_internal_eq) 1.
+
+Arguments sbi_later {PROP} _%I : simpl never, rename.
+Arguments sbi_internal_eq {PROP _} _ _ : 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.
+Global Instance sbi_cofe' (PROP : sbi) : Cofe PROP.
+Proof. apply sbi_cofe. Qed.
+
+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} _%stdpp : 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_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 sbi_internal_eq {PROP _} _ _ : simpl never, rename.
+Arguments sbi_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) : stdpp_scope.
+Notation "P ⊢@{ PROP } Q" := (bi_entails (PROP:=PROP) P%I Q%I) (only parsing) : stdpp_scope.
+Notation "(⊢)" := bi_entails (only parsing) : stdpp_scope.
+Notation "(⊢@{ PROP } )" := (bi_entails (PROP:=PROP)) (only parsing) : stdpp_scope.
+
+Notation "P ⊣⊢ Q" := (equiv (A:=bi_car _) P%I Q%I) : stdpp_scope.
+Notation "P ⊣⊢@{ PROP } Q" := (equiv (A:=bi_car PROP) P%I Q%I) (only parsing) : stdpp_scope.
+Notation "(⊣⊢)" := (equiv (A:=bi_car _)) (only parsing) : stdpp_scope.
+Notation "(⊣⊢@{ PROP } )" := (equiv (A:=bi_car PROP)) (only parsing) : stdpp_scope.
+
+Notation "P -∗ Q" := (P ⊢ Q) : stdpp_scope.
+
+Notation "'emp'" := (bi_emp) : bi_scope.
+Notation "'⌜' φ 'âŒ'" := (bi_pure φ%type%stdpp) : 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 "'<pers>' P" := (bi_persistently P) : bi_scope.
+
+Infix "≡" := sbi_internal_eq : bi_scope.
+Notation "â–· P" := (sbi_later P) : bi_scope.
+
+Coercion bi_emp_valid {PROP : bi} (P : PROP) : Prop := emp ⊢ P.
+Coercion sbi_emp_valid {PROP : sbi} : PROP → Prop := bi_emp_valid.
+
+Arguments bi_emp_valid {_} _%I : simpl never.
+Typeclasses Opaque bi_emp_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 (φ : Prop) P : φ → 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.
+
+(* 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.
+
+(* Persistently *)
+Lemma persistently_mono P Q : (P ⊢ Q) → <pers> P ⊢ <pers> Q.
+Proof. eapply bi_mixin_persistently_mono, bi_bi_mixin. Qed.
+Lemma persistently_idemp_2 P : <pers> P ⊢ <pers> <pers> P.
+Proof. eapply bi_mixin_persistently_idemp_2, bi_bi_mixin. Qed.
+
+Lemma persistently_emp_2 : emp ⊢@{PROP} <pers> emp.
+Proof. eapply bi_mixin_persistently_emp_2, bi_bi_mixin. Qed.
+
+Lemma persistently_forall_2 {A} (Ψ : A → PROP) :
+ (∀ a, <pers> (Ψ a)) ⊢ <pers> (∀ a, Ψ a).
+Proof. eapply bi_mixin_persistently_forall_2, bi_bi_mixin. Qed.
+Lemma persistently_exist_1 {A} (Ψ : A → PROP) :
+ <pers> (∃ a, Ψ a) ⊢ ∃ a, <pers> (Ψ a).
+Proof. eapply bi_mixin_persistently_exist_1, bi_bi_mixin. Qed.
+
+Lemma persistently_absorbing P Q : <pers> P ∗ Q ⊢ <pers> P.
+Proof. eapply (bi_mixin_persistently_absorbing bi_entails), bi_bi_mixin. Qed.
+Lemma persistently_and_sep_elim P Q : <pers> P ∧ Q ⊢ P ∗ Q.
+Proof. eapply (bi_mixin_persistently_and_sep_elim bi_entails), bi_bi_mixin. Qed.
+End bi_laws.
+
+Section sbi_laws.
+Context {PROP : sbi}.
+Implicit Types φ : Prop.
+Implicit Types P Q R : PROP.
+
+(* Equality *)
+Global Instance internal_eq_ne (A : ofeT) : NonExpansive2 (@sbi_internal_eq PROP A).
+Proof. eapply sbi_mixin_internal_eq_ne, sbi_sbi_mixin. Qed.
+
+Lemma internal_eq_refl {A : ofeT} P (a : A) : P ⊢ a ≡ a.
+Proof. eapply sbi_mixin_internal_eq_refl, sbi_sbi_mixin. Qed.
+Lemma internal_eq_rewrite {A : ofeT} a b (Ψ : A → PROP) :
+ NonExpansive Ψ → a ≡ b ⊢ Ψ a → Ψ b.
+Proof. eapply sbi_mixin_internal_eq_rewrite, sbi_sbi_mixin. Qed.
+
+Lemma fun_ext {A} {B : A → ofeT} (f g : ofe_fun B) :
+ (∀ x, f x ≡ g x) ⊢@{PROP} f ≡ g.
+Proof. eapply sbi_mixin_fun_ext, sbi_sbi_mixin. Qed.
+Lemma sig_eq {A : ofeT} (P : A → Prop) (x y : sig P) :
+ `x ≡ `y ⊢@{PROP} x ≡ y.
+Proof. eapply sbi_mixin_sig_eq, sbi_sbi_mixin. Qed.
+Lemma discrete_eq_1 {A : ofeT} (a b : A) :
+ Discrete a → a ≡ b ⊢@{PROP} ⌜a ≡ bâŒ.
+Proof. eapply sbi_mixin_discrete_eq_1, sbi_sbi_mixin. Qed.
+
+(* Later *)
+Global Instance later_contractive : Contractive (@sbi_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 ⊢@{PROP} ▷ (x ≡ y).
+Proof. eapply sbi_mixin_later_eq_1, sbi_sbi_mixin. Qed.
+Lemma later_eq_2 {A : ofeT} (x y : A) : ▷ (x ≡ y) ⊢@{PROP} Next x ≡ Next y.
+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 later_intro P : P ⊢ ▷ P.
+Proof. eapply sbi_mixin_later_intro, 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_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 : ▷ <pers> P ⊢ <pers> ▷ P.
+Proof. eapply (sbi_mixin_later_persistently_1 bi_entails), sbi_sbi_mixin. Qed.
+Lemma later_persistently_2 P : <pers> ▷ P ⊢ ▷ <pers> 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/bi/lib/atomic.v b/theories/bi/lib/atomic.v
new file mode 100644
index 0000000000000000000000000000000000000000..09b9ec49ce2c4b107f3732810cc774f7843df175
--- /dev/null
+++ b/theories/bi/lib/atomic.v
@@ -0,0 +1,285 @@
+From iris.bi Require Export bi updates.
+From iris.bi.lib Require Import fixpoint laterable.
+From stdpp Require Import coPset namespaces.
+From iris.proofmode Require Import coq_tactics tactics reduction.
+Set Default Proof Using "Type".
+
+(** Conveniently split a conjunction on both assumption and conclusion. *)
+Local Tactic Notation "iSplitWith" constr(H) :=
+ iApply (bi.and_parallel with H); iSplit; iIntros H.
+
+Section definition.
+ Context `{BiFUpd PROP} {A B : Type}.
+ Implicit Types
+ (Eo Em Ei : coPset) (* outside/module/inner masks *)
+ (α : A → PROP) (* atomic pre-condition *)
+ (P : PROP) (* abortion condition *)
+ (β : A → B → PROP) (* atomic post-condition *)
+ (Φ : A → B → PROP) (* post-condition *)
+ .
+
+ (** atomic_acc as the "introduction form" of atomic updates: An accessor
+ that can be aborted back to [P]. *)
+ Definition atomic_acc Eo Ei α P β Φ : PROP :=
+ (|={Eo, Ei}=> ∃ x, α x ∗
+ ((α x ={Ei, Eo}=∗ P) ∧ (∀ y, β x y ={Ei, Eo}=∗ Φ x y))
+ )%I.
+
+ Lemma atomic_acc_wand Eo Ei α P1 P2 β Φ1 Φ2 :
+ ((P1 -∗ P2) ∧ (∀ x y, Φ1 x y -∗ Φ2 x y)) -∗
+ (atomic_acc Eo Ei α P1 β Φ1 -∗ atomic_acc Eo Ei α P2 β Φ2).
+ Proof.
+ iIntros "HP12 AS". iMod "AS" as (x) "[Hα Hclose]".
+ iModIntro. iExists x. iFrame "Hα". iSplit.
+ - iIntros "Hα". iDestruct "Hclose" as "[Hclose _]".
+ iApply "HP12". iApply "Hclose". done.
+ - iIntros (y) "Hβ". iDestruct "Hclose" as "[_ Hclose]".
+ iApply "HP12". iApply "Hclose". done.
+ Qed.
+
+ Lemma atomic_acc_mask Eo Em α P β Φ :
+ atomic_acc Eo (Eo∖Em) α P β Φ ⊣⊢ ∀ E, ⌜Eo ⊆ E⌠→ atomic_acc E (E∖Em) α P β Φ.
+ Proof.
+ iSplit; last first.
+ { iIntros "Hstep". iApply ("Hstep" with "[% //]"). }
+ iIntros "Hstep" (E HE).
+ iApply (fupd_mask_frame_acc with "Hstep"); first done.
+ iIntros "Hstep". iDestruct "Hstep" as (x) "[Hα Hclose]".
+ iIntros "!> Hclose'".
+ iExists x. iFrame. iSplitWith "Hclose".
+ - iIntros "Hα". iApply "Hclose'". iApply "Hclose". done.
+ - iIntros (y) "Hβ". iApply "Hclose'". iApply "Hclose". done.
+ Qed.
+
+ (** atomic_update as a fixed-point of the equation
+ AU = ∃ P. ▷ P ∗ □ (▷ P ==∗ α ∗ (α ==∗ AU) ∧ (β ==∗ Q))
+ = ∃ P. ▷ P ∗ □ (▷ P -∗ atomic_acc α AU β Q)
+ *)
+ Context Eo Em α β Φ.
+
+ Definition atomic_update_pre (Ψ : () → PROP) (_ : ()) : PROP :=
+ (∃ (P : PROP), ▷ P ∗
+ □ (▷ P -∗ atomic_acc Eo (Eo∖Em) α (Ψ ()) β Φ))%I.
+
+ Local Instance atomic_update_pre_mono : BiMonoPred atomic_update_pre.
+ Proof.
+ constructor.
+ - iIntros (P1 P2) "#HP12". iIntros ([]) "AU".
+ iDestruct "AU" as (P) "[HP #AS]". iExists P. iFrame.
+ iIntros "!# HP". iApply (atomic_acc_wand with "[HP12]"); last by iApply "AS".
+ iSplit; last by eauto. iApply "HP12".
+ - intros ??. solve_proper.
+ Qed.
+
+ Definition atomic_update_def :=
+ bi_greatest_fixpoint atomic_update_pre ().
+
+End definition.
+
+(** Seal it *)
+Definition atomic_update_aux : seal (@atomic_update_def). by eexists. Qed.
+Definition atomic_update `{BiFUpd PROP} {A B : Type} := atomic_update_aux.(unseal) PROP _ A B.
+Definition atomic_update_eq :
+ @atomic_update = @atomic_update_def := atomic_update_aux.(seal_eq).
+
+(** Lemmas about AU *)
+Section lemmas.
+ Context `{BiFUpd PROP} {A B : Type}.
+ Implicit Types (α : A → PROP) (β Φ : A → B → PROP) (P : PROP).
+
+ Local Existing Instance atomic_update_pre_mono.
+
+ Global Instance atomic_acc_ne Eo Em n :
+ Proper (
+ pointwise_relation A (dist n) ==>
+ dist n ==>
+ pointwise_relation A (pointwise_relation B (dist n)) ==>
+ pointwise_relation A (pointwise_relation B (dist n)) ==>
+ dist n
+ ) (atomic_acc (PROP:=PROP) Eo Em).
+ Proof. solve_proper. Qed.
+
+ Global Instance atomic_update_ne Eo Em n :
+ Proper (
+ pointwise_relation A (dist n) ==>
+ pointwise_relation A (pointwise_relation B (dist n)) ==>
+ pointwise_relation A (pointwise_relation B (dist n)) ==>
+ dist n
+ ) (atomic_update (PROP:=PROP) Eo Em).
+ Proof.
+ rewrite atomic_update_eq /atomic_update_def /atomic_update_pre. solve_proper.
+ Qed.
+
+ (** The ellimination form: an accessor *)
+ Lemma aupd_acc Eo Em E α β Φ :
+ Eo ⊆ E →
+ atomic_update Eo Em α β Φ -∗
+ atomic_acc E (E∖Em) α (atomic_update Eo Em α β Φ) β Φ.
+ Proof using Type*.
+ rewrite atomic_update_eq {1}/atomic_update_def /=. iIntros (HE) "HUpd".
+ iPoseProof (greatest_fixpoint_unfold_1 with "HUpd") as "HUpd".
+ iDestruct "HUpd" as (P) "(HP & Hshift)".
+ iRevert (E HE). iApply atomic_acc_mask.
+ iApply "Hshift". done.
+ Qed.
+
+ Global Instance aupd_laterable Eo Em α β Φ :
+ Laterable (atomic_update Eo Em α β Φ).
+ Proof.
+ rewrite /Laterable atomic_update_eq {1}/atomic_update_def /=. iIntros "AU".
+ iPoseProof (greatest_fixpoint_unfold_1 with "AU") as (P) "[HP #AS]".
+ iExists P. iFrame. iIntros "!# HP !>".
+ iApply greatest_fixpoint_unfold_2. iExists P. iFrame "#∗".
+ Qed.
+
+ Lemma aupd_intro P Q α β Eo Em Φ :
+ Affine P → Persistent P → Laterable Q →
+ (P ∗ Q -∗ atomic_acc Eo (Eo∖Em) α Q β Φ) →
+ P ∗ Q -∗ atomic_update Eo Em α β Φ.
+ Proof.
+ rewrite atomic_update_eq {1}/atomic_update_def /=.
+ iIntros (??? HAU) "[#HP HQ]".
+ iApply (greatest_fixpoint_coind _ (λ _, Q)); last done. iIntros "!#" ([]) "HQ".
+ iDestruct (laterable with "HQ") as (Q') "[HQ' #HQi]". iExists Q'. iFrame.
+ iIntros "!# HQ'". iDestruct ("HQi" with "HQ'") as ">HQ {HQi}".
+ iApply HAU. by iFrame.
+ Qed.
+
+ Lemma aacc_intro x Eo Ei α P β Φ :
+ Ei ⊆ Eo → α x -∗
+ ((α x ={Eo}=∗ P) ∧ (∀ y, β x y ={Eo}=∗ Φ x y)) -∗
+ atomic_acc Eo Ei α P β Φ.
+ Proof.
+ iIntros (?) "Hα Hclose".
+ iMod fupd_intro_mask' as "Hclose'"; last iModIntro; first set_solver.
+ iExists x. iFrame. iSplitWith "Hclose".
+ - iIntros "Hα". iMod "Hclose'" as "_". iApply "Hclose". done.
+ - iIntros (y) "Hβ". iMod "Hclose'" as "_". iApply "Hclose". done.
+ Qed.
+
+ Global Instance elim_acc_aacc {X} E1 E2 Ei (α' β' : X → PROP) γ' α β Pas Φ :
+ ElimAcc (X:=X) (fupd E1 E2) (fupd E2 E1) α' β' γ'
+ (atomic_acc E1 Ei α Pas β Φ)
+ (λ x', atomic_acc E2 Ei α (β' x' ∗ (γ' x' -∗? Pas))%I β
+ (λ x y, β' x' ∗ (γ' x' -∗? Φ x y)))%I.
+ Proof.
+ rewrite /ElimAcc.
+ (* FIXME: Is there any way to prevent maybe_wand from unfolding?
+ It gets unfolded by env_cbv in the proofmode, ideally we'd like that
+ to happen only if one argument is a constructor. *)
+ iIntros "Hinner >Hacc". iDestruct "Hacc" as (x') "[Hα' Hclose]".
+ iMod ("Hinner" with "Hα'") as (x) "[Hα Hclose']".
+ iMod (fupd_intro_mask') as "Hclose''"; last iModIntro; first done.
+ iExists x. iFrame. iSplitWith "Hclose'".
+ - iIntros "Hα". iMod "Hclose''" as "_".
+ iMod ("Hclose'" with "Hα") as "[Hβ' HPas]".
+ iMod ("Hclose" with "Hβ'") as "Hγ'".
+ iModIntro. destruct (γ' x'); iApply "HPas"; done.
+ - iIntros (y) "Hβ". iMod "Hclose''" as "_".
+ iMod ("Hclose'" with "Hβ") as "[Hβ' HΦ]".
+ iMod ("Hclose" with "Hβ'") as "Hγ'".
+ iModIntro. destruct (γ' x'); iApply "HΦ"; done.
+ Qed.
+
+ Lemma aacc_aacc {A' B'} E1 E2 E3
+ α P β Φ
+ (α' : A' → PROP) P' (β' Φ' : A' → B' → PROP) :
+ atomic_acc E1 E2 α P β Φ -∗
+ (∀ x, α x -∗ atomic_acc E2 E3 α' (α x ∗ (P ={E1}=∗ P')) β'
+ (λ x' y', (α x ∗ (P ={E1}=∗ Φ' x' y'))
+ ∨ ∃ y, β x y ∗ (Φ x y ={E1}=∗ Φ' x' y'))) -∗
+ atomic_acc E1 E3 α' P' β' Φ'.
+ Proof.
+ iIntros "Hupd Hstep". iMod ("Hupd") as (x) "[Hα Hclose]".
+ iMod ("Hstep" with "Hα") as (x') "[Hα' Hclose']".
+ iModIntro. iExists x'. iFrame "Hα'". iSplit.
+ - iIntros "Hα'". iDestruct "Hclose'" as "[Hclose' _]".
+ iMod ("Hclose'" with "Hα'") as "[Hα Hupd]".
+ iDestruct "Hclose" as "[Hclose _]".
+ iMod ("Hclose" with "Hα"). iApply "Hupd". auto.
+ - iIntros (y') "Hβ'". iDestruct "Hclose'" as "[_ Hclose']".
+ iMod ("Hclose'" with "Hβ'") as "[[Hα HΦ']|Hcont]".
+ + (* Abort the step we are eliminating *)
+ iDestruct "Hclose" as "[Hclose _]".
+ iMod ("Hclose" with "Hα") as "HP".
+ iApply "HΦ'". done.
+ + (* Complete the step we are eliminating *)
+ iDestruct "Hclose" as "[_ Hclose]".
+ iDestruct "Hcont" as (y) "[Hβ HΦ']".
+ iMod ("Hclose" with "Hβ") as "HΦ".
+ iApply "HΦ'". done.
+ Qed.
+
+ Lemma aacc_aupd {A' B'} E1 E2 Eo Em
+ α β Φ
+ (α' : A' → PROP) P' (β' Φ' : A' → B' → PROP) :
+ Eo ⊆ E1 →
+ atomic_update Eo Em α β Φ -∗
+ (∀ x, α x -∗ atomic_acc (E1∖Em) E2 α' (α x ∗ (atomic_update Eo Em α β Φ ={E1}=∗ P')) β'
+ (λ x' y', (α x ∗ (atomic_update Eo Em α β Φ ={E1}=∗ Φ' x' y'))
+ ∨ ∃ y, β x y ∗ (Φ x y ={E1}=∗ Φ' x' y'))) -∗
+ atomic_acc E1 E2 α' P' β' Φ'.
+ Proof.
+ iIntros (?) "Hupd Hstep". iApply (aacc_aacc with "[Hupd] Hstep").
+ iApply aupd_acc; done.
+ Qed.
+
+ Lemma aacc_aupd_commit {A' B'} E1 E2 Eo Em
+ α β Φ
+ (α' : A' → PROP) P' (β' Φ' : A' → B' → PROP) :
+ Eo ⊆ E1 →
+ atomic_update Eo Em α β Φ -∗
+ (∀ x, α x -∗ atomic_acc (E1∖Em) E2 α' (α x ∗ (atomic_update Eo Em α β Φ ={E1}=∗ P')) β'
+ (λ x' y', ∃ y, β x y ∗ (Φ x y ={E1}=∗ Φ' x' y'))) -∗
+ atomic_acc E1 E2 α' P' β' Φ'.
+ Proof.
+ iIntros (?) "Hupd Hstep". iApply (aacc_aupd with "Hupd"); first done.
+ iIntros (x) "Hα". iApply atomic_acc_wand; last first.
+ { iApply "Hstep". done. }
+ iSplit; first by eauto. iIntros (??) "?". by iRight.
+ Qed.
+
+ Lemma aacc_aupd_abort {A' B'} E1 E2 Eo Em
+ α β Φ
+ (α' : A' → PROP) P' (β' Φ' : A' → B' → PROP) :
+ Eo ⊆ E1 →
+ atomic_update Eo Em α β Φ -∗
+ (∀ x, α x -∗ atomic_acc (E1∖Em) E2 α' (α x ∗ (atomic_update Eo Em α β Φ ={E1}=∗ P')) β'
+ (λ x' y', α x ∗ (atomic_update Eo Em α β Φ ={E1}=∗ Φ' x' y'))) -∗
+ atomic_acc E1 E2 α' P' β' Φ'.
+ Proof.
+ iIntros (?) "Hupd Hstep". iApply (aacc_aupd with "Hupd"); first done.
+ iIntros (x) "Hα". iApply atomic_acc_wand; last first.
+ { iApply "Hstep". done. }
+ iSplit; first by eauto. iIntros (??) "?". by iLeft.
+ Qed.
+
+End lemmas.
+
+(** ProofMode support for atomic updates *)
+
+Section proof_mode.
+ Context `{BiFUpd PROP} {A B : Type}.
+ Implicit Types (α : A → PROP) (β Φ : A → B → PROP) (P : PROP).
+
+ Lemma tac_aupd_intro Γp Γs n α β Eo Em Φ P :
+ Timeless (PROP:=PROP) emp →
+ TCForall Laterable (env_to_list Γs) →
+ P = prop_of_env Γs →
+ envs_entails (Envs Γp Γs n) (atomic_acc Eo (Eo∖Em) α P β Φ) →
+ envs_entails (Envs Γp Γs n) (atomic_update Eo Em α β Φ).
+ Proof.
+ intros ? HΓs ->. rewrite envs_entails_eq of_envs_eq' /atomic_acc /=.
+ setoid_rewrite prop_of_env_sound =>HAU.
+ apply aupd_intro; [apply _..|]. done.
+ Qed.
+End proof_mode.
+
+(** Now the coq-level tactics *)
+
+Tactic Notation "iAuIntro" :=
+ iStartProof; eapply tac_aupd_intro; [
+ iSolveTC || fail "iAuIntro: emp is not timeless"
+ | iSolveTC || fail "iAuIntro: not all spatial assumptions are laterable"
+ | (* P = ...: make the P pretty *) pm_reflexivity
+ | (* the new proof mode goal *) ].
diff --git a/theories/bi/lib/core.v b/theories/bi/lib/core.v
new file mode 100644
index 0000000000000000000000000000000000000000..ce4ab4647a0cb1b2f0f39f36fd67e7f91bfcc4c7
--- /dev/null
+++ b/theories/bi/lib/core.v
@@ -0,0 +1,57 @@
+From iris.bi Require Export bi plainly.
+From iris.proofmode Require Import tactics.
+Set Default Proof Using "Type".
+Import bi.
+
+(** The "core" of an assertion is its maximal persistent part,
+ i.e. the conjunction of all persistent assertions that are weaker
+ than P (as in, implied by P). *)
+Definition coreP `{!BiPlainly PROP} (P : PROP) : PROP :=
+ (* TODO: Looks like we want notation for affinely-plainly; that lets us avoid
+ using conjunction/implication here. *)
+ (∀ Q : PROP, <affine> ■(Q -∗ <pers> Q) -∗ <affine> ■(P -∗ Q) -∗ Q)%I.
+Instance: Params (@coreP) 1.
+Typeclasses Opaque coreP.
+
+Section core.
+ Context `{!BiPlainly PROP}.
+ Implicit Types P Q : PROP.
+
+ Lemma coreP_intro P : P -∗ coreP P.
+ Proof.
+ rewrite /coreP. iIntros "HP" (Q) "_ HPQ".
+ (* FIXME: Cannot apply HPQ directly. This works if we move it to the
+ persistent context, but why should we? *)
+ iDestruct (affinely_plainly_elim with "HPQ") as "HPQ".
+ by iApply "HPQ".
+ Qed.
+
+ Global Instance coreP_persistent P : Persistent (coreP P).
+ Proof.
+ rewrite /coreP /Persistent. iIntros "HC" (Q).
+ iApply persistently_wand_affinely_plainly. iIntros "#HQ".
+ iApply persistently_wand_affinely_plainly. iIntros "#HPQ".
+ iApply "HQ". iApply "HC"; auto.
+ Qed.
+
+ Global Instance coreP_ne : NonExpansive (coreP (PROP:=PROP)).
+ Proof. solve_proper. Qed.
+ Global Instance coreP_proper : Proper ((⊣⊢) ==> (⊣⊢)) (coreP (PROP:=PROP)).
+ Proof. solve_proper. Qed.
+
+ Global Instance coreP_mono : Proper ((⊢) ==> (⊢)) (coreP (PROP:=PROP)).
+ Proof. solve_proper. Qed.
+
+ Lemma coreP_elim P : Persistent P → coreP P -∗ P.
+ Proof. rewrite /coreP. iIntros (?) "HCP". iApply "HCP"; auto. Qed.
+
+ (* TODO: Can we generalize this to non-affine BIs? *)
+ Lemma coreP_wand `{!BiAffine PROP} P Q : (coreP P ⊢ Q) ↔ (P ⊢ <pers> Q).
+ Proof.
+ split.
+ - iIntros (HP) "HP". iDestruct (coreP_intro with "HP") as "#HcP".
+ iAlways. by iApply HP.
+ - iIntros (HPQ) "HcP". iDestruct (coreP_mono _ _ HPQ with "HcP") as "HcQ".
+ by iDestruct (coreP_elim with "HcQ") as "#HQ".
+ Qed.
+End core.
diff --git a/theories/base_logic/lib/counter_examples.v b/theories/bi/lib/counter_examples.v
similarity index 67%
rename from theories/base_logic/lib/counter_examples.v
rename to theories/bi/lib/counter_examples.v
index 9228b168817cee0c81554b5c3e77b99238c62a4d..ca5f1707f28b2d4072979c92aa2fa8bfbceaa128 100644
--- a/theories/base_logic/lib/counter_examples.v
+++ b/theories/bi/lib/counter_examples.v
@@ -1,24 +1,42 @@
-From iris.base_logic Require Import base_logic soundness.
+From iris.bi Require Export bi.
From iris.proofmode Require Import tactics.
Set Default Proof Using "Type*".
(** This proves that we need the â–· in a "Saved Proposition" construction with
name-dependent allocation. *)
Module savedprop. Section savedprop.
- Context (M : ucmraT).
- Notation iProp := (uPred M).
- Notation "¬ P" := (□ (P → False))%I : uPred_scope.
- Implicit Types P : iProp.
+ Context `{BiAffine PROP}.
+ Notation "¬ P" := (□ (P → False))%I : bi_scope.
+ Implicit Types P : PROP.
- (** Saved Propositions and the update modality *)
- Context (sprop : Type) (saved : sprop → iProp → iProp).
+ Context (bupd : PROP → PROP).
+ Notation "|==> Q" := (bupd Q)
+ (at level 99, Q at level 200, format "|==> Q") : bi_scope.
+
+ Hypothesis bupd_intro : ∀ P, P ⊢ |==> P.
+ Hypothesis bupd_mono : ∀ P Q, (P ⊢ Q) → (|==> P) ⊢ |==> Q.
+ Hypothesis bupd_trans : ∀ P, (|==> |==> P) ⊢ |==> P.
+ Hypothesis bupd_frame_r : ∀ P R, (|==> P) ∗ R ⊢ |==> (P ∗ R).
+
+ Context (ident : Type) (saved : ident → PROP → PROP).
Hypothesis sprop_persistent : ∀ i P, Persistent (saved i P).
Hypothesis sprop_alloc_dep :
- ∀ (P : sprop → iProp), (|==> (∃ i, saved i (P i)))%I.
+ ∀ (P : ident → PROP), (|==> ∃ i, saved i (P i))%I.
Hypothesis sprop_agree : ∀ i P Q, saved i P ∧ saved i Q ⊢ □ (P ↔ Q).
+ (** We assume that we cannot update to false. *)
+ Hypothesis consistency : ¬(|==> False)%I.
+
+ Instance bupd_mono' : Proper ((⊢) ==> (⊢)) bupd.
+ Proof. intros P Q ?. by apply bupd_mono. Qed.
+ Instance elim_modal_bupd p P Q : ElimModal True p false (|==> P) P (|==> Q) (|==> Q).
+ Proof.
+ by rewrite /ElimModal bi.intuitionistically_if_elim
+ bupd_frame_r bi.wand_elim_r bupd_trans.
+ Qed.
+
(** A bad recursive reference: "Assertion with name [i] does not hold" *)
- Definition A (i : sprop) : iProp := ∃ P, ¬ P ∗ saved i P.
+ Definition A (i : ident) : PROP := (∃ P, ¬ P ∗ saved i P)%I.
Lemma A_alloc : (|==> ∃ i, saved i (A i))%I.
Proof. by apply sprop_alloc_dep. Qed.
@@ -40,25 +58,24 @@ Module savedprop. Section savedprop.
Lemma contradiction : False.
Proof using All.
- apply (@consistency M); simpl.
- iIntros "". iMod A_alloc as (i) "#H".
+ apply consistency.
+ iMod A_alloc as (i) "#H".
iPoseProof (saved_NA with "H") as "HN".
- iApply "HN". by iApply saved_A.
+ iApply bupd_intro. iApply "HN". iApply saved_A. done.
Qed.
End savedprop. End savedprop.
+
(** This proves that we need the â–· when opening invariants. *)
-(** We fork in [uPred M] for any M, but the proof would work in any BI. *)
Module inv. Section inv.
- Context (M : ucmraT).
- Notation iProp := (uPred M).
- Implicit Types P : iProp.
+ Context `{BiAffine PROP}.
+ Implicit Types P : PROP.
(** Assumptions *)
(** We have the update modality (two classes: empty/full mask) *)
Inductive mask := M0 | M1.
- Context (fupd : mask → iProp → iProp).
-
+ Context (fupd : mask → PROP → PROP).
+ Arguments fupd _ _%I.
Hypothesis fupd_intro : ∀ E P, P ⊢ fupd E P.
Hypothesis fupd_mono : ∀ E P Q, (P ⊢ Q) → fupd E P ⊢ fupd E Q.
Hypothesis fupd_fupd : ∀ E P, fupd E (fupd E P) ⊢ fupd E P.
@@ -66,7 +83,8 @@ Module inv. Section inv.
Hypothesis fupd_mask_mono : ∀ P, fupd M0 P ⊢ fupd M1 P.
(** We have invariants *)
- Context (name : Type) (inv : name → iProp → iProp).
+ Context (name : Type) (inv : name → PROP → PROP).
+ Arguments inv _ _%I.
Hypothesis inv_persistent : ∀ i P, Persistent (inv i P).
Hypothesis inv_alloc : ∀ P, P ⊢ fupd M1 (∃ i, inv i P).
Hypothesis inv_open :
@@ -82,7 +100,7 @@ Module inv. Section inv.
* Ex () +_## ()
*)
Context (gname : Type).
- Context (start finished : gname → iProp).
+ Context (start finished : gname → PROP).
Hypothesis sts_alloc : fupd M0 (∃ γ, start γ).
Hypotheses start_finish : ∀ γ, start γ ⊢ fupd M0 (finished γ).
@@ -106,36 +124,42 @@ 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.
+ Global Instance elim_fupd_fupd p E P Q :
+ ElimModal True p false (fupd E P) P (fupd E Q) (fupd E Q).
+ Proof.
+ by rewrite /ElimModal bi.intuitionistically_if_elim
+ 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).
+ Global Instance elim_fupd0_fupd1 p P Q :
+ ElimModal True p false (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 bi.intuitionistically_if_elim
+ fupd_frame_r bi.wand_elim_r fupd_mask_mono fupd_fupd.
Qed.
- Global Instance exists_split_fupd0 {A} E P (Φ : A → iProp) :
+ Global Instance exists_split_fupd0 {A} E P (Φ : A → PROP) :
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. *)
- Definition saved (γ : gname) (P : iProp) : iProp :=
- ∃ i, inv i (start γ ∨ (finished γ ∗ □ P)).
+ Definition saved (γ : gname) (P : PROP) : PROP :=
+ (∃ i, inv i (start γ ∨ (finished γ ∗ □ P)))%I.
Global Instance saved_persistent γ P : Persistent (saved γ P) := _.
- Lemma saved_alloc (P : gname → iProp) : fupd M1 (∃ γ, saved γ (P γ)).
+ Lemma saved_alloc (P : gname → PROP) : fupd M1 (∃ γ, saved γ (P γ)).
Proof.
iIntros "". iMod (sts_alloc) as (γ) "Hs".
- iMod (inv_alloc (start γ ∨ (finished γ ∗ □ (P γ))) with "[Hs]") as (i) "#Hi".
+ iMod (inv_alloc (start γ ∨ (finished γ ∗ □ (P γ)))%I with "[Hs]") as (i) "#Hi".
{ auto. }
iApply fupd_intro. by iExists γ, i.
Qed.
@@ -161,8 +185,8 @@ Module inv. Section inv.
Qed.
(** And now we tie a bad knot. *)
- Notation "¬ P" := (□ (P -∗ fupd M1 False))%I : uPred_scope.
- Definition A i : iProp := ∃ P, ¬P ∗ saved i P.
+ Notation "¬ P" := (□ (P -∗ fupd M1 False))%I : bi_scope.
+ Definition A i : PROP := (∃ P, ¬P ∗ saved i P)%I.
Global Instance A_persistent i : Persistent (A i) := _.
Lemma A_alloc : fupd M1 (∃ i, saved i (A i)).
diff --git a/theories/bi/lib/fixpoint.v b/theories/bi/lib/fixpoint.v
new file mode 100644
index 0000000000000000000000000000000000000000..27dd09a3fd3a70de93b3ae4e2c7e55680356078f
--- /dev/null
+++ b/theories/bi/lib/fixpoint.v
@@ -0,0 +1,118 @@
+From iris.bi Require Export bi.
+From iris.proofmode Require Import tactics.
+Set Default Proof Using "Type*".
+Import bi.
+
+(** Least and greatest fixpoint of a monotone function, defined entirely inside
+ the logic. *)
+Class BiMonoPred {PROP : bi} {A : ofeT} (F : (A → PROP) → (A → PROP)) := {
+ bi_mono_pred Φ Ψ : (<pers> (∀ x, Φ x -∗ Ψ x) → ∀ x, F Φ x -∗ F Ψ x)%I;
+ bi_mono_pred_ne Φ : NonExpansive Φ → NonExpansive (F Φ)
+}.
+Arguments bi_mono_pred {_ _ _ _} _ _.
+Local Existing Instance bi_mono_pred_ne.
+
+Definition bi_least_fixpoint {PROP : bi} {A : ofeT}
+ (F : (A → PROP) → (A → PROP)) (x : A) : PROP :=
+ tc_opaque (∀ Φ : A -n> PROP, <pers> (∀ x, F Φ x -∗ Φ x) → Φ x)%I.
+Arguments bi_least_fixpoint : simpl never.
+
+Definition bi_greatest_fixpoint {PROP : bi} {A : ofeT}
+ (F : (A → PROP) → (A → PROP)) (x : A) : PROP :=
+ tc_opaque (∃ Φ : A -n> PROP, <pers> (∀ x, Φ x -∗ F Φ x) ∧ Φ x)%I.
+Arguments bi_greatest_fixpoint : simpl never.
+
+Global Instance least_fixpoint_ne {PROP : bi} {A : ofeT} n :
+ Proper (pointwise_relation (A → PROP) (pointwise_relation A (dist n)) ==>
+ dist n ==> dist n) bi_least_fixpoint.
+Proof. solve_proper. Qed.
+
+Section least.
+ Context {PROP : bi} {A : ofeT} (F : (A → PROP) → (A → PROP)) `{!BiMonoPred F}.
+
+ Lemma least_fixpoint_unfold_2 x : F (bi_least_fixpoint F) x ⊢ bi_least_fixpoint F x.
+ Proof.
+ rewrite /bi_least_fixpoint /=. iIntros "HF" (Φ) "#Hincl".
+ iApply "Hincl". iApply (bi_mono_pred _ Φ with "[#]"); last done.
+ iIntros "!#" (y) "Hy". iApply ("Hy" with "[# //]").
+ Qed.
+
+ Lemma least_fixpoint_unfold_1 x :
+ bi_least_fixpoint F x ⊢ F (bi_least_fixpoint F) x.
+ Proof.
+ iIntros "HF". iApply ("HF" $! (CofeMor (F (bi_least_fixpoint F))) with "[#]").
+ iIntros "!#" (y) "Hy". iApply (bi_mono_pred with "[#]"); last done.
+ iIntros "!#" (z) "?". by iApply least_fixpoint_unfold_2.
+ Qed.
+
+ Corollary least_fixpoint_unfold x :
+ bi_least_fixpoint F x ≡ F (bi_least_fixpoint F) x.
+ Proof.
+ apply (anti_symm _); auto using least_fixpoint_unfold_1, least_fixpoint_unfold_2.
+ Qed.
+
+ Lemma least_fixpoint_ind (Φ : A → PROP) `{!NonExpansive Φ} :
+ □ (∀ y, F Φ y -∗ Φ y) -∗ ∀ x, bi_least_fixpoint F x -∗ Φ x.
+ Proof.
+ iIntros "#HΦ" (x) "HF". by iApply ("HF" $! (CofeMor Φ) with "[#]").
+ Qed.
+
+ Lemma least_fixpoint_strong_ind (Φ : A → PROP) `{!NonExpansive Φ} :
+ □ (∀ y, F (λ x, Φ x ∧ bi_least_fixpoint F x) y -∗ Φ y) -∗
+ ∀ x, bi_least_fixpoint F x -∗ Φ x.
+ Proof.
+ trans (∀ x, bi_least_fixpoint F x -∗ Φ x ∧ bi_least_fixpoint F x)%I.
+ { iIntros "#HΦ". iApply (least_fixpoint_ind with "[]"); first solve_proper.
+ iIntros "!#" (y) "H". iSplit; first by iApply "HΦ".
+ iApply least_fixpoint_unfold_2. iApply (bi_mono_pred with "[#] H").
+ by iIntros "!# * [_ ?]". }
+ by setoid_rewrite and_elim_l.
+ Qed.
+End least.
+
+Lemma greatest_fixpoint_ne_outer {PROP : bi} {A : ofeT}
+ (F1 : (A → PROP) → (A → PROP))
+ (F2 : (A → PROP) → (A → PROP)):
+ (∀ Φ x n, F1 Φ x ≡{n}≡ F2 Φ x) → ∀ x1 x2 n,
+ (dist n) x1 x2 → (dist n) (bi_greatest_fixpoint F1 x1) (bi_greatest_fixpoint F2 x2).
+Proof.
+ intros HF ??? Hx. rewrite /bi_greatest_fixpoint /=.
+ f_equiv. f_equiv. f_equiv. 2: solve_proper.
+ f_equiv. f_equiv. f_equiv. f_equiv. apply HF.
+Qed.
+
+Global Instance greatest_fixpoint_ne {PROP : bi} {A : ofeT} n :
+ Proper (pointwise_relation (A → PROP) (pointwise_relation A (dist n)) ==>
+ dist n ==> dist n) bi_greatest_fixpoint.
+Proof. solve_proper. Qed.
+
+Section greatest.
+ Context {PROP : bi} {A : ofeT} (F : (A → PROP) → (A → PROP)) `{!BiMonoPred F}.
+
+ Lemma greatest_fixpoint_unfold_1 x :
+ bi_greatest_fixpoint F x ⊢ F (bi_greatest_fixpoint F) x.
+ Proof.
+ iDestruct 1 as (Φ) "[#Hincl HΦ]".
+ iApply (bi_mono_pred Φ (bi_greatest_fixpoint F) with "[#]").
+ - iIntros "!#" (y) "Hy". iExists Φ. auto.
+ - by iApply "Hincl".
+ Qed.
+
+ Lemma greatest_fixpoint_unfold_2 x :
+ F (bi_greatest_fixpoint F) x ⊢ bi_greatest_fixpoint F x.
+ Proof.
+ iIntros "HF". iExists (CofeMor (F (bi_greatest_fixpoint F))).
+ iSplit; last done. iIntros "!#" (y) "Hy". iApply (bi_mono_pred with "[#] Hy").
+ iIntros "!#" (z) "?". by iApply greatest_fixpoint_unfold_1.
+ Qed.
+
+ Corollary greatest_fixpoint_unfold x :
+ bi_greatest_fixpoint F x ≡ F (bi_greatest_fixpoint F) x.
+ Proof.
+ apply (anti_symm _); auto using greatest_fixpoint_unfold_1, greatest_fixpoint_unfold_2.
+ Qed.
+
+ Lemma greatest_fixpoint_coind (Φ : A → PROP) `{!NonExpansive Φ} :
+ □ (∀ y, Φ y -∗ F Φ y) -∗ ∀ x, Φ x -∗ bi_greatest_fixpoint F x.
+ Proof. iIntros "#HΦ" (x) "Hx". iExists (CofeMor Φ). auto. Qed.
+End greatest.
diff --git a/theories/base_logic/lib/fractional.v b/theories/bi/lib/fractional.v
similarity index 69%
rename from theories/base_logic/lib/fractional.v
rename to theories/bi/lib/fractional.v
index 104146e5375cb8407374ea47fe79085f2edffc1b..cef06cc0fc7390801b3c8d5bd30df045fce918a8 100644
--- a/theories/base_logic/lib/fractional.v
+++ b/theories/bi/lib/fractional.v
@@ -1,15 +1,16 @@
-From stdpp Require Import gmap gmultiset.
-From iris.base_logic Require Export base_logic.
-From iris.base_logic Require Import big_op.
-From iris.proofmode Require Import classes class_instances.
+From iris.bi Require Export bi.
+From iris.proofmode Require Import classes class_instances_bi.
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.
+ Persistent P → Absorbing P → Fractional (λ _, P).
+ Proof. intros ?? 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,46 +115,39 @@ 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 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 P1 P2.
+ Proof. intros. rewrite /IntoSep [P]fractional_split //. Qed.
+
+ Global Instance into_sep_fractional_half 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 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
+ the proof search. The proof search then fails almost always on
[AsFractional R Φ r], but the slowdown is still noticeable. For
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.intuitionistically_if_elim -fractional Qp_div_2.
Qed.
End fractional.
diff --git a/theories/bi/lib/laterable.v b/theories/bi/lib/laterable.v
new file mode 100644
index 0000000000000000000000000000000000000000..a1243539d128962bf206b27414e0d344628c93c4
--- /dev/null
+++ b/theories/bi/lib/laterable.v
@@ -0,0 +1,60 @@
+From iris.bi Require Export bi.
+From iris.proofmode Require Import tactics.
+Set Default Proof Using "Type".
+
+(** The class of laterable assertions *)
+Class Laterable {PROP : sbi} (P : PROP) := laterable :
+ P -∗ ∃ Q, ▷ Q ∗ □ (▷ Q -∗ ◇ P).
+Arguments Laterable {_} _%I : simpl never.
+Arguments laterable {_} _%I {_}.
+Hint Mode Laterable + ! : typeclass_instances.
+
+Section instances.
+ Context {PROP : sbi}.
+ Implicit Types P : PROP.
+ Implicit Types Ps : list PROP.
+
+ Global Instance later_laterable P : Laterable (â–· P).
+ Proof.
+ rewrite /Laterable. iIntros "HP". iExists P. iFrame.
+ iIntros "!# HP !>". done.
+ Qed.
+
+ Global Instance timeless_laterable P :
+ Timeless P → Laterable P.
+ Proof.
+ rewrite /Laterable. iIntros (?) "HP". iExists P%I. iFrame.
+ iSplitR; first by iNext. iIntros "!# >HP !>". done.
+ Qed.
+
+ (** This lemma is not very useful: It needs a strange assumption about
+ emp, and most of the time intuitionistic propositions can be just kept
+ around anyway and don't need to be "latered". The lemma exists
+ because the fact that it needs the side-condition is interesting;
+ it is not an instance because it won't usually get used. *)
+ Lemma intuitionistic_laterable P :
+ Timeless (PROP:=PROP) emp → Affine P → Persistent P → Laterable P.
+ Proof.
+ rewrite /Laterable. iIntros (???) "#HP".
+ iExists emp%I. iSplitL; first by iNext.
+ iIntros "!# >_". done.
+ Qed.
+
+ Global Instance sep_laterable P Q :
+ Laterable P → Laterable Q → Laterable (P ∗ Q).
+ Proof.
+ rewrite /Laterable. iIntros (LP LQ) "[HP HQ]".
+ iDestruct (LP with "HP") as (P') "[HP' #HP]".
+ iDestruct (LQ with "HQ") as (Q') "[HQ' #HQ]".
+ iExists (P' ∗ Q')%I. iSplitL; first by iFrame.
+ iIntros "!# [HP' HQ']". iSplitL "HP'".
+ - iApply "HP". done.
+ - iApply "HQ". done.
+ Qed.
+
+ Global Instance big_sepL_laterable Ps :
+ Timeless (PROP:=PROP) emp →
+ TCForall Laterable Ps →
+ Laterable ([∗] Ps).
+ Proof. induction 2; simpl; apply _. Qed.
+End instances.
diff --git a/theories/bi/monpred.v b/theories/bi/monpred.v
new file mode 100644
index 0000000000000000000000000000000000000000..2a25581675dd91c329f44d53811c2096408b0a5b
--- /dev/null
+++ b/theories/bi/monpred.v
@@ -0,0 +1,975 @@
+From stdpp Require Import coPset.
+From iris.bi Require Import bi.
+
+(** Definitions. *)
+Structure biIndex :=
+ BiIndex
+ { bi_index_type :> Type;
+ bi_index_inhabited : Inhabited bi_index_type;
+ bi_index_rel : SqSubsetEq bi_index_type;
+ bi_index_rel_preorder : PreOrder (⊑) }.
+Existing Instances bi_index_inhabited bi_index_rel bi_index_rel_preorder.
+
+(* We may want to instantiate monPred with the reflexivity relation in
+ the case where there is no relevent order. In that case, there is
+ no bottom element, so that we do not want to force any BI index to
+ have one. *)
+Class BiIndexBottom {I : biIndex} (bot : I) :=
+ bi_index_bot i : bot ⊑ i.
+
+Section Ofe_Cofe.
+Context {I : biIndex} {PROP : bi}.
+Implicit Types i : I.
+
+Record monPred :=
+ MonPred { monPred_at :> I → PROP;
+ monPred_mono : Proper ((⊑) ==> (⊢)) monPred_at }.
+Local Existing Instance monPred_mono.
+
+Bind Scope monPred with bi.
+
+Implicit Types P Q : monPred.
+
+(** Ofe + Cofe instances *)
+
+Section Ofe_Cofe_def.
+ Inductive monPred_equiv' P Q : Prop :=
+ { monPred_in_equiv i : P i ≡ Q i } .
+ Instance monPred_equiv : Equiv monPred := monPred_equiv'.
+ Inductive monPred_dist' (n : nat) (P Q : monPred) : Prop :=
+ { monPred_in_dist i : P i ≡{n}≡ Q i }.
+ Instance monPred_dist : Dist monPred := monPred_dist'.
+
+ Definition monPred_sig P : { f : I -c> PROP | Proper ((⊑) ==> (⊢)) f } :=
+ exist _ (monPred_at P) (monPred_mono P).
+
+ Definition sig_monPred (P' : { f : I -c> PROP | Proper ((⊑) ==> (⊢)) f })
+ : monPred :=
+ MonPred (proj1_sig P') (proj2_sig P').
+
+ (* These two lemma use the wrong Equiv and Dist instance for
+ monPred. so we make sure they are not accessible outside of the
+ section by using Let. *)
+ Let monPred_sig_equiv:
+ ∀ P Q, P ≡ Q ↔ monPred_sig P ≡ monPred_sig Q.
+ Proof. by split; [intros []|]. Qed.
+ Let monPred_sig_dist:
+ ∀ n, ∀ P Q : monPred, P ≡{n}≡ Q ↔ monPred_sig P ≡{n}≡ monPred_sig Q.
+ Proof. by split; [intros []|]. Qed.
+
+ Definition monPred_ofe_mixin : OfeMixin monPred.
+ Proof. by apply (iso_ofe_mixin monPred_sig monPred_sig_equiv monPred_sig_dist). Qed.
+
+ Canonical Structure monPredC := OfeT monPred monPred_ofe_mixin.
+
+ Global Instance monPred_cofe `{Cofe PROP} : Cofe monPredC.
+ Proof.
+ unshelve refine (iso_cofe_subtype (A:=I-c>PROP) _ MonPred monPred_at _ _ _);
+ [apply _|by apply monPred_sig_dist|done|].
+ intros c i j Hij. apply @limit_preserving;
+ [by apply bi.limit_preserving_entails; intros ??|]=>n. by rewrite Hij.
+ Qed.
+End Ofe_Cofe_def.
+
+Lemma monPred_sig_monPred (P' : { f : I -c> PROP | Proper ((⊑) ==> (⊢)) f }) :
+ monPred_sig (sig_monPred P') ≡ P'.
+Proof. by change (P' ≡ P'). Qed.
+Lemma sig_monPred_sig P : sig_monPred (monPred_sig P) ≡ P.
+Proof. done. Qed.
+
+Global Instance monPred_sig_ne : NonExpansive monPred_sig.
+Proof. move=> ??? [?] ? //=. Qed.
+Global Instance monPred_sig_proper : Proper ((≡) ==> (≡)) monPred_sig.
+Proof. eapply (ne_proper _). Qed.
+Global Instance sig_monPred_ne : NonExpansive (@sig_monPred).
+Proof. split=>? //=. Qed.
+Global Instance sig_monPred_proper : Proper ((≡) ==> (≡)) sig_monPred.
+Proof. eapply (ne_proper _). Qed.
+
+(* We generalize over the relation R which is morally the equivalence
+ relation over B. That way, the BI index can use equality as an
+ equivalence relation (and Coq is able to infer the Proper and
+ Reflexive instances properly), or any other equivalence relation,
+ provided it is compatible with (⊑). *)
+Global Instance monPred_at_ne (R : relation I) :
+ Proper (R ==> R ==> iff) (⊑) → Reflexive R →
+ ∀ n, Proper (dist n ==> R ==> dist n) monPred_at.
+Proof.
+ intros ????? [Hd] ?? HR. rewrite Hd.
+ apply equiv_dist, bi.equiv_spec; split; f_equiv; rewrite ->HR; done.
+Qed.
+Global Instance monPred_at_proper (R : relation I) :
+ Proper (R ==> R ==> iff) (⊑) → Reflexive R →
+ Proper ((≡) ==> R ==> (≡)) monPred_at.
+Proof. repeat intro. apply equiv_dist=>?. f_equiv=>//. by apply equiv_dist. Qed.
+End Ofe_Cofe.
+
+Arguments monPred _ _ : clear implicits.
+Arguments monPred_at {_ _} _%I _.
+Local Existing Instance monPred_mono.
+Arguments monPredC _ _ : clear implicits.
+
+(** BI and SBI structures. *)
+
+Section Bi.
+Context {I : biIndex} {PROP : bi}.
+Implicit Types i : I.
+Notation monPred := (monPred I PROP).
+Implicit Types P Q : monPred.
+
+Inductive monPred_entails (P1 P2 : monPred) : Prop :=
+ { monPred_in_entails i : P1 i ⊢ P2 i }.
+Hint Immediate monPred_in_entails.
+
+Program Definition monPred_upclosed (Φ : I → PROP) : monPred :=
+ MonPred (λ i, (∀ j, ⌜i ⊑ j⌠→ Φ j)%I) _.
+Next Obligation. solve_proper. Qed.
+
+Definition monPred_embed_def (P : PROP) : monPred := MonPred (λ _, P) _.
+Definition monPred_embed_aux : seal (@monPred_embed_def). by eexists. Qed.
+Definition monPred_embed : Embed PROP monPred := monPred_embed_aux.(unseal).
+Definition monPred_embed_eq : @embed _ _ monPred_embed = _ := monPred_embed_aux.(seal_eq).
+
+Definition monPred_emp_def : monPred := MonPred (λ _, emp)%I _.
+Definition monPred_emp_aux : seal (@monPred_emp_def). by eexists. Qed.
+Definition monPred_emp := monPred_emp_aux.(unseal).
+Definition monPred_emp_eq : @monPred_emp = _ := monPred_emp_aux.(seal_eq).
+
+Definition monPred_pure_def (φ : Prop) : monPred := MonPred (λ _, ⌜φâŒ)%I _.
+Definition monPred_pure_aux : seal (@monPred_pure_def). by eexists. Qed.
+Definition monPred_pure := monPred_pure_aux.(unseal).
+Definition monPred_pure_eq : @monPred_pure = _ := monPred_pure_aux.(seal_eq).
+
+Definition monPred_objectively_def P : monPred := MonPred (λ _, ∀ i, P i)%I _.
+Definition monPred_objectively_aux : seal (@monPred_objectively_def). by eexists. Qed.
+Definition monPred_objectively := monPred_objectively_aux.(unseal).
+Definition monPred_objectively_eq : @monPred_objectively = _ := monPred_objectively_aux.(seal_eq).
+
+Definition monPred_subjectively_def P : monPred := MonPred (λ _, ∃ i, P i)%I _.
+Definition monPred_subjectively_aux : seal (@monPred_subjectively_def). by eexists. Qed.
+Definition monPred_subjectively := monPred_subjectively_aux.(unseal).
+Definition monPred_subjectively_eq : @monPred_subjectively = _ := monPred_subjectively_aux.(seal_eq).
+
+Program Definition monPred_and_def P Q : monPred :=
+ MonPred (λ i, P i ∧ Q i)%I _.
+Next Obligation. solve_proper. Qed.
+Definition monPred_and_aux : seal (@monPred_and_def). by eexists. Qed.
+Definition monPred_and := monPred_and_aux.(unseal).
+Definition monPred_and_eq : @monPred_and = _ := monPred_and_aux.(seal_eq).
+
+Program Definition monPred_or_def P Q : monPred :=
+ MonPred (λ i, P i ∨ Q i)%I _.
+Next Obligation. solve_proper. Qed.
+Definition monPred_or_aux : seal (@monPred_or_def). by eexists. Qed.
+Definition monPred_or := monPred_or_aux.(unseal).
+Definition monPred_or_eq : @monPred_or = _ := monPred_or_aux.(seal_eq).
+
+Definition monPred_impl_def P Q : monPred :=
+ monPred_upclosed (λ i, P i → Q i)%I.
+Definition monPred_impl_aux : seal (@monPred_impl_def). by eexists. Qed.
+Definition monPred_impl := monPred_impl_aux.(unseal).
+Definition monPred_impl_eq : @monPred_impl = _ := monPred_impl_aux.(seal_eq).
+
+Program Definition monPred_forall_def A (Φ : A → monPred) : monPred :=
+ MonPred (λ i, ∀ x : A, Φ x i)%I _.
+Next Obligation. solve_proper. Qed.
+Definition monPred_forall_aux : seal (@monPred_forall_def). by eexists. Qed.
+Definition monPred_forall := monPred_forall_aux.(unseal).
+Definition monPred_forall_eq : @monPred_forall = _ := monPred_forall_aux.(seal_eq).
+
+Program Definition monPred_exist_def A (Φ : A → monPred) : monPred :=
+ MonPred (λ i, ∃ x : A, Φ x i)%I _.
+Next Obligation. solve_proper. Qed.
+Definition monPred_exist_aux : seal (@monPred_exist_def). by eexists. Qed.
+Definition monPred_exist := monPred_exist_aux.(unseal).
+Definition monPred_exist_eq : @monPred_exist = _ := monPred_exist_aux.(seal_eq).
+
+Program Definition monPred_sep_def P Q : monPred :=
+ MonPred (λ i, P i ∗ Q i)%I _.
+Next Obligation. solve_proper. Qed.
+Definition monPred_sep_aux : seal (@monPred_sep_def). by eexists. Qed.
+Definition monPred_sep := monPred_sep_aux.(unseal).
+Definition monPred_sep_eq : @monPred_sep = _ := monPred_sep_aux.(seal_eq).
+
+Definition monPred_wand_def P Q : monPred :=
+ monPred_upclosed (λ i, P i -∗ Q i)%I.
+Definition monPred_wand_aux : seal (@monPred_wand_def). by eexists. Qed.
+Definition monPred_wand := monPred_wand_aux.(unseal).
+Definition monPred_wand_eq : @monPred_wand = _ := monPred_wand_aux.(seal_eq).
+
+Program Definition monPred_persistently_def P : monPred :=
+ MonPred (λ i, <pers> (P i))%I _.
+Next Obligation. solve_proper. Qed.
+Definition monPred_persistently_aux : seal (@monPred_persistently_def). by eexists. Qed.
+Definition monPred_persistently := monPred_persistently_aux.(unseal).
+Definition monPred_persistently_eq : @monPred_persistently = _ := monPred_persistently_aux.(seal_eq).
+
+Program Definition monPred_in_def (i0 : I) : monPred :=
+ MonPred (λ i : I, ⌜i0 ⊑ iâŒ%I) _.
+Next Obligation. solve_proper. Qed.
+Definition monPred_in_aux : seal (@monPred_in_def). by eexists. Qed.
+Definition monPred_in := monPred_in_aux.(unseal).
+Definition monPred_in_eq : @monPred_in = _ := monPred_in_aux.(seal_eq).
+End Bi.
+
+Arguments monPred_objectively {_ _} _%I.
+Arguments monPred_subjectively {_ _} _%I.
+Notation "'<obj>' P" := (monPred_objectively P) : bi_scope.
+Notation "'<subj>' P" := (monPred_subjectively P) : bi_scope.
+
+Section Sbi.
+Context {I : biIndex} {PROP : sbi}.
+Implicit Types i : I.
+Notation monPred := (monPred I PROP).
+Implicit Types P Q : monPred.
+
+Definition monPred_internal_eq_def (A : ofeT) (a b : A) : monPred :=
+ MonPred (λ _, a ≡ b)%I _.
+Definition monPred_internal_eq_aux : seal (@monPred_internal_eq_def). by eexists. Qed.
+Definition monPred_internal_eq := monPred_internal_eq_aux.(unseal).
+Definition monPred_internal_eq_eq : @monPred_internal_eq = _ :=
+ monPred_internal_eq_aux.(seal_eq).
+
+Program Definition monPred_later_def P : monPred := MonPred (λ i, ▷ (P i))%I _.
+Next Obligation. solve_proper. Qed.
+Definition monPred_later_aux : seal monPred_later_def. by eexists. Qed.
+Definition monPred_later := monPred_later_aux.(unseal).
+Definition monPred_later_eq : monPred_later = _ := monPred_later_aux.(seal_eq).
+End Sbi.
+
+Module MonPred.
+Definition unseal_eqs :=
+ (@monPred_and_eq, @monPred_or_eq, @monPred_impl_eq,
+ @monPred_forall_eq, @monPred_exist_eq, @monPred_sep_eq, @monPred_wand_eq,
+ @monPred_persistently_eq, @monPred_later_eq, @monPred_internal_eq_eq, @monPred_in_eq,
+ @monPred_embed_eq, @monPred_emp_eq, @monPred_pure_eq,
+ @monPred_objectively_eq, @monPred_subjectively_eq).
+Ltac unseal :=
+ unfold bi_affinely, bi_absorbingly, sbi_except_0, bi_pure, bi_emp,
+ monPred_upclosed, bi_and, bi_or,
+ bi_impl, bi_forall, bi_exist, sbi_internal_eq, bi_sep, bi_wand,
+ bi_persistently, bi_affinely, sbi_later;
+ simpl;
+ unfold sbi_emp, sbi_pure, sbi_and, sbi_or, sbi_impl, sbi_forall, sbi_exist,
+ sbi_internal_eq, sbi_sep, sbi_wand, sbi_persistently;
+ simpl;
+ rewrite !unseal_eqs /=.
+End MonPred.
+Import MonPred.
+
+Section canonical_bi.
+Context (I : biIndex) (PROP : bi).
+
+Lemma monPred_bi_mixin : BiMixin (PROP:=monPred I PROP)
+ monPred_entails monPred_emp monPred_pure monPred_and monPred_or
+ monPred_impl monPred_forall monPred_exist monPred_sep monPred_wand
+ monPred_persistently.
+Proof.
+ split; try unseal; try by (split=> ? /=; repeat f_equiv).
+ - split.
+ + intros P. by split.
+ + intros P Q R [H1] [H2]. split => ?. by rewrite H1 H2.
+ - split.
+ + intros [HPQ]. split; split => i; move: (HPQ i); by apply bi.equiv_spec.
+ + intros [[] []]. split=>i. by apply bi.equiv_spec.
+ - intros P φ ?. split=> i. by apply bi.pure_intro.
+ - intros φ P HP. split=> i. apply bi.pure_elim'=> ?. by apply HP.
+ - intros A φ. split=> i. by apply bi.pure_forall_2.
+ - intros P Q. split=> i. by apply bi.and_elim_l.
+ - intros P Q. split=> i. by apply bi.and_elim_r.
+ - intros P Q R [?] [?]. split=> i. by apply bi.and_intro.
+ - intros P Q. split=> i. by apply bi.or_intro_l.
+ - intros P Q. split=> i. by apply bi.or_intro_r.
+ - intros P Q R [?] [?]. split=> i. by apply bi.or_elim.
+ - intros P Q R [HR]. split=> i /=. setoid_rewrite bi.pure_impl_forall.
+ apply bi.forall_intro=> j. apply bi.forall_intro=> Hij.
+ apply bi.impl_intro_r. by rewrite -HR /= !Hij.
+ - intros P Q R [HR]. split=> i /=.
+ rewrite HR /= bi.forall_elim bi.pure_impl_forall bi.forall_elim //.
+ apply bi.impl_elim_l.
+ - intros A P Ψ HΨ. split=> i. apply bi.forall_intro => ?. by apply HΨ.
+ - intros A Ψ. split=> i. by apply: bi.forall_elim.
+ - intros A Ψ a. split=> i. by rewrite /= -bi.exist_intro.
+ - intros A Ψ Q HΨ. split=> i. apply bi.exist_elim => a. by apply HΨ.
+ - intros P P' Q Q' [?] [?]. split=> i. by apply bi.sep_mono.
+ - intros P. split=> i. by apply bi.emp_sep_1.
+ - intros P. split=> i. by apply bi.emp_sep_2.
+ - intros P Q. split=> i. by apply bi.sep_comm'.
+ - intros P Q R. split=> i. by apply bi.sep_assoc'.
+ - intros P Q R [HR]. split=> i /=. setoid_rewrite bi.pure_impl_forall.
+ apply bi.forall_intro=> j. apply bi.forall_intro=> Hij.
+ apply bi.wand_intro_r. by rewrite -HR /= !Hij.
+ - intros P Q R [HP]. split=> i. apply bi.wand_elim_l'.
+ rewrite HP /= bi.forall_elim bi.pure_impl_forall bi.forall_elim //.
+ - intros P Q [?]. split=> i /=. by f_equiv.
+ - intros P. split=> i. by apply bi.persistently_idemp_2.
+ - split=> i. by apply bi.persistently_emp_intro.
+ - intros A Ψ. split=> i. by apply bi.persistently_forall_2.
+ - intros A Ψ. split=> i. by apply bi.persistently_exist_1.
+ - intros P Q. split=> i. apply bi.sep_elim_l, _.
+ - intros P Q. split=> i. by apply bi.persistently_and_sep_elim.
+Qed.
+
+Canonical Structure monPredI : bi :=
+ {| bi_ofe_mixin := monPred_ofe_mixin; bi_bi_mixin := monPred_bi_mixin |}.
+End canonical_bi.
+
+Section canonical_sbi.
+Context (I : biIndex) (PROP : sbi).
+
+Lemma monPred_sbi_mixin :
+ SbiMixin (PROP:=monPred I PROP) monPred_entails monPred_pure
+ monPred_or monPred_impl monPred_forall monPred_exist
+ monPred_sep monPred_persistently monPred_internal_eq monPred_later.
+Proof.
+ split; unseal.
+ - intros n P Q HPQ. split=> i /=.
+ apply bi.later_contractive. destruct n as [|n]=> //. by apply HPQ.
+ - by split=> ? /=; repeat f_equiv.
+ - intros A P a. split=> i. by apply bi.internal_eq_refl.
+ - intros A a b Ψ ?. split=> i /=.
+ setoid_rewrite bi.pure_impl_forall. do 2 apply bi.forall_intro => ?.
+ erewrite (bi.internal_eq_rewrite _ _ (flip Ψ _)) => //=. solve_proper.
+ - intros A1 A2 f g. split=> i. by apply bi.fun_ext.
+ - intros A P x y. split=> i. by apply bi.sig_eq.
+ - intros A a b ?. split=> i. by apply bi.discrete_eq_1.
+ - intros A x y. split=> i. by apply bi.later_eq_1.
+ - intros A x y. split=> i. by apply bi.later_eq_2.
+ - intros P Q [?]. split=> i. by apply bi.later_mono.
+ - intros P. split=> i /=. by apply bi.later_intro.
+ - intros A Ψ. split=> i. by apply bi.later_forall_2.
+ - intros A Ψ. split=> i. by apply bi.later_exist_false.
+ - intros P Q. split=> i. by apply bi.later_sep_1.
+ - intros P Q. split=> i. by apply bi.later_sep_2.
+ - intros P. split=> i. by apply bi.later_persistently_1.
+ - intros P. split=> i. by apply bi.later_persistently_2.
+ - intros P. split=> i /=. rewrite -bi.forall_intro. apply bi.later_false_em.
+ intros j. rewrite bi.pure_impl_forall. apply bi.forall_intro=> Hij. by rewrite Hij.
+Qed.
+
+Canonical Structure monPredSI : sbi :=
+ {| sbi_ofe_mixin := monPred_ofe_mixin; sbi_bi_mixin := monPred_bi_mixin I PROP;
+ sbi_sbi_mixin := monPred_sbi_mixin |}.
+End canonical_sbi.
+
+Class Objective {I : biIndex} {PROP : bi} (P : monPred I PROP) :=
+ objective_at i j : P i -∗ P j.
+Arguments Objective {_ _} _%I.
+Arguments objective_at {_ _} _%I {_}.
+Hint Mode Objective + + ! : typeclass_instances.
+Instance: Params (@Objective) 2.
+
+(** Primitive facts that cannot be deduced from the BI structure. *)
+
+Section bi_facts.
+Context {I : biIndex} {PROP : bi}.
+Local Notation monPred := (monPred I PROP).
+Local Notation monPredI := (monPredI I PROP).
+Local Notation monPred_at := (@monPred_at I PROP).
+Local Notation BiIndexBottom := (@BiIndexBottom I).
+Implicit Types i : I.
+Implicit Types P Q : monPred.
+
+(** Instances *)
+Global Instance monPred_at_mono :
+ Proper ((⊢) ==> (⊑) ==> (⊢)) monPred_at.
+Proof. by move=> ?? [?] ?? ->. Qed.
+Global Instance monPred_at_flip_mono :
+ Proper (flip (⊢) ==> flip (⊑) ==> flip (⊢)) monPred_at.
+Proof. solve_proper. Qed.
+
+Global Instance monPred_in_proper (R : relation I) :
+ Proper (R ==> R ==> iff) (⊑) → Reflexive R →
+ Proper (R ==> (≡)) (@monPred_in I PROP).
+Proof. unseal. split. solve_proper. Qed.
+Global Instance monPred_in_mono : Proper (flip (⊑) ==> (⊢)) (@monPred_in I PROP).
+Proof. unseal. split. solve_proper. Qed.
+Global Instance monPred_in_flip_mono : Proper ((⊑) ==> flip (⊢)) (@monPred_in I PROP).
+Proof. solve_proper. Qed.
+
+Global Instance monPred_positive : BiPositive PROP → BiPositive monPredI.
+Proof. split => ?. unseal. apply bi_positive. Qed.
+Global Instance monPred_affine : BiAffine PROP → BiAffine monPredI.
+Proof. split => ?. unseal. by apply affine. Qed.
+
+Global Instance monPred_at_persistent P i : Persistent P → Persistent (P i).
+Proof. move => [] /(_ i). by unseal. Qed.
+Global Instance monPred_at_absorbing P i : Absorbing P → Absorbing (P i).
+Proof. move => [] /(_ i). unfold Absorbing. by unseal. Qed.
+Global Instance monPred_at_affine P i : Affine P → Affine (P i).
+Proof. move => [] /(_ i). unfold Affine. by unseal. Qed.
+
+(* Note that monPred_in is *not* Plain, because it does depend on the
+ index. *)
+Global Instance monPred_in_persistent i :
+ Persistent (@monPred_in I PROP i).
+Proof. unfold Persistent. unseal; split => ?. by apply bi.pure_persistent. Qed.
+Global Instance monPred_in_absorbing i :
+ Absorbing (@monPred_in I PROP i).
+Proof. unfold Absorbing. unseal. split=> ? /=. apply absorbing, _. Qed.
+
+Definition monPred_embedding_mixin : BiEmbedMixin PROP monPredI monPred_embed.
+Proof.
+ split; try apply _; rewrite /bi_emp_valid; unseal; try done.
+ - move=> P /= [/(_ inhabitant) ?] //.
+ - intros P Q. split=> i /=.
+ by rewrite bi.forall_elim bi.pure_impl_forall bi.forall_elim.
+ - intros P Q. split=> i /=.
+ by rewrite bi.forall_elim bi.pure_impl_forall bi.forall_elim.
+Qed.
+Global Instance monPred_bi_embed : BiEmbed PROP monPredI :=
+ {| bi_embed_mixin := monPred_embedding_mixin |}.
+Global Instance monPred_bi_embed_emp : BiEmbedEmp PROP monPredI.
+Proof. split. by unseal. Qed.
+
+Lemma monPred_emp_unfold : emp%I = ⎡emp : PROP⎤%I.
+Proof. by unseal. Qed.
+Lemma monPred_pure_unfold : bi_pure = λ φ, ⎡ ⌜ φ ⌠: PROP⎤%I.
+Proof. by unseal. Qed.
+Lemma monPred_objectively_unfold : monPred_objectively = λ P, ⎡∀ i, P i⎤%I.
+Proof. by unseal. Qed.
+Lemma monPred_subjectively_unfold : monPred_subjectively = λ P, ⎡∃ i, P i⎤%I.
+Proof. by unseal. Qed.
+
+Global Instance monPred_objectively_ne : NonExpansive (@monPred_objectively I PROP).
+Proof. rewrite monPred_objectively_unfold. solve_proper. Qed.
+Global Instance monPred_objectively_proper : Proper ((≡) ==> (≡)) (@monPred_objectively I PROP).
+Proof. apply (ne_proper _). Qed.
+Lemma monPred_objectively_mono P Q : (P ⊢ Q) → (<obj> P ⊢ <obj> Q).
+Proof. rewrite monPred_objectively_unfold. solve_proper. Qed.
+Global Instance monPred_objectively_mono' : Proper ((⊢) ==> (⊢)) (@monPred_objectively I PROP).
+Proof. intros ???. by apply monPred_objectively_mono. Qed.
+Global Instance monPred_objectively_flip_mono' :
+ Proper (flip (⊢) ==> flip (⊢)) (@monPred_objectively I PROP).
+Proof. intros ???. by apply monPred_objectively_mono. Qed.
+
+Global Instance monPred_objectively_persistent P : Persistent P → Persistent (<obj> P).
+Proof. rewrite monPred_objectively_unfold. apply _. Qed.
+Global Instance monPred_objectively_absorbing P : Absorbing P → Absorbing (<obj> P).
+Proof. rewrite monPred_objectively_unfold. apply _. Qed.
+Global Instance monPred_objectively_affine P : Affine P → Affine (<obj> P).
+Proof. rewrite monPred_objectively_unfold. apply _. Qed.
+
+Global Instance monPred_subjectively_ne : NonExpansive (@monPred_subjectively I PROP).
+Proof. rewrite monPred_subjectively_unfold. solve_proper. Qed.
+Global Instance monPred_subjectively_proper : Proper ((≡) ==> (≡)) (@monPred_subjectively I PROP).
+Proof. apply (ne_proper _). Qed.
+Lemma monPred_subjectively_mono P Q : (P ⊢ Q) → <subj> P ⊢ <subj> Q.
+Proof. rewrite monPred_subjectively_unfold. solve_proper. Qed.
+Global Instance monPred_subjectively_mono' : Proper ((⊢) ==> (⊢)) (@monPred_subjectively I PROP).
+Proof. intros ???. by apply monPred_subjectively_mono. Qed.
+Global Instance monPred_subjectively_flip_mono' :
+ Proper (flip (⊢) ==> flip (⊢)) (@monPred_subjectively I PROP).
+Proof. intros ???. by apply monPred_subjectively_mono. Qed.
+
+Global Instance monPred_subjectively_persistent P : Persistent P → Persistent (<subj> P).
+Proof. rewrite monPred_subjectively_unfold. apply _. Qed.
+Global Instance monPred_subjectively_absorbing P : Absorbing P → Absorbing (<subj> P).
+Proof. rewrite monPred_subjectively_unfold. apply _. Qed.
+Global Instance monPred_subjectively_affine P : Affine P → Affine (<subj> P).
+Proof. rewrite monPred_subjectively_unfold. apply _. Qed.
+
+(** monPred_at unfolding laws *)
+Lemma monPred_at_embed i (P : PROP) : monPred_at ⎡P⎤ i ⊣⊢ P.
+Proof. by unseal. Qed.
+Lemma monPred_at_pure i (φ : Prop) : monPred_at ⌜φ⌠i ⊣⊢ ⌜φâŒ.
+Proof. by unseal. Qed.
+Lemma monPred_at_emp i : monPred_at emp i ⊣⊢ emp.
+Proof. by unseal. Qed.
+Lemma monPred_at_and i P Q : (P ∧ Q) i ⊣⊢ P i ∧ Q i.
+Proof. by unseal. Qed.
+Lemma monPred_at_or i P Q : (P ∨ Q) i ⊣⊢ P i ∨ Q i.
+Proof. by unseal. Qed.
+Lemma monPred_at_impl i P Q : (P → Q) i ⊣⊢ ∀ j, ⌜i ⊑ j⌠→ P j → Q j.
+Proof. by unseal. Qed.
+Lemma monPred_at_forall {A} i (Φ : A → monPred) : (∀ x, Φ x) i ⊣⊢ ∀ x, Φ x i.
+Proof. by unseal. Qed.
+Lemma monPred_at_exist {A} i (Φ : A → monPred) : (∃ x, Φ x) i ⊣⊢ ∃ x, Φ x i.
+Proof. by unseal. Qed.
+Lemma monPred_at_sep i P Q : (P ∗ Q) i ⊣⊢ P i ∗ Q i.
+Proof. by unseal. Qed.
+Lemma monPred_at_wand i P Q : (P -∗ Q) i ⊣⊢ ∀ j, ⌜i ⊑ j⌠→ P j -∗ Q j.
+Proof. by unseal. Qed.
+Lemma monPred_at_persistently i P : (<pers> P) i ⊣⊢ <pers> (P i).
+Proof. by unseal. Qed.
+Lemma monPred_at_in i j : monPred_at (monPred_in j) i ⊣⊢ ⌜j ⊑ iâŒ.
+Proof. by unseal. Qed.
+Lemma monPred_at_objectively i P : (<obj> P) i ⊣⊢ ∀ j, P j.
+Proof. by unseal. Qed.
+Lemma monPred_at_subjectively i P : (<subj> P) i ⊣⊢ ∃ j, P j.
+Proof. by unseal. Qed.
+Lemma monPred_at_persistently_if i p P : (<pers>?p P) i ⊣⊢ <pers>?p (P i).
+Proof. destruct p=>//=. apply monPred_at_persistently. Qed.
+Lemma monPred_at_affinely i P : (<affine> P) i ⊣⊢ <affine> (P i).
+Proof. by rewrite /bi_affinely monPred_at_and monPred_at_emp. Qed.
+Lemma monPred_at_affinely_if i p P : (<affine>?p P) i ⊣⊢ <affine>?p (P i).
+Proof. destruct p=>//=. apply monPred_at_affinely. Qed.
+Lemma monPred_at_intuitionistically i P : (□ P) i ⊣⊢ □ (P i).
+Proof. by rewrite /bi_intuitionistically monPred_at_affinely monPred_at_persistently. Qed.
+Lemma monPred_at_intuitionistically_if i p P : (□?p P) i ⊣⊢ □?p (P i).
+Proof. destruct p=>//=. apply monPred_at_intuitionistically. Qed.
+
+Lemma monPred_at_absorbingly i P : (<absorb> P) i ⊣⊢ <absorb> (P i).
+Proof. by rewrite /bi_absorbingly monPred_at_sep monPred_at_pure. Qed.
+
+Lemma monPred_wand_force i P Q : (P -∗ Q) i -∗ (P i -∗ Q i).
+Proof. unseal. rewrite bi.forall_elim bi.pure_impl_forall bi.forall_elim //. Qed.
+Lemma monPred_impl_force i P Q : (P → Q) i -∗ (P i → Q i).
+Proof. unseal. rewrite bi.forall_elim bi.pure_impl_forall bi.forall_elim //. Qed.
+
+(* Laws for monPred_objectively and of Objective. *)
+Lemma monPred_objectively_elim P : <obj> P ⊢ P.
+Proof. rewrite monPred_objectively_unfold. unseal. split=>?. apply bi.forall_elim. Qed.
+Lemma monPred_objectively_idemp P : <obj> <obj> P ⊣⊢ <obj> P.
+Proof.
+ apply bi.equiv_spec; split; [by apply monPred_objectively_elim|].
+ unseal. split=>i /=. by apply bi.forall_intro=>_.
+Qed.
+
+Lemma monPred_objectively_forall {A} (Φ : A → monPred) : <obj> (∀ x, Φ x) ⊣⊢ ∀ x, <obj> (Φ x).
+Proof.
+ unseal. split=>i. apply bi.equiv_spec; split=>/=;
+ do 2 apply bi.forall_intro=>?; by do 2 rewrite bi.forall_elim.
+Qed.
+Lemma monPred_objectively_and P Q : <obj> (P ∧ Q) ⊣⊢ <obj> P ∧ <obj> Q.
+Proof.
+ unseal. split=>i. apply bi.equiv_spec; split=>/=.
+ - apply bi.and_intro; do 2 f_equiv. apply bi.and_elim_l. apply bi.and_elim_r.
+ - apply bi.forall_intro=>?. by rewrite !bi.forall_elim.
+Qed.
+Lemma monPred_objectively_exist {A} (Φ : A → monPred) :
+ (∃ x, <obj> (Φ x)) ⊢ <obj> (∃ x, (Φ x)).
+Proof. apply bi.exist_elim=>?. f_equiv. apply bi.exist_intro. Qed.
+Lemma monPred_objectively_or P Q : <obj> P ∨ <obj> Q ⊢ <obj> (P ∨ Q).
+Proof. apply bi.or_elim; f_equiv. apply bi.or_intro_l. apply bi.or_intro_r. Qed.
+
+Lemma monPred_objectively_sep_2 P Q : <obj> P ∗ <obj> Q ⊢ <obj> (P ∗ Q).
+Proof. unseal. split=>i /=. apply bi.forall_intro=>?. by rewrite !bi.forall_elim. Qed.
+Lemma monPred_objectively_sep `{BiIndexBottom bot} P Q : <obj> (P ∗ Q) ⊣⊢ <obj> P ∗ <obj> Q.
+Proof.
+ apply bi.equiv_spec, conj, monPred_objectively_sep_2. unseal. split=>i /=.
+ rewrite (bi.forall_elim bot). by f_equiv; apply bi.forall_intro=>j; f_equiv.
+Qed.
+Lemma monPred_objectively_embed (P : PROP) : <obj> ⎡P⎤ ⊣⊢ ⎡P⎤.
+Proof.
+ apply bi.equiv_spec; split; unseal; split=>i /=.
+ by rewrite (bi.forall_elim inhabitant). by apply bi.forall_intro.
+Qed.
+Lemma monPred_objectively_emp : <obj> (emp : monPred) ⊣⊢ emp.
+Proof. rewrite monPred_emp_unfold. apply monPred_objectively_embed. Qed.
+Lemma monPred_objectively_pure φ : <obj> (⌜ φ ⌠: monPred) ⊣⊢ ⌜ φ âŒ.
+Proof. rewrite monPred_pure_unfold. apply monPred_objectively_embed. Qed.
+
+Lemma monPred_subjectively_intro P : P ⊢ <subj> P.
+Proof. unseal. split=>?. apply bi.exist_intro. Qed.
+
+Lemma monPred_subjectively_forall {A} (Φ : A → monPred) :
+ (<subj> (∀ x, Φ x)) ⊢ ∀ x, <subj> (Φ x).
+Proof. apply bi.forall_intro=>?. f_equiv. apply bi.forall_elim. Qed.
+Lemma monPred_subjectively_and P Q : <subj> (P ∧ Q) ⊢ <subj> P ∧ <subj> Q.
+Proof. apply bi.and_intro; f_equiv. apply bi.and_elim_l. apply bi.and_elim_r. Qed.
+Lemma monPred_subjectively_exist {A} (Φ : A → monPred) : <subj> (∃ x, Φ x) ⊣⊢ ∃ x, <subj> (Φ x).
+Proof.
+ unseal. split=>i. apply bi.equiv_spec; split=>/=;
+ do 2 apply bi.exist_elim=>?; by do 2 rewrite -bi.exist_intro.
+Qed.
+Lemma monPred_subjectively_or P Q : <subj> (P ∨ Q) ⊣⊢ <subj> P ∨ <subj> Q.
+Proof.
+ unseal. split=>i. apply bi.equiv_spec; split=>/=.
+ - apply bi.exist_elim=>?. by rewrite -!bi.exist_intro.
+ - apply bi.or_elim; do 2 f_equiv. apply bi.or_intro_l. apply bi.or_intro_r.
+Qed.
+
+Lemma monPred_subjectively_sep P Q : <subj> (P ∗ Q) ⊢ <subj> P ∗ <subj> Q.
+Proof. unseal. split=>i /=. apply bi.exist_elim=>?. by rewrite -!bi.exist_intro. Qed.
+
+Lemma monPred_subjectively_idemp P : <subj> <subj> P ⊣⊢ <subj> P.
+Proof.
+ apply bi.equiv_spec; split; [|by apply monPred_subjectively_intro].
+ unseal. split=>i /=. by apply bi.exist_elim=>_.
+Qed.
+
+Lemma objective_objectively P `{!Objective P} : P ⊢ <obj> P.
+Proof.
+ rewrite monPred_objectively_unfold /= embed_forall. apply bi.forall_intro=>?.
+ split=>?. unseal. apply objective_at, _.
+Qed.
+Lemma objective_subjectively P `{!Objective P} : <subj> P ⊢ P.
+Proof.
+ rewrite monPred_subjectively_unfold /= embed_exist. apply bi.exist_elim=>?.
+ split=>?. unseal. apply objective_at, _.
+Qed.
+
+Global Instance embed_objective (P : PROP) : @Objective I PROP ⎡P⎤.
+Proof. intros ??. by unseal. Qed.
+Global Instance pure_objective φ : @Objective I PROP ⌜φâŒ.
+Proof. intros ??. by unseal. Qed.
+Global Instance emp_objective : @Objective I PROP emp.
+Proof. intros ??. by unseal. Qed.
+Global Instance objectively_objective P : Objective (<obj> P).
+Proof. intros ??. by unseal. Qed.
+Global Instance subjectively_objective P : Objective (<subj> P).
+Proof. intros ??. by unseal. Qed.
+
+Global Instance and_objective P Q `{!Objective P, !Objective Q} : Objective (P ∧ Q).
+Proof. intros i j. unseal. by rewrite !(objective_at _ i j). Qed.
+Global Instance or_objective P Q `{!Objective P, !Objective Q} : Objective (P ∨ Q).
+Proof. intros i j. by rewrite !monPred_at_or !(objective_at _ i j). Qed.
+Global Instance impl_objective P Q `{!Objective P, !Objective Q} : Objective (P → Q).
+Proof.
+ intros i j. unseal. rewrite (bi.forall_elim i) bi.pure_impl_forall.
+ rewrite bi.forall_elim //. apply bi.forall_intro=> k.
+ rewrite bi.pure_impl_forall. apply bi.forall_intro=>_.
+ rewrite (objective_at Q i). by rewrite (objective_at P k).
+Qed.
+Global Instance forall_objective {A} Φ {H : ∀ x : A, Objective (Φ x)} :
+ @Objective I PROP (∀ x, Φ x)%I.
+Proof. intros i j. unseal. do 2 f_equiv. by apply objective_at. Qed.
+Global Instance exists_objective {A} Φ {H : ∀ x : A, Objective (Φ x)} :
+ @Objective I PROP (∃ x, Φ x)%I.
+Proof. intros i j. unseal. do 2 f_equiv. by apply objective_at. Qed.
+
+Global Instance sep_objective P Q `{!Objective P, !Objective Q} : Objective (P ∗ Q).
+Proof. intros i j. unseal. by rewrite !(objective_at _ i j). Qed.
+Global Instance wand_objective P Q `{!Objective P, !Objective Q} : Objective (P -∗ Q).
+Proof.
+ intros i j. unseal. rewrite (bi.forall_elim i) bi.pure_impl_forall.
+ rewrite bi.forall_elim //. apply bi.forall_intro=> k.
+ rewrite bi.pure_impl_forall. apply bi.forall_intro=>_.
+ rewrite (objective_at Q i). by rewrite (objective_at P k).
+Qed.
+Global Instance persistently_objective P `{!Objective P} : Objective (<pers> P).
+Proof. intros i j. unseal. by rewrite objective_at. Qed.
+
+Global Instance affinely_objective P `{!Objective P} : Objective (<affine> P).
+Proof. rewrite /bi_affinely. apply _. Qed.
+Global Instance intuitionistically_objective P `{!Objective P} : Objective (â–¡ P).
+Proof. rewrite /bi_intuitionistically. apply _. Qed.
+Global Instance absorbingly_objective P `{!Objective P} : Objective (<absorb> P).
+Proof. rewrite /bi_absorbingly. apply _. Qed.
+Global Instance persistently_if_objective P p `{!Objective P} : Objective (<pers>?p P).
+Proof. rewrite /bi_persistently_if. destruct p; apply _. Qed.
+Global Instance affinely_if_objective P p `{!Objective P} : Objective (<affine>?p P).
+Proof. rewrite /bi_affinely_if. destruct p; apply _. Qed.
+Global Instance intuitionistically_if_objective P p `{!Objective P} : Objective (â–¡?p P).
+Proof. rewrite /bi_intuitionistically_if. destruct p; apply _. Qed.
+
+(** monPred_in *)
+Lemma monPred_in_intro P : P ⊢ ∃ i, monPred_in i ∧ ⎡P i⎤.
+Proof.
+ unseal. split=>i /=.
+ rewrite /= -(bi.exist_intro i). apply bi.and_intro=>//. by apply bi.pure_intro.
+Qed.
+Lemma monPred_in_elim P i : monPred_in i -∗ ⎡P i⎤ → P .
+Proof.
+ apply bi.impl_intro_r. unseal. split=>i' /=.
+ eapply bi.pure_elim; [apply bi.and_elim_l|]=>?. rewrite bi.and_elim_r. by f_equiv.
+Qed.
+
+(** Big op *)
+Global Instance monPred_at_monoid_and_homomorphism i :
+ MonoidHomomorphism bi_and bi_and (≡) (flip monPred_at i).
+Proof. split; [split|]; try apply _. apply monPred_at_and. apply monPred_at_pure. Qed.
+Global Instance monPred_at_monoid_or_homomorphism i :
+ MonoidHomomorphism bi_or bi_or (≡) (flip monPred_at i).
+Proof. split; [split|]; try apply _. apply monPred_at_or. apply monPred_at_pure. Qed.
+Global Instance monPred_at_monoid_sep_homomorphism i :
+ MonoidHomomorphism bi_sep bi_sep (≡) (flip monPred_at i).
+Proof. split; [split|]; try apply _. apply monPred_at_sep. apply monPred_at_emp. Qed.
+
+Lemma monPred_at_big_sepL {A} i (Φ : nat → A → monPred) l :
+ ([∗ list] k↦x ∈ l, Φ k x) i ⊣⊢ [∗ list] k↦x ∈ l, Φ k x i.
+Proof. apply (big_opL_commute (flip monPred_at i)). Qed.
+Lemma monPred_at_big_sepM `{Countable K} {A} i (Φ : K → A → monPred) (m : gmap K A) :
+ ([∗ map] k↦x ∈ m, Φ k x) i ⊣⊢ [∗ map] k↦x ∈ m, Φ k x i.
+Proof. apply (big_opM_commute (flip monPred_at i)). Qed.
+Lemma monPred_at_big_sepS `{Countable A} i (Φ : A → monPred) (X : gset A) :
+ ([∗ set] y ∈ X, Φ y) i ⊣⊢ [∗ set] y ∈ X, Φ y i.
+Proof. apply (big_opS_commute (flip monPred_at i)). Qed.
+Lemma monPred_at_big_sepMS `{Countable A} i (Φ : A → monPred) (X : gmultiset A) :
+ ([∗ mset] y ∈ X, Φ y) i ⊣⊢ ([∗ mset] y ∈ X, Φ y i).
+Proof. apply (big_opMS_commute (flip monPred_at i)). Qed.
+
+Global Instance monPred_objectively_monoid_and_homomorphism :
+ MonoidHomomorphism bi_and bi_and (≡) (@monPred_objectively I PROP).
+Proof.
+ split; [split|]; try apply _. apply monPred_objectively_and.
+ apply monPred_objectively_pure.
+Qed.
+Global Instance monPred_objectively_monoid_sep_entails_homomorphism :
+ MonoidHomomorphism bi_sep bi_sep (flip (⊢)) (@monPred_objectively I PROP).
+Proof.
+ split; [split|]; try apply _. apply monPred_objectively_sep_2.
+ by rewrite monPred_objectively_emp.
+Qed.
+Global Instance monPred_objectively_monoid_sep_homomorphism `{BiIndexBottom bot} :
+ MonoidHomomorphism bi_sep bi_sep (≡) (@monPred_objectively I PROP).
+Proof.
+ split; [split|]; try apply _. apply monPred_objectively_sep.
+ by rewrite monPred_objectively_emp.
+Qed.
+
+Lemma monPred_objectively_big_sepL_entails {A} (Φ : nat → A → monPred) l :
+ ([∗ list] k↦x ∈ l, <obj> (Φ k x)) ⊢ <obj> ([∗ list] k↦x ∈ l, Φ k x).
+Proof. apply (big_opL_commute monPred_objectively (R:=flip (⊢))). Qed.
+Lemma monPred_objectively_big_sepM_entails
+ `{Countable K} {A} (Φ : K → A → monPred) (m : gmap K A) :
+ ([∗ map] k↦x ∈ m, <obj> (Φ k x)) ⊢ <obj> ([∗ map] k↦x ∈ m, Φ k x).
+Proof. apply (big_opM_commute monPred_objectively (R:=flip (⊢))). Qed.
+Lemma monPred_objectively_big_sepS_entails `{Countable A} (Φ : A → monPred) (X : gset A) :
+ ([∗ set] y ∈ X, <obj> (Φ y)) ⊢ <obj> ([∗ set] y ∈ X, Φ y).
+Proof. apply (big_opS_commute monPred_objectively (R:=flip (⊢))). Qed.
+Lemma monPred_objectively_big_sepMS_entails `{Countable A} (Φ : A → monPred) (X : gmultiset A) :
+ ([∗ mset] y ∈ X, <obj> (Φ y)) ⊢ <obj> ([∗ mset] y ∈ X, Φ y).
+Proof. apply (big_opMS_commute monPred_objectively (R:=flip (⊢))). Qed.
+
+Lemma monPred_objectively_big_sepL `{BiIndexBottom bot} {A} (Φ : nat → A → monPred) l :
+ <obj> ([∗ list] k↦x ∈ l, Φ k x) ⊣⊢ ([∗ list] k↦x ∈ l, <obj> (Φ k x)).
+Proof. apply (big_opL_commute _). Qed.
+Lemma monPred_objectively_big_sepM `{BiIndexBottom bot} `{Countable K} {A}
+ (Φ : K → A → monPred) (m : gmap K A) :
+ <obj> ([∗ map] k↦x ∈ m, Φ k x) ⊣⊢ ([∗ map] k↦x ∈ m, <obj> (Φ k x)).
+Proof. apply (big_opM_commute _). Qed.
+Lemma monPred_objectively_big_sepS `{BiIndexBottom bot} `{Countable A}
+ (Φ : A → monPred) (X : gset A) :
+ <obj> ([∗ set] y ∈ X, Φ y) ⊣⊢ ([∗ set] y ∈ X, <obj> (Φ y)).
+Proof. apply (big_opS_commute _). Qed.
+Lemma monPred_objectively_big_sepMS `{BiIndexBottom bot} `{Countable A}
+ (Φ : A → monPred) (X : gmultiset A) :
+ <obj> ([∗ mset] y ∈ X, Φ y) ⊣⊢ ([∗ mset] y ∈ X, <obj> (Φ y)).
+Proof. apply (big_opMS_commute _). Qed.
+
+Global Instance big_sepL_objective {A} (l : list A) Φ `{∀ n x, Objective (Φ n x)} :
+ @Objective I PROP ([∗ list] n↦x ∈ l, Φ n x)%I.
+Proof. generalize dependent Φ. induction l=>/=; apply _. Qed.
+Global Instance big_sepM_objective `{Countable K} {A}
+ (Φ : K → A → monPred) (m : gmap K A) `{∀ k x, Objective (Φ k x)} :
+ Objective ([∗ map] k↦x ∈ m, Φ k x)%I.
+Proof. intros ??. rewrite !monPred_at_big_sepM. do 3 f_equiv. by apply objective_at. Qed.
+Global Instance big_sepS_objective `{Countable A} (Φ : A → monPred)
+ (X : gset A) `{∀ y, Objective (Φ y)} :
+ Objective ([∗ set] y ∈ X, Φ y)%I.
+Proof. intros ??. rewrite !monPred_at_big_sepS. do 2 f_equiv. by apply objective_at. Qed.
+Global Instance big_sepMS_objective `{Countable A} (Φ : A → monPred)
+ (X : gmultiset A) `{∀ y, Objective (Φ y)} :
+ Objective ([∗ mset] y ∈ X, Φ y)%I.
+Proof. intros ??. rewrite !monPred_at_big_sepMS. do 2 f_equiv. by apply objective_at. Qed.
+
+(** BUpd *)
+Program Definition monPred_bupd_def `{BiBUpd PROP} (P : monPred) : monPred :=
+ MonPred (λ i, |==> P i)%I _.
+Next Obligation. solve_proper. Qed.
+Definition monPred_bupd_aux `{BiBUpd PROP} : seal monPred_bupd_def. by eexists. Qed.
+Definition monPred_bupd `{BiBUpd PROP} : BUpd _ := monPred_bupd_aux.(unseal).
+Definition monPred_bupd_eq `{BiBUpd PROP} : @bupd _ monPred_bupd = _ :=
+ monPred_bupd_aux.(seal_eq).
+
+Lemma monPred_bupd_mixin `{BiBUpd PROP} : BiBUpdMixin monPredI monPred_bupd.
+Proof.
+ split; rewrite monPred_bupd_eq.
+ - split=>/= i. solve_proper.
+ - intros P. split=>/= i. apply bupd_intro.
+ - intros P Q HPQ. split=>/= i. by rewrite HPQ.
+ - intros P. split=>/= i. apply bupd_trans.
+ - intros P Q. split=>/= i. rewrite !monPred_at_sep /=. apply bupd_frame_r.
+Qed.
+Global Instance monPred_bi_bupd `{BiBUpd PROP} : BiBUpd monPredI :=
+ {| bi_bupd_mixin := monPred_bupd_mixin |}.
+
+Lemma monPred_at_bupd `{BiBUpd PROP} i P : (|==> P) i ⊣⊢ |==> P i.
+Proof. by rewrite monPred_bupd_eq. Qed.
+
+Global Instance bupd_objective `{BiBUpd PROP} P `{!Objective P} :
+ Objective (|==> P)%I.
+Proof. intros ??. by rewrite !monPred_at_bupd objective_at. Qed.
+
+Global Instance monPred_bi_embed_bupd `{BiBUpd PROP} :
+ BiEmbedBUpd PROP monPredI.
+Proof. split. split=>i /=. by rewrite monPred_at_bupd !monPred_at_embed. Qed.
+End bi_facts.
+
+Section sbi_facts.
+Context {I : biIndex} {PROP : sbi}.
+Local Notation monPred := (monPred I PROP).
+Local Notation monPredSI := (monPredSI I PROP).
+Implicit Types i : I.
+Implicit Types P Q : monPred.
+
+Global Instance monPred_at_timeless P i : Timeless P → Timeless (P i).
+Proof. move => [] /(_ i). unfold Timeless. by unseal. Qed.
+Global Instance monPred_in_timeless i0 : Timeless (@monPred_in I PROP i0).
+Proof. split => ? /=. unseal. apply timeless, _. Qed.
+Global Instance monPred_objectively_timeless P : Timeless P → Timeless (<obj> P).
+Proof.
+ move=>[]. unfold Timeless. unseal=>Hti. split=> ? /=.
+ by apply timeless, bi.forall_timeless.
+Qed.
+Global Instance monPred_subjectively_timeless P : Timeless P → Timeless (<subj> P).
+Proof.
+ move=>[]. unfold Timeless. unseal=>Hti. split=> ? /=.
+ by apply timeless, bi.exist_timeless.
+Qed.
+
+Global Instance monPred_sbi_embed : SbiEmbed PROP monPredSI.
+Proof.
+ split; unseal=> //. intros ? P Q.
+ apply (@bi.f_equiv _ _ _ (λ P, monPred_at P inhabitant)); solve_proper.
+Qed.
+
+Lemma monPred_internal_eq_unfold : @sbi_internal_eq monPredSI = λ A x y, ⎡ x ≡ y ⎤%I.
+Proof. by unseal. Qed.
+
+(** Unfolding lemmas *)
+Lemma monPred_at_internal_eq {A : ofeT} i (a b : A) :
+ @monPred_at I PROP (a ≡ b) i ⊣⊢ a ≡ b.
+Proof. rewrite monPred_internal_eq_unfold. by apply monPred_at_embed. Qed.
+Lemma monPred_at_later i P : (▷ P) i ⊣⊢ ▷ P i.
+Proof. by unseal. Qed.
+Lemma monPred_at_laterN n i P : (▷^n P) i ⊣⊢ ▷^n P i.
+Proof. induction n; first done. rewrite /= monPred_at_later IHn //. Qed.
+Lemma monPred_at_except_0 i P : (◇ P) i ⊣⊢ ◇ P i.
+Proof. by unseal. Qed.
+
+Lemma monPred_equivI {PROP' : sbi} P Q :
+ P ≡ Q ⊣⊢@{PROP'} ∀ i, P i ≡ Q i.
+Proof.
+ apply bi.equiv_spec. split.
+ - apply bi.forall_intro=>?. apply (bi.f_equiv (flip monPred_at _)).
+ - by rewrite -{2}(sig_monPred_sig P) -{2}(sig_monPred_sig Q)
+ -bi.f_equiv -bi.sig_equivI !bi.ofe_fun_equivI.
+Qed.
+
+(** Objective *)
+Global Instance internal_eq_objective {A : ofeT} (x y : A) :
+ @Objective I PROP (x ≡ y).
+Proof. intros ??. by unseal. Qed.
+
+Global Instance later_objective P `{!Objective P} : Objective (â–· P).
+Proof. intros ??. unseal. by rewrite objective_at. Qed.
+Global Instance laterN_objective P `{!Objective P} n : Objective (â–·^n P).
+Proof. induction n; apply _. Qed.
+Global Instance except0_objective P `{!Objective P} : Objective (â—‡ P).
+Proof. rewrite /sbi_except_0. apply _. Qed.
+
+(** FUpd *)
+Program Definition monPred_fupd_def `{BiFUpd PROP} (E1 E2 : coPset)
+ (P : monPred) : monPred :=
+ MonPred (λ i, |={E1,E2}=> P i)%I _.
+Next Obligation. solve_proper. Qed.
+Definition monPred_fupd_aux `{BiFUpd PROP} : seal monPred_fupd_def. by eexists. Qed.
+Definition monPred_fupd `{BiFUpd PROP} : FUpd _ := monPred_fupd_aux.(unseal).
+Definition monPred_fupd_eq `{BiFUpd PROP} : @fupd _ monPred_fupd = _ :=
+ monPred_fupd_aux.(seal_eq).
+
+Lemma monPred_fupd_mixin `{BiFUpd PROP} : BiFUpdMixin monPredSI monPred_fupd.
+Proof.
+ split; rewrite monPred_fupd_eq.
+ - split=>/= i. solve_proper.
+ - intros E1 E2 P HE12. split=>/= i. by apply fupd_intro_mask.
+ - intros E1 E2 P. split=>/= i. by rewrite monPred_at_except_0 except_0_fupd.
+ - intros E1 E2 P Q HPQ. split=>/= i. by rewrite HPQ.
+ - intros E1 E2 E3 P. split=>/= i. apply fupd_trans.
+ - intros E1 E2 Ef P HE1f. split=>/= i.
+ rewrite monPred_impl_force monPred_at_pure -fupd_mask_frame_r' //.
+ - intros E1 E2 P Q. split=>/= i. by rewrite !monPred_at_sep /= fupd_frame_r.
+Qed.
+Global Instance monPred_bi_fupd `{BiFUpd PROP} : BiFUpd monPredSI :=
+ {| bi_fupd_mixin := monPred_fupd_mixin |}.
+Global Instance monPred_bi_bupd_fupd `{BiBUpdFUpd PROP} : BiBUpdFUpd monPredSI.
+Proof.
+ intros E P. split=>/= i. rewrite monPred_at_bupd monPred_fupd_eq bupd_fupd //=.
+Qed.
+Global Instance monPred_bi_embed_fupd `{BiFUpd PROP} : BiEmbedFUpd PROP monPredSI.
+Proof. split. split=>i /=. by rewrite monPred_fupd_eq /= !monPred_at_embed. Qed.
+
+Lemma monPred_at_fupd `{BiFUpd PROP} i E1 E2 P :
+ (|={E1,E2}=> P) i ⊣⊢ |={E1,E2}=> P i.
+Proof. by rewrite monPred_fupd_eq. Qed.
+
+Global Instance fupd_objective E1 E2 P `{!Objective P} `{BiFUpd PROP} :
+ Objective (|={E1,E2}=> P)%I.
+Proof. intros ??. by rewrite !monPred_at_fupd objective_at. Qed.
+
+(** Plainly *)
+Definition monPred_plainly_def `{BiPlainly PROP} P : monPred :=
+ MonPred (λ _, ∀ i, ■(P i))%I _.
+Definition monPred_plainly_aux `{BiPlainly PROP} : seal monPred_plainly_def. by eexists. Qed.
+Definition monPred_plainly `{BiPlainly PROP} : Plainly _ := monPred_plainly_aux.(unseal).
+Definition monPred_plainly_eq `{BiPlainly PROP} : @plainly _ monPred_plainly = _ := monPred_plainly_aux.(seal_eq).
+
+Lemma monPred_plainly_mixin `{BiPlainly PROP} : BiPlainlyMixin monPredSI monPred_plainly.
+Proof.
+ split; rewrite monPred_plainly_eq; try unseal.
+ - by (split=> ? /=; repeat f_equiv).
+ - intros P Q [?]. split=> i /=. by do 3 f_equiv.
+ - intros P. split=> i /=. by rewrite bi.forall_elim plainly_elim_persistently.
+ - intros P. split=> i /=. repeat setoid_rewrite <-plainly_forall.
+ rewrite -plainly_idemp_2. f_equiv. by apply bi.forall_intro=>_.
+ - intros A Ψ. split=> i /=. apply bi.forall_intro=> j.
+ rewrite plainly_forall. apply bi.forall_intro=> a. by rewrite !bi.forall_elim.
+ - intros P Q. split=> i /=. repeat setoid_rewrite bi.pure_impl_forall.
+ repeat setoid_rewrite <-plainly_forall.
+ repeat setoid_rewrite bi.persistently_forall. do 4 f_equiv.
+ apply persistently_impl_plainly.
+ - intros P Q. split=> i /=.
+ repeat setoid_rewrite bi.pure_impl_forall. rewrite 2!bi.forall_elim //.
+ repeat setoid_rewrite <-plainly_forall.
+ setoid_rewrite plainly_impl_plainly. f_equiv.
+ do 3 apply bi.forall_intro => ?. f_equiv. rewrite bi.forall_elim //.
+ - intros P. split=> i /=. apply bi.forall_intro=>_. by apply plainly_emp_intro.
+ - intros P Q. split=> i. apply bi.sep_elim_l, _.
+ - intros P Q. split=> i /=. rewrite (monPred_equivI P Q). f_equiv=> j.
+ by rewrite -prop_ext !(bi.forall_elim j) !bi.pure_True // !bi.True_impl.
+ - intros P. split=> i /=.
+ rewrite bi.later_forall. f_equiv=> j. by rewrite -later_plainly_1.
+ - intros P. split=> i /=.
+ rewrite bi.later_forall. f_equiv=> j. by rewrite -later_plainly_2.
+Qed.
+Global Instance monPred_bi_plainly `{BiPlainly PROP} : BiPlainly monPredSI :=
+ {| bi_plainly_mixin := monPred_plainly_mixin |}.
+
+Global Instance monPred_bi_plainly_exist `{BiPlainly PROP} `{@BiIndexBottom I bot} :
+ BiPlainlyExist PROP → BiPlainlyExist monPredSI.
+Proof.
+ split=>?/=. rewrite monPred_plainly_eq /=. repeat setoid_rewrite monPred_at_exist.
+ rewrite (bi.forall_elim bot) plainly_exist_1. do 2 f_equiv.
+ apply bi.forall_intro=>?. by do 2 f_equiv.
+Qed.
+
+Global Instance monPred_bi_embed_plainly `{BiPlainly PROP} :
+ BiEmbedPlainly PROP monPredSI.
+Proof. apply bi_embed_plainly_emp, _. Qed.
+
+Lemma monPred_plainly_unfold `{BiPlainly PROP} : plainly = λ P, ⎡ ∀ i, ■(P i) ⎤%I.
+Proof. by rewrite monPred_plainly_eq monPred_embed_eq. Qed.
+Lemma monPred_at_plainly `{BiPlainly PROP} i P : (■P) i ⊣⊢ ∀ j, ■(P j).
+Proof. by rewrite monPred_plainly_eq. Qed.
+
+Global Instance monPred_bi_bupd_plainly `{BiBUpdPlainly PROP} : BiBUpdPlainly monPredSI.
+Proof.
+ intros P. split=> /= i.
+ rewrite monPred_at_bupd monPred_at_plainly bi.forall_elim. apply bupd_plainly.
+Qed.
+
+Global Instance monPred_at_plain `{BiPlainly PROP} P i : Plain P → Plain (P i).
+Proof. move => [] /(_ i). rewrite /Plain monPred_at_plainly bi.forall_elim //. Qed.
+
+Global Instance monPred_bi_fupd_plainly `{BiFUpdPlainly PROP} : BiFUpdPlainly monPredSI.
+Proof.
+ split; rewrite monPred_fupd_eq; unseal.
+ - intros E1 E2 E2' P Q ? HE12. split=>/= i. do 3 f_equiv.
+ apply fupd_plain'; [apply _|done].
+ - intros E P ?. split=>/= i. apply later_fupd_plain, _.
+Qed.
+
+Global Instance plainly_objective `{BiPlainly PROP} P : Objective (â– P).
+Proof. rewrite monPred_plainly_unfold. apply _. Qed.
+Global Instance plainly_if_objective `{BiPlainly PROP} P p `{!Objective P} :
+ Objective (â– ?p P).
+Proof. rewrite /plainly_if. destruct p; apply _. Qed.
+
+Global Instance monPred_objectively_plain `{BiPlainly PROP} P : Plain P → Plain (<obj> P).
+Proof. rewrite monPred_objectively_unfold. apply _. Qed.
+Global Instance monPred_subjectively_plain `{BiPlainly PROP} P : Plain P → Plain (<subj> P).
+Proof. rewrite monPred_subjectively_unfold. apply _. Qed.
+End sbi_facts.
diff --git a/theories/bi/notation.v b/theories/bi/notation.v
new file mode 100644
index 0000000000000000000000000000000000000000..84afd7846d38a52dbad27687f0b9abf278e8538b
--- /dev/null
+++ b/theories/bi/notation.v
@@ -0,0 +1,133 @@
+(** Just reserve the notation. *)
+
+(** Turnstiles *)
+Reserved Notation "P ⊢ Q" (at level 99, Q at level 200, right associativity).
+Reserved Notation "P '⊢@{' PROP } Q" (at level 99, Q at level 200, right associativity).
+Reserved Notation "('⊢@{' PROP } )" (at level 99).
+Reserved Notation "P ⊣⊢ Q" (at level 95, no associativity).
+Reserved Notation "P '⊣⊢@{' PROP } Q" (at level 95, no associativity).
+Reserved Notation "('⊣⊢@{' PROP } )" (at level 95).
+
+(** BI connectives *)
+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,
+ format "'[' P '/' -∗ Q ']'").
+
+Reserved Notation "⎡ P ⎤".
+
+(** Modalities *)
+Reserved Notation "'<pers>' P" (at level 20, right associativity).
+Reserved Notation "'<pers>?' p P" (at level 20, p at level 9, P at level 20,
+ right associativity, format "'<pers>?' p P").
+
+Reserved Notation "â–· P" (at level 20, right associativity).
+Reserved Notation "â–·? p P" (at level 20, p at level 9, P at level 20,
+ format "â–·? p P").
+Reserved Notation "â–·^ n P" (at level 20, n at level 9, P at level 20,
+ format "â–·^ n P").
+
+Reserved Infix "∗-∗" (at level 95, no associativity).
+
+Reserved Notation "'<affine>' P" (at level 20, right associativity).
+Reserved Notation "'<affine>?' p P" (at level 20, p at level 9, P at level 20,
+ right associativity, format "'<affine>?' p P").
+
+Reserved Notation "'<absorb>' P" (at level 20, right associativity).
+
+Reserved Notation "â–¡ P" (at level 20, right associativity).
+Reserved Notation "'â–¡?' p P" (at level 20, p at level 9, P at level 20,
+ right associativity, format "'â–¡?' p P").
+
+Reserved Notation "â—‡ P" (at level 20, right associativity).
+
+Reserved Notation "â– P" (at level 20, right associativity).
+Reserved Notation "â– ? p P" (at level 20, p at level 9, P at level 20,
+ right associativity, format "â– ? p P").
+
+Reserved Notation "'<obj>' P" (at level 20, right associativity).
+Reserved Notation "'<subj>' P" (at level 20, right associativity).
+
+(** Update modalities *)
+Reserved Notation "|==> Q" (at level 99, Q at level 200, format "|==> Q").
+Reserved Notation "P ==∗ Q"
+ (at level 99, Q at level 200, format "'[' P '/' ==∗ Q ']'").
+
+Reserved Notation "|={ E1 , E2 }=> Q"
+ (at level 99, E1, E2 at level 50, Q at level 200,
+ format "|={ E1 , E2 }=> Q").
+Reserved Notation "P ={ E1 , E2 }=∗ Q"
+ (at level 99, E1,E2 at level 50, Q at level 200,
+ format "'[' P '/' ={ E1 , E2 }=∗ Q ']'").
+
+Reserved Notation "|={ E }=> Q"
+ (at level 99, E at level 50, Q at level 200,
+ format "|={ E }=> Q").
+Reserved Notation "P ={ E }=∗ Q"
+ (at level 99, E at level 50, Q at level 200,
+ format "'[' P '/' ={ E }=∗ Q ']'").
+
+Reserved Notation "|={ E1 , E2 , E3 }â–·=> Q"
+ (at level 99, E1, E2 at level 50, Q at level 200,
+ format "|={ E1 , E2 , E3 }â–·=> Q").
+Reserved Notation "P ={ E1 , E2 , E3 }▷=∗ Q"
+ (at level 99, E1, E2 at level 50, Q at level 200,
+ format "'[' P '/' ={ E1 , E2 , E3 }▷=∗ Q ']'").
+Reserved Notation "|={ E1 , E2 }â–·=> Q"
+ (at level 99, E1, E2 at level 50, Q at level 200,
+ format "|={ E1 , E2 }â–·=> Q").
+Reserved Notation "P ={ E1 , E2 }▷=∗ Q"
+ (at level 99, E1, E2 at level 50, Q at level 200,
+ format "'[' P '/' ={ E1 , E2 }▷=∗ Q ']'").
+Reserved Notation "|={ E }â–·=> Q"
+ (at level 99, E at level 50, Q at level 200,
+ format "|={ E }â–·=> Q").
+Reserved Notation "P ={ E }▷=∗ Q"
+ (at level 99, E at level 50, Q at level 200,
+ format "'[' P '/' ={ E }▷=∗ Q ']'").
+
+(** Big Ops *)
+Reserved Notation "'[∗' 'list]' k ↦ x ∈ l , P"
+ (at level 200, l at level 10, k, x at level 1, right associativity,
+ format "[∗ list] k ↦ x ∈ l , P").
+Reserved Notation "'[∗' 'list]' x ∈ l , P"
+ (at level 200, l at level 10, x at level 1, right associativity,
+ format "[∗ list] x ∈ l , P").
+
+Reserved Notation "'[∗' 'list]' k ↦ x1 ; x2 ∈ l1 ; l2 , P"
+ (at level 200, l1, l2 at level 10, k, x1, x2 at level 1, right associativity,
+ format "[∗ list] k ↦ x1 ; x2 ∈ l1 ; l2 , P").
+Reserved Notation "'[∗' 'list]' x1 ; x2 ∈ l1 ; l2 , P"
+ (at level 200, l1, l2 at level 10, x1, x2 at level 1, right associativity,
+ format "[∗ list] x1 ; x2 ∈ l1 ; l2 , P").
+
+Reserved Notation "'[∗]' Ps" (at level 20).
+
+Reserved Notation "'[∧' 'list]' k ↦ x ∈ l , P"
+ (at level 200, l at level 10, k, x at level 1, right associativity,
+ format "[∧ list] k ↦ x ∈ l , P").
+Reserved Notation "'[∧' 'list]' x ∈ l , P"
+ (at level 200, l at level 10, x at level 1, right associativity,
+ format "[∧ list] x ∈ l , P").
+
+Reserved Notation "'[∧]' Ps" (at level 20).
+
+Reserved Notation "'[∗' 'map]' k ↦ x ∈ m , P"
+ (at level 200, m at level 10, k, x at level 1, right associativity,
+ format "[∗ map] k ↦ x ∈ m , P").
+Reserved Notation "'[∗' 'map]' x ∈ m , P"
+ (at level 200, m at level 10, x at level 1, right associativity,
+ format "[∗ map] x ∈ m , P").
+
+Reserved Notation "'[∗' 'set]' x ∈ X , P"
+ (at level 200, X at level 10, x at level 1, right associativity,
+ format "[∗ set] x ∈ X , P").
+
+Reserved Notation "'[∗' 'mset]' x ∈ X , P"
+ (at level 200, X at level 10, x at level 1, right associativity,
+ format "[∗ mset] x ∈ X , P").
+
+(** Define the scope *)
+Delimit Scope bi_scope with I.
diff --git a/theories/bi/plainly.v b/theories/bi/plainly.v
new file mode 100644
index 0000000000000000000000000000000000000000..abff5e6423567ebf068a919dc66ab916cc921e66
--- /dev/null
+++ b/theories/bi/plainly.v
@@ -0,0 +1,542 @@
+From iris.bi Require Import derived_laws_sbi.
+From iris.algebra Require Import monoid.
+Import interface.bi derived_laws_bi.bi derived_laws_sbi.bi.
+
+Class Plainly (A : Type) := plainly : A → A.
+Hint Mode Plainly ! : typeclass_instances.
+Instance: Params (@plainly) 2.
+Notation "â– P" := (plainly P) : bi_scope.
+
+(* Mixins allow us to create instances easily without having to use Program *)
+Record BiPlainlyMixin (PROP : sbi) `(Plainly PROP) := {
+ bi_plainly_mixin_plainly_ne : NonExpansive plainly;
+
+ bi_plainly_mixin_plainly_mono P Q : (P ⊢ Q) → ■P ⊢ ■Q;
+ bi_plainly_mixin_plainly_elim_persistently P : ■P ⊢ <pers> P;
+ bi_plainly_mixin_plainly_idemp_2 P : ■P ⊢ ■■P;
+
+ bi_plainly_mixin_plainly_forall_2 {A} (Ψ : A → PROP) :
+ (∀ a, ■(Ψ a)) ⊢ ■(∀ a, Ψ a);
+
+ (* The following two laws are very similar, and indeed they hold not just
+ for persistently and plainly, but for any modality defined as `M P n x :=
+ ∀ y, R x y → P n y`. *)
+ bi_plainly_mixin_persistently_impl_plainly P Q :
+ (■P → <pers> Q) ⊢ <pers> (■P → Q);
+ bi_plainly_mixin_plainly_impl_plainly P Q : (■P → ■Q) ⊢ ■(■P → Q);
+
+ bi_plainly_mixin_plainly_emp_intro P : P ⊢ ■emp;
+ bi_plainly_mixin_plainly_absorb P Q : ■P ∗ Q ⊢ ■P;
+
+ bi_plainly_mixin_prop_ext P Q : ■((P -∗ Q) ∧ (Q -∗ P)) ⊢ P ≡ Q;
+
+ bi_plainly_mixin_later_plainly_1 P : ▷ ■P ⊢ ■▷ P;
+ bi_plainly_mixin_later_plainly_2 P : ■▷ P ⊢ ▷ ■P;
+}.
+
+Class BiPlainly (PROP : sbi) := {
+ bi_plainly_plainly :> Plainly PROP;
+ bi_plainly_mixin : BiPlainlyMixin PROP bi_plainly_plainly;
+}.
+Hint Mode BiPlainly ! : typeclass_instances.
+Arguments bi_plainly_plainly : simpl never.
+
+Class BiPlainlyExist `{!BiPlainly PROP} :=
+ plainly_exist_1 A (Ψ : A → PROP) :
+ ■(∃ a, Ψ a) ⊢ ∃ a, ■(Ψ a).
+Arguments BiPlainlyExist : clear implicits.
+Arguments BiPlainlyExist _ {_}.
+Arguments plainly_exist_1 _ {_ _} _.
+Hint Mode BiPlainlyExist ! - : typeclass_instances.
+
+Section plainly_laws.
+ Context `{BiPlainly PROP}.
+ Implicit Types P Q : PROP.
+
+ Global Instance plainly_ne : NonExpansive (@plainly PROP _).
+ Proof. eapply bi_plainly_mixin_plainly_ne, bi_plainly_mixin. Qed.
+
+ Lemma plainly_mono P Q : (P ⊢ Q) → ■P ⊢ ■Q.
+ Proof. eapply bi_plainly_mixin_plainly_mono, bi_plainly_mixin. Qed.
+ Lemma plainly_elim_persistently P : ■P ⊢ <pers> P.
+ Proof. eapply bi_plainly_mixin_plainly_elim_persistently, bi_plainly_mixin. Qed.
+ Lemma plainly_idemp_2 P : ■P ⊢ ■■P.
+ Proof. eapply bi_plainly_mixin_plainly_idemp_2, bi_plainly_mixin. Qed.
+ Lemma plainly_forall_2 {A} (Ψ : A → PROP) : (∀ a, ■(Ψ a)) ⊢ ■(∀ a, Ψ a).
+ Proof. eapply bi_plainly_mixin_plainly_forall_2, bi_plainly_mixin. Qed.
+ Lemma persistently_impl_plainly P Q : (■P → <pers> Q) ⊢ <pers> (■P → Q).
+ Proof. eapply bi_plainly_mixin_persistently_impl_plainly, bi_plainly_mixin. Qed.
+ Lemma plainly_impl_plainly P Q : (■P → ■Q) ⊢ ■(■P → Q).
+ Proof. eapply bi_plainly_mixin_plainly_impl_plainly, bi_plainly_mixin. Qed.
+ Lemma plainly_absorb P Q : ■P ∗ Q ⊢ ■P.
+ Proof. eapply bi_plainly_mixin_plainly_absorb, bi_plainly_mixin. Qed.
+ Lemma plainly_emp_intro P : P ⊢ ■emp.
+ Proof. eapply bi_plainly_mixin_plainly_emp_intro, bi_plainly_mixin. Qed.
+
+ Lemma prop_ext P Q : ■((P -∗ Q) ∧ (Q -∗ P)) ⊢ P ≡ Q.
+ Proof. eapply bi_plainly_mixin_prop_ext, bi_plainly_mixin. Qed.
+
+ Lemma later_plainly_1 P : ▷ ■P ⊢ ■(▷ P).
+ Proof. eapply bi_plainly_mixin_later_plainly_1, bi_plainly_mixin. Qed.
+ Lemma later_plainly_2 P : ■▷ P ⊢ ▷ ■P.
+ Proof. eapply bi_plainly_mixin_later_plainly_2, bi_plainly_mixin. Qed.
+End plainly_laws.
+
+(* Derived properties and connectives *)
+Class Plain `{BiPlainly PROP} (P : PROP) := plain : P ⊢ ■P.
+Arguments Plain {_ _} _%I : simpl never.
+Arguments plain {_ _} _%I {_}.
+Hint Mode Plain + - ! : typeclass_instances.
+Instance: Params (@Plain) 1.
+
+Definition plainly_if `{!BiPlainly PROP} (p : bool) (P : PROP) : PROP :=
+ (if p then â– P else P)%I.
+Arguments plainly_if {_ _} !_ _%I /.
+Instance: Params (@plainly_if) 2.
+Typeclasses Opaque plainly_if.
+
+Notation "â– ? p P" := (plainly_if p P) : bi_scope.
+
+(* Derived laws *)
+Section plainly_derived.
+Context `{BiPlainly PROP}.
+Implicit Types P : PROP.
+
+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'.
+
+Global Instance plainly_proper :
+ Proper ((⊣⊢) ==> (⊣⊢)) (@plainly PROP _) := ne_proper _.
+
+Global Instance plainly_mono' : Proper ((⊢) ==> (⊢)) (@plainly PROP _).
+Proof. intros P Q; apply plainly_mono. Qed.
+Global Instance plainly_flip_mono' :
+ Proper (flip (⊢) ==> flip (⊢)) (@plainly PROP _).
+Proof. intros P Q; apply plainly_mono. Qed.
+
+Lemma affinely_plainly_elim P : <affine> ■P ⊢ P.
+Proof. by rewrite plainly_elim_persistently /bi_affinely persistently_and_emp_elim. Qed.
+
+Lemma persistently_elim_plainly P : <pers> ■P ⊣⊢ ■P.
+Proof.
+ apply (anti_symm _).
+ - by rewrite persistently_into_absorbingly /bi_absorbingly comm plainly_absorb.
+ - by rewrite {1}plainly_idemp_2 plainly_elim_persistently.
+Qed.
+Lemma persistently_if_elim_plainly P p : <pers>?p ■P ⊣⊢ ■P.
+Proof. destruct p; last done. exact: persistently_elim_plainly. Qed.
+
+Lemma plainly_persistently_elim P : ■<pers> P ⊣⊢ ■P.
+Proof.
+ apply (anti_symm _).
+ - rewrite -{1}(left_id True%I bi_and (â– _)%I) (plainly_emp_intro True%I).
+ rewrite -{2}(persistently_and_emp_elim P).
+ rewrite !and_alt -plainly_forall_2. by apply forall_mono=> -[].
+ - by rewrite {1}plainly_idemp_2 (plainly_elim_persistently P).
+Qed.
+
+Lemma absorbingly_elim_plainly P : <absorb> ■P ⊣⊢ ■P.
+Proof. by rewrite -(persistently_elim_plainly P) absorbingly_elim_persistently. Qed.
+
+Lemma plainly_and_sep_elim P Q : ■P ∧ Q -∗ (emp ∧ P) ∗ Q.
+Proof. by rewrite plainly_elim_persistently persistently_and_sep_elim_emp. Qed.
+Lemma plainly_and_sep_assoc P Q R : ■P ∧ (Q ∗ R) ⊣⊢ (■P ∧ Q) ∗ R.
+Proof. by rewrite -(persistently_elim_plainly P) persistently_and_sep_assoc. Qed.
+Lemma plainly_and_emp_elim P : emp ∧ ■P ⊢ P.
+Proof. by rewrite plainly_elim_persistently persistently_and_emp_elim. Qed.
+Lemma plainly_into_absorbingly P : ■P ⊢ <absorb> P.
+Proof. by rewrite plainly_elim_persistently persistently_into_absorbingly. Qed.
+Lemma plainly_elim P `{!Absorbing P} : ■P ⊢ P.
+Proof. by rewrite plainly_elim_persistently persistently_elim. Qed.
+
+Lemma plainly_idemp_1 P : ■■P ⊢ ■P.
+Proof. by rewrite plainly_into_absorbingly absorbingly_elim_plainly. Qed.
+Lemma plainly_idemp P : ■■P ⊣⊢ ■P.
+Proof. apply (anti_symm _); auto using plainly_idemp_1, plainly_idemp_2. Qed.
+
+Lemma plainly_intro' P Q : (■P ⊢ Q) → ■P ⊢ ■Q.
+Proof. intros <-. apply plainly_idemp_2. Qed.
+
+Lemma plainly_pure φ : ■⌜φ⌠⊣⊢@{PROP} ⌜φâŒ.
+Proof.
+ apply (anti_symm _); auto.
+ - by rewrite plainly_elim_persistently persistently_pure.
+ - apply pure_elim'=> Hφ.
+ trans (∀ x : False, ■True : PROP)%I; [by apply forall_intro|].
+ rewrite plainly_forall_2. by rewrite -(pure_intro φ).
+Qed.
+Lemma plainly_forall {A} (Ψ : A → PROP) : ■(∀ a, Ψ a) ⊣⊢ ∀ a, ■(Ψ a).
+Proof.
+ apply (anti_symm _); auto using plainly_forall_2.
+ apply forall_intro=> x. by rewrite (forall_elim x).
+Qed.
+Lemma plainly_exist_2 {A} (Ψ : A → PROP) : (∃ a, ■(Ψ a)) ⊢ ■(∃ a, Ψ a).
+Proof. apply exist_elim=> x. by rewrite (exist_intro x). Qed.
+Lemma plainly_exist `{!BiPlainlyExist PROP} {A} (Ψ : A → PROP) :
+ ■(∃ a, Ψ a) ⊣⊢ ∃ a, ■(Ψ a).
+Proof. apply (anti_symm _); auto using plainly_exist_1, plainly_exist_2. Qed.
+Lemma plainly_and P Q : ■(P ∧ Q) ⊣⊢ ■P ∧ ■Q.
+Proof. rewrite !and_alt plainly_forall. by apply forall_proper=> -[]. Qed.
+Lemma plainly_or_2 P Q : ■P ∨ ■Q ⊢ ■(P ∨ Q).
+Proof. rewrite !or_alt -plainly_exist_2. by apply exist_mono=> -[]. Qed.
+Lemma plainly_or `{!BiPlainlyExist PROP} P Q : ■(P ∨ Q) ⊣⊢ ■P ∨ ■Q.
+Proof. rewrite !or_alt plainly_exist. by apply exist_proper=> -[]. Qed.
+Lemma plainly_impl P Q : ■(P → Q) ⊢ ■P → ■Q.
+Proof.
+ apply impl_intro_l; rewrite -plainly_and.
+ apply plainly_mono, impl_elim with P; auto.
+Qed.
+
+Lemma plainly_sep_dup P : ■P ⊣⊢ ■P ∗ ■P.
+Proof.
+ apply (anti_symm _).
+ - rewrite -{1}(idemp bi_and (â– _)%I).
+ by rewrite -{2}(emp_sep (â– _)%I) plainly_and_sep_assoc and_elim_l.
+ - by rewrite plainly_absorb.
+Qed.
+
+Lemma plainly_and_sep_l_1 P Q : ■P ∧ Q ⊢ ■P ∗ Q.
+Proof. by rewrite -{1}(emp_sep Q%I) plainly_and_sep_assoc and_elim_l. Qed.
+Lemma plainly_and_sep_r_1 P Q : P ∧ ■Q ⊢ P ∗ ■Q.
+Proof. by rewrite !(comm _ P) plainly_and_sep_l_1. Qed.
+
+Lemma plainly_True_emp : ■True ⊣⊢@{PROP} ■emp.
+Proof. apply (anti_symm _); eauto using plainly_mono, plainly_emp_intro. Qed.
+Lemma plainly_and_sep P Q : ■(P ∧ Q) ⊢ ■(P ∗ Q).
+Proof.
+ rewrite plainly_and.
+ rewrite -{1}plainly_idemp -plainly_and -{1}(emp_sep Q%I).
+ by rewrite plainly_and_sep_assoc (comm bi_and) plainly_and_emp_elim.
+Qed.
+
+Lemma plainly_affinely_elim P : ■<affine> P ⊣⊢ ■P.
+Proof. by rewrite /bi_affinely plainly_and -plainly_True_emp plainly_pure left_id. Qed.
+
+Lemma intuitionistically_plainly_elim P : □ ■P -∗ □ P.
+Proof. rewrite intuitionistically_affinely plainly_elim_persistently //. Qed.
+Lemma intuitionistically_plainly P : □ ■P -∗ ■□ P.
+Proof.
+ rewrite /bi_intuitionistically plainly_affinely_elim affinely_elim.
+ rewrite persistently_elim_plainly plainly_persistently_elim. done.
+Qed.
+
+Lemma and_sep_plainly P Q : ■P ∧ ■Q ⊣⊢ ■P ∗ ■Q.
+Proof.
+ apply (anti_symm _); auto using plainly_and_sep_l_1.
+ apply and_intro.
+ - by rewrite plainly_absorb.
+ - by rewrite comm plainly_absorb.
+Qed.
+Lemma plainly_sep_2 P Q : ■P ∗ ■Q ⊢ ■(P ∗ Q).
+Proof. by rewrite -plainly_and_sep plainly_and -and_sep_plainly. Qed.
+Lemma plainly_sep `{BiPositive PROP} P Q : ■(P ∗ Q) ⊣⊢ ■P ∗ ■Q.
+Proof.
+ apply (anti_symm _); auto using plainly_sep_2.
+ rewrite -(plainly_affinely_elim (_ ∗ _)%I) affinely_sep -and_sep_plainly. apply and_intro.
+ - by rewrite (affinely_elim_emp Q) right_id affinely_elim.
+ - by rewrite (affinely_elim_emp P) left_id affinely_elim.
+Qed.
+
+Lemma plainly_wand P Q : ■(P -∗ Q) ⊢ ■P -∗ ■Q.
+Proof. apply wand_intro_r. by rewrite plainly_sep_2 wand_elim_l. Qed.
+
+Lemma plainly_entails_l P Q : (P ⊢ ■Q) → P ⊢ ■Q ∗ P.
+Proof. intros; rewrite -plainly_and_sep_l_1; auto. Qed.
+Lemma plainly_entails_r P Q : (P ⊢ ■Q) → P ⊢ P ∗ ■Q.
+Proof. intros; rewrite -plainly_and_sep_r_1; auto. Qed.
+
+Lemma plainly_impl_wand_2 P Q : ■(P -∗ Q) ⊢ ■(P → Q).
+Proof.
+ apply plainly_intro', impl_intro_r.
+ rewrite -{2}(emp_sep P%I) plainly_and_sep_assoc.
+ by rewrite (comm bi_and) plainly_and_emp_elim wand_elim_l.
+Qed.
+
+Lemma impl_wand_plainly_2 P Q : (■P -∗ Q) ⊢ (■P → Q).
+Proof. apply impl_intro_l. by rewrite plainly_and_sep_l_1 wand_elim_r. Qed.
+
+Lemma impl_wand_affinely_plainly P Q : (■P → Q) ⊣⊢ (<affine> ■P -∗ Q).
+Proof. by rewrite -(persistently_elim_plainly P) impl_wand_intuitionistically. Qed.
+
+Lemma persistently_wand_affinely_plainly P Q :
+ (<affine> ■P -∗ <pers> Q) ⊢ <pers> (<affine> ■P -∗ Q).
+Proof. rewrite -!impl_wand_affinely_plainly. apply persistently_impl_plainly. Qed.
+
+Lemma plainly_wand_affinely_plainly P Q :
+ (<affine> ■P -∗ ■Q) ⊢ ■(<affine> ■P -∗ Q).
+Proof. rewrite -!impl_wand_affinely_plainly. apply plainly_impl_plainly. Qed.
+
+Section plainly_affine_bi.
+ Context `{BiAffine PROP}.
+
+ Lemma plainly_emp : ■emp ⊣⊢@{PROP} emp.
+ Proof. by rewrite -!True_emp plainly_pure. Qed.
+
+ Lemma plainly_and_sep_l P Q : ■P ∧ Q ⊣⊢ ■P ∗ Q.
+ Proof.
+ apply (anti_symm (⊢));
+ eauto using plainly_and_sep_l_1, sep_and with typeclass_instances.
+ Qed.
+ Lemma plainly_and_sep_r P Q : P ∧ ■Q ⊣⊢ P ∗ ■Q.
+ Proof. by rewrite !(comm _ P) plainly_and_sep_l. Qed.
+
+ Lemma plainly_impl_wand P Q : ■(P → Q) ⊣⊢ ■(P -∗ Q).
+ Proof.
+ apply (anti_symm (⊢)); auto using plainly_impl_wand_2.
+ apply plainly_intro', wand_intro_l.
+ by rewrite -plainly_and_sep_r plainly_elim impl_elim_r.
+ Qed.
+
+ Lemma impl_wand_plainly P Q : (■P → Q) ⊣⊢ (■P -∗ Q).
+ Proof.
+ apply (anti_symm (⊢)). by rewrite -impl_wand_1. by rewrite impl_wand_plainly_2.
+ Qed.
+End plainly_affine_bi.
+
+(* Conditional plainly *)
+Global Instance plainly_if_ne p : NonExpansive (@plainly_if PROP _ p).
+Proof. solve_proper. Qed.
+Global Instance plainly_if_proper p : Proper ((⊣⊢) ==> (⊣⊢)) (@plainly_if PROP _ p).
+Proof. solve_proper. Qed.
+Global Instance plainly_if_mono' p : Proper ((⊢) ==> (⊢)) (@plainly_if PROP _ p).
+Proof. solve_proper. Qed.
+Global Instance plainly_if_flip_mono' p :
+ Proper (flip (⊢) ==> flip (⊢)) (@plainly_if PROP _ p).
+Proof. solve_proper. Qed.
+
+Lemma plainly_if_mono p P Q : (P ⊢ Q) → ■?p P ⊢ ■?p Q.
+Proof. by intros ->. Qed.
+
+Lemma plainly_if_pure p φ : â– ?p ⌜φ⌠⊣⊢@{PROP} ⌜φâŒ.
+Proof. destruct p; simpl; auto using plainly_pure. Qed.
+Lemma plainly_if_and p P Q : ■?p (P ∧ Q) ⊣⊢ ■?p P ∧ ■?p Q.
+Proof. destruct p; simpl; auto using plainly_and. Qed.
+Lemma plainly_if_or_2 p P Q : ■?p P ∨ ■?p Q ⊢ ■?p (P ∨ Q).
+Proof. destruct p; simpl; auto using plainly_or_2. Qed.
+Lemma plainly_if_or `{!BiPlainlyExist PROP} p P Q : ■?p (P ∨ Q) ⊣⊢ ■?p P ∨ ■?p Q.
+Proof. destruct p; simpl; auto using plainly_or. Qed.
+Lemma plainly_if_exist_2 {A} p (Ψ : A → PROP) : (∃ a, ■?p (Ψ a)) ⊢ ■?p (∃ a, Ψ a).
+Proof. destruct p; simpl; auto using plainly_exist_2. Qed.
+Lemma plainly_if_exist `{!BiPlainlyExist PROP} {A} p (Ψ : A → PROP) :
+ ■?p (∃ a, Ψ a) ⊣⊢ ∃ a, ■?p (Ψ a).
+Proof. destruct p; simpl; auto using plainly_exist. Qed.
+Lemma plainly_if_sep_2 `{!BiPositive PROP} p P Q : ■?p P ∗ ■?p Q ⊢ ■?p (P ∗ Q).
+Proof. destruct p; simpl; auto using plainly_sep_2. Qed.
+
+Lemma plainly_if_idemp p P : ■?p ■?p P ⊣⊢ ■?p P.
+Proof. destruct p; simpl; auto using plainly_idemp. Qed.
+
+(* Properties of plain propositions *)
+Global Instance Plain_proper : Proper ((≡) ==> iff) (@Plain PROP _).
+Proof. solve_proper. Qed.
+
+Lemma plain_plainly_2 P `{!Plain P} : P ⊢ ■P.
+Proof. done. Qed.
+Lemma plain_plainly P `{!Plain P, !Absorbing P} : ■P ⊣⊢ P.
+Proof. apply (anti_symm _), plain_plainly_2, _. by apply plainly_elim. Qed.
+Lemma plainly_intro P Q `{!Plain P} : (P ⊢ Q) → P ⊢ ■Q.
+Proof. by intros <-. Qed.
+
+(* Typeclass instances *)
+Global Instance plainly_absorbing P : Absorbing (â– P).
+Proof. by rewrite /Absorbing /bi_absorbingly comm plainly_absorb. Qed.
+Global Instance plainly_if_absorbing P p :
+ Absorbing P → Absorbing (plainly_if p P).
+Proof. intros; destruct p; simpl; apply _. Qed.
+
+(* Not an instance, see the bottom of this file *)
+Lemma plain_persistent P : Plain P → Persistent P.
+Proof. intros. by rewrite /Persistent -plainly_elim_persistently. Qed.
+
+(* Not an instance, see the bottom of this file *)
+Lemma impl_persistent P Q :
+ Absorbing P → Plain P → Persistent Q → Persistent (P → Q).
+Proof.
+ intros. by rewrite /Persistent {2}(plain P) -persistently_impl_plainly
+ -(persistent Q) (plainly_into_absorbingly P) absorbing.
+Qed.
+
+Global Instance plainly_persistent P : Persistent (â– P).
+Proof. by rewrite /Persistent persistently_elim_plainly. Qed.
+
+Global Instance wand_persistent P Q :
+ Plain P → Persistent Q → Absorbing Q → Persistent (P -∗ Q).
+Proof.
+ intros. rewrite /Persistent {2}(plain P). trans (<pers> (■P → Q))%I.
+ - rewrite -persistently_impl_plainly impl_wand_affinely_plainly -(persistent Q).
+ by rewrite affinely_plainly_elim.
+ - apply persistently_mono, wand_intro_l. by rewrite sep_and impl_elim_r.
+Qed.
+
+(* Instances for big operators *)
+Global Instance plainly_and_homomorphism :
+ MonoidHomomorphism bi_and bi_and (≡) (@plainly PROP _).
+Proof.
+ split; [split|]; try apply _. apply plainly_and. apply plainly_pure.
+Qed.
+
+Global Instance plainly_or_homomorphism `{!BiPlainlyExist PROP} :
+ MonoidHomomorphism bi_or bi_or (≡) (@plainly PROP _).
+Proof.
+ split; [split|]; try apply _. apply plainly_or. apply plainly_pure.
+Qed.
+
+Global Instance plainly_sep_weak_homomorphism `{!BiPositive PROP, !BiAffine PROP} :
+ WeakMonoidHomomorphism bi_sep bi_sep (≡) (@plainly PROP _).
+Proof. split; try apply _. apply plainly_sep. Qed.
+
+Global Instance plainly_sep_homomorphism `{BiAffine PROP} :
+ MonoidHomomorphism bi_sep bi_sep (≡) (@plainly PROP _).
+Proof. split. apply _. apply plainly_emp. Qed.
+
+Global Instance plainly_sep_entails_weak_homomorphism :
+ WeakMonoidHomomorphism bi_sep bi_sep (flip (⊢)) (@plainly PROP _).
+Proof. split; try apply _. intros P Q; by rewrite plainly_sep_2. Qed.
+
+Global Instance plainly_sep_entails_homomorphism `{!BiAffine PROP} :
+ MonoidHomomorphism bi_sep bi_sep (flip (⊢)) (@plainly PROP _).
+Proof. split. apply _. simpl. rewrite plainly_emp. done. Qed.
+
+Global Instance limit_preserving_Plain {A:ofeT} `{Cofe A} (Φ : A → PROP) :
+ NonExpansive Φ → LimitPreserving (λ x, Plain (Φ x)).
+Proof. intros. apply limit_preserving_entails; solve_proper. Qed.
+
+(* Plainness instances *)
+Global Instance pure_plain φ : Plain (PROP:=PROP) ⌜φâŒ.
+Proof. by rewrite /Plain plainly_pure. Qed.
+Global Instance emp_plain : Plain (PROP:=PROP) emp.
+Proof. apply plainly_emp_intro. Qed.
+Global Instance and_plain P Q : Plain P → Plain Q → Plain (P ∧ Q).
+Proof. intros. by rewrite /Plain plainly_and -!plain. Qed.
+Global Instance or_plain P Q : Plain P → Plain Q → Plain (P ∨ Q).
+Proof. intros. by rewrite /Plain -plainly_or_2 -!plain. Qed.
+Global Instance forall_plain {A} (Ψ : A → PROP) :
+ (∀ x, Plain (Ψ x)) → Plain (∀ x, Ψ x).
+Proof.
+ intros. rewrite /Plain plainly_forall. apply forall_mono=> x. by rewrite -plain.
+Qed.
+Global Instance exist_plain {A} (Ψ : A → PROP) :
+ (∀ x, Plain (Ψ x)) → Plain (∃ x, Ψ x).
+Proof.
+ intros. rewrite /Plain -plainly_exist_2. apply exist_mono=> x. by rewrite -plain.
+Qed.
+
+Global Instance impl_plain P Q : Absorbing P → Plain P → Plain Q → Plain (P → Q).
+Proof.
+ intros. by rewrite /Plain {2}(plain P) -plainly_impl_plainly -(plain Q)
+ (plainly_into_absorbingly P) absorbing.
+Qed.
+Global Instance wand_plain P Q :
+ Plain P → Plain Q → Absorbing Q → Plain (P -∗ Q).
+Proof.
+ intros. rewrite /Plain {2}(plain P). trans (■(■P → Q))%I.
+ - rewrite -plainly_impl_plainly impl_wand_affinely_plainly -(plain Q).
+ by rewrite affinely_plainly_elim.
+ - apply plainly_mono, wand_intro_l. by rewrite sep_and impl_elim_r.
+Qed.
+Global Instance sep_plain P Q : Plain P → Plain Q → Plain (P ∗ Q).
+Proof. intros. by rewrite /Plain -plainly_sep_2 -!plain. Qed.
+
+Global Instance plainly_plain P : Plain (â– P).
+Proof. by rewrite /Plain plainly_idemp. Qed.
+Global Instance persistently_plain P : Plain P → Plain (<pers> P).
+Proof.
+ rewrite /Plain=> HP. rewrite {1}HP plainly_persistently_elim persistently_elim_plainly //.
+Qed.
+Global Instance affinely_plain P : Plain P → Plain (<affine> P).
+Proof. rewrite /bi_affinely. apply _. Qed.
+Global Instance intuitionistically_plain P : Plain P → Plain (□ P).
+Proof. rewrite /bi_intuitionistically. apply _. Qed.
+Global Instance absorbingly_plain P : Plain P → Plain (<absorb> P).
+Proof. rewrite /bi_absorbingly. apply _. Qed.
+Global Instance from_option_plain {A} P (Ψ : A → PROP) (mx : option A) :
+ (∀ x, Plain (Ψ x)) → Plain P → Plain (from_option Ψ P mx).
+Proof. destruct mx; apply _. Qed.
+
+(* Interaction with equality *)
+Lemma plainly_internal_eq {A:ofeT} (a b : A) : ■(a ≡ b) ⊣⊢@{PROP} a ≡ b.
+Proof.
+ apply (anti_symm (⊢)).
+ { by rewrite plainly_elim. }
+ apply (internal_eq_rewrite' a b (λ b, ■(a ≡ b))%I); [solve_proper|done|].
+ rewrite -(internal_eq_refl True%I a) plainly_pure; auto.
+Qed.
+
+Lemma plainly_alt P : ■P ⊣⊢ <affine> P ≡ emp.
+Proof.
+ rewrite -plainly_affinely_elim. apply (anti_symm (⊢)).
+ - rewrite -prop_ext. apply plainly_mono, and_intro; apply wand_intro_l.
+ + by rewrite affinely_elim_emp left_id.
+ + by rewrite left_id.
+ - rewrite internal_eq_sym (internal_eq_rewrite _ _ plainly).
+ by rewrite -plainly_True_emp plainly_pure True_impl.
+Qed.
+
+Lemma plainly_alt_absorbing P `{!Absorbing P} : ■P ⊣⊢ P ≡ True.
+Proof.
+ apply (anti_symm (⊢)).
+ - rewrite -prop_ext. apply plainly_mono, and_intro; apply wand_intro_l; auto.
+ - rewrite internal_eq_sym (internal_eq_rewrite _ _ plainly).
+ by rewrite plainly_pure True_impl.
+Qed.
+
+Lemma plainly_True_alt P : ■(True -∗ P) ⊣⊢ P ≡ True.
+Proof.
+ apply (anti_symm (⊢)).
+ - rewrite -prop_ext. apply plainly_mono, and_intro; apply wand_intro_l; auto.
+ by rewrite wand_elim_r.
+ - rewrite internal_eq_sym (internal_eq_rewrite _ _
+ (λ Q, ■(True -∗ Q))%I ltac:(shelve)); last solve_proper.
+ by rewrite -entails_wand // -(plainly_emp_intro True%I) True_impl.
+Qed.
+
+(* Interaction with â–· *)
+Lemma later_plainly P : ▷ ■P ⊣⊢ ■▷ P.
+Proof. apply (anti_symm _); auto using later_plainly_1, later_plainly_2. Qed.
+Lemma laterN_plainly n P : ▷^n ■P ⊣⊢ ■▷^n P.
+Proof. induction n as [|n IH]; simpl; auto. by rewrite IH later_plainly. Qed.
+
+Lemma later_plainly_if p P : ▷ ■?p P ⊣⊢ ■?p ▷ P.
+Proof. destruct p; simpl; auto using later_plainly. Qed.
+Lemma laterN_plainly_if n p P : ▷^n ■?p P ⊣⊢ ■?p (▷^n P).
+Proof. destruct p; simpl; auto using laterN_plainly. Qed.
+
+Lemma except_0_plainly_1 P : ◇ ■P ⊢ ■◇ P.
+Proof. by rewrite /sbi_except_0 -plainly_or_2 -later_plainly plainly_pure. Qed.
+Lemma except_0_plainly `{!BiPlainlyExist PROP} P : ◇ ■P ⊣⊢ ■◇ P.
+Proof. by rewrite /sbi_except_0 plainly_or -later_plainly plainly_pure. Qed.
+
+Global Instance internal_eq_plain {A : ofeT} (a b : A) :
+ Plain (PROP:=PROP) (a ≡ b).
+Proof. by intros; rewrite /Plain plainly_internal_eq. Qed.
+
+Global Instance later_plain P : Plain P → Plain (▷ P).
+Proof. intros. by rewrite /Plain -later_plainly {1}(plain P). Qed.
+Global Instance laterN_plain n P : Plain P → Plain (▷^n P).
+Proof. induction n; apply _. Qed.
+Global Instance except_0_plain P : Plain P → Plain (◇ P).
+Proof. rewrite /sbi_except_0; apply _. Qed.
+
+Global Instance plainly_timeless P `{!BiPlainlyExist PROP} :
+ Timeless P → Timeless (■P).
+Proof.
+ intros. rewrite /Timeless /sbi_except_0 later_plainly_1.
+ by rewrite (timeless P) /sbi_except_0 plainly_or {1}plainly_elim.
+Qed.
+End plainly_derived.
+
+(* When declared as an actual instance, [plain_persistent] will cause
+failing proof searches to take exponential time, as Coq will try to
+apply it the instance at any node in the proof search tree.
+
+To avoid that, we declare it using a [Hint Immediate], so that it will
+only be used at the leaves of the proof search tree, i.e. when the
+premise of the hint can be derived from just the current context. *)
+Hint Immediate plain_persistent : typeclass_instances.
+
+(* Not defined using an ordinary [Instance] because the default
+[class_apply @impl_persistent] shelves the [BiPlainly] premise, making proof
+search for the other premises fail. See the proof of [coreP_persistent] for an
+example where it would fail with a regular [Instance].*)
+Hint Extern 4 (Persistent (_ → _)) => eapply @impl_persistent : typeclass_instances.
diff --git a/theories/base_logic/tactics.v b/theories/bi/tactics.v
similarity index 71%
rename from theories/base_logic/tactics.v
rename to theories/bi/tactics.v
index 49085be989a91b7b36a51a6dfb470d3cb663aafe..8674be92407f9cbb82304ad25451edef2cd4e397 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 => default 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, default 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 `{BiAffine 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/bi/telescopes.v b/theories/bi/telescopes.v
new file mode 100644
index 0000000000000000000000000000000000000000..d54533929a945c82d8872083527dacbaaff6251c
--- /dev/null
+++ b/theories/bi/telescopes.v
@@ -0,0 +1,82 @@
+From stdpp Require Export telescopes.
+From iris.bi Require Export bi.
+Set Default Proof Using "Type*".
+Import bi.
+
+(* This cannot import the proofmode because it is imported by the proofmode! *)
+
+(** Telescopic quantifiers *)
+Definition bi_texist {PROP : bi} {TT : tele} (Ψ : TT → PROP) : PROP :=
+ tele_fold (@bi_exist PROP) (λ x, x) (tele_bind Ψ).
+Arguments bi_texist {_ !_} _ /.
+Definition bi_tforall {PROP : bi} {TT : tele} (Ψ : TT → PROP) : PROP :=
+ tele_fold (@bi_forall PROP) (λ x, x) (tele_bind Ψ).
+Arguments bi_tforall {_ !_} _ /.
+
+Notation "'∃..' x .. y , P" := (bi_texist (λ x, .. (bi_texist (λ y, P)) .. )%I)
+ (at level 200, x binder, y binder, right associativity,
+ format "∃.. x .. y , P") : bi_scope.
+Notation "'∀..' x .. y , P" := (bi_tforall (λ x, .. (bi_tforall (λ y, P)) .. )%I)
+ (at level 200, x binder, y binder, right associativity,
+ format "∀.. x .. y , P") : bi_scope.
+
+Section telescope_quantifiers.
+ Context {PROP : bi} {TT : tele}.
+
+ Lemma bi_tforall_forall (Ψ : TT → PROP) :
+ bi_tforall Ψ ⊣⊢ bi_forall Ψ.
+ Proof.
+ symmetry. unfold bi_tforall. induction TT as [|X ft IH].
+ - simpl. apply (anti_symm _).
+ + by rewrite (forall_elim TargO).
+ + rewrite -forall_intro; first done.
+ intros p. rewrite (tele_arg_O_inv p) /= //.
+ - simpl. apply (anti_symm _); apply forall_intro; intros a.
+ + rewrite /= -IH. apply forall_intro; intros p.
+ by rewrite (forall_elim (TargS a p)).
+ + move/tele_arg_inv : (a) => [x [pf ->]] {a} /=.
+ setoid_rewrite <- IH.
+ rewrite 2!forall_elim. done.
+ Qed.
+
+ Lemma bi_texist_exist (Ψ : TT → PROP) :
+ bi_texist Ψ ⊣⊢ bi_exist Ψ.
+ Proof.
+ symmetry. unfold bi_texist. induction TT as [|X ft IH].
+ - simpl. apply (anti_symm _).
+ + apply exist_elim; intros p.
+ rewrite (tele_arg_O_inv p) //.
+ + by rewrite -(exist_intro TargO).
+ - simpl. apply (anti_symm _); apply exist_elim.
+ + intros p. move/tele_arg_inv: (p) => [x [pf ->]] {p} /=.
+ by rewrite -exist_intro -IH -exist_intro.
+ + intros x.
+ rewrite /= -IH. apply exist_elim; intros p.
+ by rewrite -(exist_intro (TargS x p)).
+ Qed.
+
+ Global Instance bi_tforall_ne n :
+ Proper (pointwise_relation _ (dist n) ==> dist n) (@bi_tforall PROP TT).
+ Proof.
+ intros ?? EQ. rewrite !bi_tforall_forall. rewrite EQ //.
+ Qed.
+
+ Global Instance bi_tforall_proper :
+ Proper (pointwise_relation _ (⊣⊢) ==> (⊣⊢)) (@bi_tforall PROP TT).
+ Proof.
+ intros ?? EQ. rewrite !bi_tforall_forall. rewrite EQ //.
+ Qed.
+
+ Global Instance bi_texist_ne n :
+ Proper (pointwise_relation _ (dist n) ==> dist n) (@bi_texist PROP TT).
+ Proof.
+ intros ?? EQ. rewrite !bi_texist_exist. rewrite EQ //.
+ Qed.
+
+ Global Instance bi_texist_proper :
+ Proper (pointwise_relation _ (⊣⊢) ==> (⊣⊢)) (@bi_texist PROP TT).
+ Proof.
+ intros ?? EQ. rewrite !bi_texist_exist. rewrite EQ //.
+ Qed.
+
+End telescope_quantifiers.
diff --git a/theories/bi/updates.v b/theories/bi/updates.v
new file mode 100644
index 0000000000000000000000000000000000000000..1e63f5b738c57e69b7953a9a49545f47137c8a9f
--- /dev/null
+++ b/theories/bi/updates.v
@@ -0,0 +1,312 @@
+From stdpp Require Import coPset.
+From iris.bi Require Import interface derived_laws_sbi big_op plainly.
+Import interface.bi derived_laws_bi.bi derived_laws_sbi.bi.
+
+(* We first define operational type classes for the notations, and then later
+bundle these operational type classes with the laws. *)
+Class BUpd (PROP : Type) : Type := bupd : PROP → PROP.
+Instance : Params (@bupd) 2.
+Hint Mode BUpd ! : typeclass_instances.
+
+Notation "|==> Q" := (bupd Q) : bi_scope.
+Notation "P ==∗ Q" := (P ⊢ |==> Q) (only parsing) : stdpp_scope.
+Notation "P ==∗ Q" := (P -∗ |==> Q)%I : bi_scope.
+
+Class FUpd (PROP : Type) : Type := fupd : coPset → coPset → PROP → PROP.
+Instance: Params (@fupd) 4.
+Hint Mode FUpd ! : typeclass_instances.
+
+Notation "|={ E1 , E2 }=> Q" := (fupd E1 E2 Q) : bi_scope.
+Notation "P ={ E1 , E2 }=∗ Q" := (P -∗ |={E1,E2}=> Q)%I : bi_scope.
+Notation "P ={ E1 , E2 }=∗ Q" := (P -∗ |={E1,E2}=> Q) : stdpp_scope.
+
+Notation "|={ E }=> Q" := (fupd E E Q) : bi_scope.
+Notation "P ={ E }=∗ Q" := (P -∗ |={E}=> Q)%I : bi_scope.
+Notation "P ={ E }=∗ Q" := (P -∗ |={E}=> Q) : stdpp_scope.
+
+(** Fancy updates that take a step. *)
+Notation "|={ E1 , E2 , E3 }â–·=> Q" := (|={E1,E2}=> (â–· |={E2,E3}=> Q))%I : bi_scope.
+Notation "P ={ E1 , E2 , E3 }▷=∗ Q" := (P -∗ |={ E1,E2,E3 }▷=> Q)%I : bi_scope.
+Notation "|={ E1 , E2 }â–·=> Q" := (|={E1,E2,E1}â–·=> Q)%I : bi_scope.
+Notation "P ={ E1 , E2 }▷=∗ Q" := (P -∗ |={ E1 , E2, E1 }▷=> Q)%I : bi_scope.
+Notation "|={ E }â–·=> Q" := (|={E,E}â–·=> Q)%I : bi_scope.
+Notation "P ={ E }▷=∗ Q" := (P ={E,E}▷=∗ Q)%I : bi_scope.
+
+(** Bundled versions *)
+(* Mixins allow us to create instances easily without having to use Program *)
+Record BiBUpdMixin (PROP : bi) `(BUpd PROP) := {
+ bi_bupd_mixin_bupd_ne : NonExpansive bupd;
+ bi_bupd_mixin_bupd_intro (P : PROP) : P ==∗ P;
+ bi_bupd_mixin_bupd_mono (P Q : PROP) : (P ⊢ Q) → (|==> P) ==∗ Q;
+ bi_bupd_mixin_bupd_trans (P : PROP) : (|==> |==> P) ==∗ P;
+ bi_bupd_mixin_bupd_frame_r (P R : PROP) : (|==> P) ∗ R ==∗ P ∗ R;
+}.
+
+Record BiFUpdMixin (PROP : sbi) `(FUpd PROP) := {
+ bi_fupd_mixin_fupd_ne E1 E2 : NonExpansive (fupd E1 E2);
+ bi_fupd_mixin_fupd_intro_mask E1 E2 (P : PROP) : E2 ⊆ E1 → P ⊢ |={E1,E2}=> |={E2,E1}=> P;
+ bi_fupd_mixin_except_0_fupd E1 E2 (P : PROP) : ◇ (|={E1,E2}=> P) ={E1,E2}=∗ P;
+ bi_fupd_mixin_fupd_mono E1 E2 (P Q : PROP) : (P ⊢ Q) → (|={E1,E2}=> P) ⊢ |={E1,E2}=> Q;
+ bi_fupd_mixin_fupd_trans E1 E2 E3 (P : PROP) : (|={E1,E2}=> |={E2,E3}=> P) ⊢ |={E1,E3}=> P;
+ bi_fupd_mixin_fupd_mask_frame_r' E1 E2 Ef (P : PROP) :
+ E1 ## Ef → (|={E1,E2}=> ⌜E2 ## Ef⌠→ P) ={E1 ∪ Ef,E2 ∪ Ef}=∗ P;
+ bi_fupd_mixin_fupd_frame_r E1 E2 (P Q : PROP) : (|={E1,E2}=> P) ∗ Q ={E1,E2}=∗ P ∗ Q;
+}.
+
+Class BiBUpd (PROP : bi) := {
+ bi_bupd_bupd :> BUpd PROP;
+ bi_bupd_mixin : BiBUpdMixin PROP bi_bupd_bupd;
+}.
+Hint Mode BiBUpd ! : typeclass_instances.
+Arguments bi_bupd_bupd : simpl never.
+
+Class BiFUpd (PROP : sbi) := {
+ bi_fupd_fupd :> FUpd PROP;
+ bi_fupd_mixin : BiFUpdMixin PROP bi_fupd_fupd;
+}.
+Hint Mode BiFUpd ! : typeclass_instances.
+Arguments bi_fupd_fupd : simpl never.
+
+Class BiBUpdFUpd (PROP : sbi) `{BiBUpd PROP, BiFUpd PROP} :=
+ bupd_fupd E (P : PROP) : (|==> P) ={E}=∗ P.
+Hint Mode BiBUpdFUpd ! - - : typeclass_instances.
+
+Class BiBUpdPlainly (PROP : sbi) `{!BiBUpd PROP, !BiPlainly PROP} :=
+ bupd_plainly (P : PROP) : (|==> ■P) -∗ P.
+Hint Mode BiBUpdPlainly ! - - : typeclass_instances.
+
+Class BiFUpdPlainly (PROP : sbi) `{!BiFUpd PROP, !BiPlainly PROP} := {
+ fupd_plain' E1 E2 E2' (P Q : PROP) `{!Plain P} :
+ E1 ⊆ E2 →
+ (Q ={E1, E2'}=∗ P) -∗ (|={E1, E2}=> Q) ={E1}=∗ (|={E1, E2}=> Q) ∗ P;
+ later_fupd_plain E (P : PROP) `{!Plain P} :
+ (▷ |={E}=> P) ={E}=∗ ▷ ◇ P;
+}.
+Hint Mode BiBUpdFUpd ! - - : typeclass_instances.
+
+Section bupd_laws.
+ Context `{BiBUpd PROP}.
+ Implicit Types P : PROP.
+
+ Global Instance bupd_ne : NonExpansive (@bupd PROP _).
+ Proof. eapply bi_bupd_mixin_bupd_ne, bi_bupd_mixin. Qed.
+ Lemma bupd_intro P : P ==∗ P.
+ Proof. eapply bi_bupd_mixin_bupd_intro, bi_bupd_mixin. Qed.
+ Lemma bupd_mono (P Q : PROP) : (P ⊢ Q) → (|==> P) ==∗ Q.
+ Proof. eapply bi_bupd_mixin_bupd_mono, bi_bupd_mixin. Qed.
+ Lemma bupd_trans (P : PROP) : (|==> |==> P) ==∗ P.
+ Proof. eapply bi_bupd_mixin_bupd_trans, bi_bupd_mixin. Qed.
+ Lemma bupd_frame_r (P R : PROP) : (|==> P) ∗ R ==∗ P ∗ R.
+ Proof. eapply bi_bupd_mixin_bupd_frame_r, bi_bupd_mixin. Qed.
+End bupd_laws.
+
+Section fupd_laws.
+ Context `{BiFUpd PROP}.
+ Implicit Types P : PROP.
+
+ Global Instance fupd_ne E1 E2 : NonExpansive (@fupd PROP _ E1 E2).
+ Proof. eapply bi_fupd_mixin_fupd_ne, bi_fupd_mixin. Qed.
+ Lemma fupd_intro_mask E1 E2 (P : PROP) : E2 ⊆ E1 → P ⊢ |={E1,E2}=> |={E2,E1}=> P.
+ Proof. eapply bi_fupd_mixin_fupd_intro_mask, bi_fupd_mixin. Qed.
+ Lemma except_0_fupd E1 E2 (P : PROP) : ◇ (|={E1,E2}=> P) ={E1,E2}=∗ P.
+ Proof. eapply bi_fupd_mixin_except_0_fupd, bi_fupd_mixin. Qed.
+ Lemma fupd_mono E1 E2 (P Q : PROP) : (P ⊢ Q) → (|={E1,E2}=> P) ⊢ |={E1,E2}=> Q.
+ Proof. eapply bi_fupd_mixin_fupd_mono, bi_fupd_mixin. Qed.
+ Lemma fupd_trans E1 E2 E3 (P : PROP) : (|={E1,E2}=> |={E2,E3}=> P) ⊢ |={E1,E3}=> P.
+ Proof. eapply bi_fupd_mixin_fupd_trans, bi_fupd_mixin. Qed.
+ Lemma fupd_mask_frame_r' E1 E2 Ef (P : PROP) :
+ E1 ## Ef → (|={E1,E2}=> ⌜E2 ## Ef⌠→ P) ={E1 ∪ Ef,E2 ∪ Ef}=∗ P.
+ Proof. eapply bi_fupd_mixin_fupd_mask_frame_r', bi_fupd_mixin. Qed.
+ Lemma fupd_frame_r E1 E2 (P Q : PROP) : (|={E1,E2}=> P) ∗ Q ={E1,E2}=∗ P ∗ Q.
+ Proof. eapply bi_fupd_mixin_fupd_frame_r, bi_fupd_mixin. Qed.
+End fupd_laws.
+
+Section bupd_derived.
+ Context `{BiBUpd PROP}.
+ Implicit Types P Q R : PROP.
+
+ (* FIXME: Removing the `PROP:=` diverges. *)
+ Global Instance bupd_proper :
+ Proper ((≡) ==> (≡)) (bupd (PROP:=PROP)) := ne_proper _.
+
+ (** BUpd derived rules *)
+ Global Instance bupd_mono' : Proper ((⊢) ==> (⊢)) (bupd (PROP:=PROP)).
+ Proof. intros P Q; apply bupd_mono. Qed.
+ Global Instance bupd_flip_mono' : Proper (flip (⊢) ==> flip (⊢)) (bupd (PROP:=PROP)).
+ Proof. intros P Q; apply bupd_mono. Qed.
+
+ Lemma bupd_frame_l R Q : (R ∗ |==> Q) ==∗ R ∗ Q.
+ Proof. rewrite !(comm _ R); apply bupd_frame_r. Qed.
+ Lemma bupd_wand_l P Q : (P -∗ Q) ∗ (|==> P) ==∗ Q.
+ Proof. by rewrite bupd_frame_l wand_elim_l. Qed.
+ Lemma bupd_wand_r P Q : (|==> P) ∗ (P -∗ Q) ==∗ Q.
+ Proof. by rewrite bupd_frame_r wand_elim_r. Qed.
+ Lemma bupd_sep P Q : (|==> P) ∗ (|==> Q) ==∗ P ∗ Q.
+ Proof. by rewrite bupd_frame_r bupd_frame_l bupd_trans. Qed.
+End bupd_derived.
+
+Section bupd_derived_sbi.
+ Context {PROP : sbi} `{BiBUpd PROP}.
+ Implicit Types P Q R : PROP.
+
+ Lemma except_0_bupd P : ◇ (|==> P) ⊢ (|==> ◇ P).
+ Proof.
+ rewrite /sbi_except_0. apply or_elim; eauto using bupd_mono, or_intro_r.
+ by rewrite -bupd_intro -or_intro_l.
+ Qed.
+
+ Lemma bupd_plain P `{BiBUpdPlainly PROP, !Plain P} : (|==> P) ⊢ P.
+ Proof. by rewrite {1}(plain P) bupd_plainly. Qed.
+End bupd_derived_sbi.
+
+Section fupd_derived.
+ Context `{BiFUpd PROP}.
+ Implicit Types P Q R : PROP.
+
+ Global Instance fupd_proper E1 E2 :
+ Proper ((≡) ==> (≡)) (fupd (PROP:=PROP) E1 E2) := ne_proper _.
+
+ (** FUpd derived rules *)
+ Global Instance fupd_mono' E1 E2 : Proper ((⊢) ==> (⊢)) (fupd (PROP:=PROP) E1 E2).
+ Proof. intros P Q; apply fupd_mono. Qed.
+ Global Instance fupd_flip_mono' E1 E2 :
+ Proper (flip (⊢) ==> flip (⊢)) (fupd (PROP:=PROP) E1 E2).
+ Proof. intros P Q; apply fupd_mono. Qed.
+
+ Lemma fupd_intro E P : P ={E}=∗ P.
+ Proof. by rewrite {1}(fupd_intro_mask E E P) // fupd_trans. Qed.
+ Lemma fupd_intro_mask' E1 E2 : E2 ⊆ E1 → (|={E1,E2}=> |={E2,E1}=> bi_emp (PROP:=PROP))%I.
+ Proof. exact: fupd_intro_mask. Qed.
+ Lemma fupd_except_0 E1 E2 P : (|={E1,E2}=> ◇ P) ={E1,E2}=∗ P.
+ Proof. by rewrite {1}(fupd_intro E2 P) except_0_fupd fupd_trans. Qed.
+
+ Lemma fupd_frame_l E1 E2 P Q : (P ∗ |={E1,E2}=> Q) ={E1,E2}=∗ P ∗ Q.
+ Proof. rewrite !(comm _ P); apply fupd_frame_r. Qed.
+ Lemma fupd_wand_l E1 E2 P Q : (P -∗ Q) ∗ (|={E1,E2}=> P) ={E1,E2}=∗ Q.
+ Proof. by rewrite fupd_frame_l wand_elim_l. Qed.
+ Lemma fupd_wand_r E1 E2 P Q : (|={E1,E2}=> P) ∗ (P -∗ Q) ={E1,E2}=∗ Q.
+ Proof. by rewrite fupd_frame_r wand_elim_r. Qed.
+
+ Lemma fupd_trans_frame E1 E2 E3 P Q :
+ ((Q ={E2,E3}=∗ emp) ∗ |={E1,E2}=> (Q ∗ P)) ={E1,E3}=∗ P.
+ Proof.
+ rewrite fupd_frame_l assoc -(comm _ Q) wand_elim_r.
+ by rewrite fupd_frame_r left_id fupd_trans.
+ Qed.
+
+ Lemma fupd_elim E1 E2 E3 P Q :
+ (Q -∗ (|={E2,E3}=> P)) → (|={E1,E2}=> Q) -∗ (|={E1,E3}=> P).
+ Proof. intros ->. rewrite fupd_trans //. Qed.
+
+ Lemma fupd_mask_frame_r E1 E2 Ef P :
+ E1 ## Ef → (|={E1,E2}=> P) ={E1 ∪ Ef,E2 ∪ Ef}=∗ P.
+ Proof.
+ intros ?. rewrite -fupd_mask_frame_r' //. f_equiv.
+ apply impl_intro_l, and_elim_r.
+ Qed.
+ Lemma fupd_mask_mono E1 E2 P : E1 ⊆ E2 → (|={E1}=> P) ={E2}=∗ P.
+ Proof.
+ intros (Ef&->&?)%subseteq_disjoint_union_L. by apply fupd_mask_frame_r.
+ Qed.
+ (** How to apply an arbitrary mask-changing view shift when having
+ an arbitrary mask. *)
+ Lemma fupd_mask_frame E E' E1 E2 P :
+ E1 ⊆ E →
+ (|={E1,E2}=> |={E2 ∪ (E ∖ E1),E'}=> P) -∗ (|={E,E'}=> P).
+ Proof.
+ intros ?. rewrite (fupd_mask_frame_r _ _ (E ∖ E1)); last set_solver.
+ rewrite fupd_trans.
+ assert (E = E1 ∪ E ∖ E1) as <-; last done.
+ apply union_difference_L. done.
+ Qed.
+ (* A variant of [fupd_mask_frame] that works well for accessors: Tailored to
+ elliminate updates of the form [|={E1,E1∖E2}=> Q] and provides a way to
+ transform the closing view shift instead of letting you prove the same
+ side-conditions twice. *)
+ Lemma fupd_mask_frame_acc E E' E1(*Eo*) E2(*Em*) P Q :
+ E1 ⊆ E →
+ (|={E1,E1∖E2}=> Q) -∗
+ (Q -∗ |={E∖E2,E'}=> (∀ R, (|={E1∖E2,E1}=> R) -∗ |={E∖E2,E}=> R) -∗ P) -∗
+ (|={E,E'}=> P).
+ Proof.
+ intros HE. apply wand_intro_r. rewrite fupd_frame_r.
+ rewrite wand_elim_r. clear Q.
+ rewrite -(fupd_mask_frame E E'); first apply fupd_mono; last done.
+ (* The most horrible way to apply fupd_intro_mask *)
+ rewrite -[X in (X -∗ _)](right_id emp%I).
+ rewrite (fupd_intro_mask (E1 ∖ E2 ∪ E ∖ E1) (E ∖ E2) emp%I); last first.
+ { rewrite {1}(union_difference_L _ _ HE). set_solver. }
+ rewrite fupd_frame_l fupd_frame_r. apply fupd_elim.
+ apply fupd_mono.
+ eapply wand_apply;
+ last (apply sep_mono; first reflexivity); first reflexivity.
+ apply forall_intro=>R. apply wand_intro_r.
+ rewrite fupd_frame_r. apply fupd_elim. rewrite left_id.
+ rewrite (fupd_mask_frame_r _ _ (E ∖ E1)); last set_solver+.
+ rewrite {4}(union_difference_L _ _ HE). done.
+ Qed.
+
+ Lemma fupd_mask_same E E1 P :
+ E = E1 → (|={E}=> P) -∗ (|={E,E1}=> P).
+ Proof. intros <-. done. Qed.
+
+ Lemma fupd_sep E P Q : (|={E}=> P) ∗ (|={E}=> Q) ={E}=∗ P ∗ Q.
+ Proof. by rewrite fupd_frame_r fupd_frame_l fupd_trans. Qed.
+ Lemma fupd_big_sepL {A} E (Φ : nat → A → PROP) (l : list A) :
+ ([∗ list] k↦x ∈ l, |={E}=> Φ k x) ={E}=∗ [∗ list] k↦x ∈ l, Φ k x.
+ Proof.
+ apply (big_opL_forall (λ P Q, P ={E}=∗ Q)); auto using fupd_intro.
+ intros P1 P2 HP Q1 Q2 HQ. by rewrite HP HQ -fupd_sep.
+ Qed.
+ Lemma fupd_big_sepM `{Countable K} {A} E (Φ : K → A → PROP) (m : gmap K A) :
+ ([∗ map] k↦x ∈ m, |={E}=> Φ k x) ={E}=∗ [∗ map] k↦x ∈ m, Φ k x.
+ Proof.
+ apply (big_opM_forall (λ P Q, P ={E}=∗ Q)); auto using fupd_intro.
+ intros P1 P2 HP Q1 Q2 HQ. by rewrite HP HQ -fupd_sep.
+ Qed.
+ Lemma fupd_big_sepS `{Countable A} E (Φ : A → PROP) X :
+ ([∗ set] x ∈ X, |={E}=> Φ x) ={E}=∗ [∗ set] x ∈ X, Φ x.
+ Proof.
+ apply (big_opS_forall (λ P Q, P ={E}=∗ Q)); auto using fupd_intro.
+ intros P1 P2 HP Q1 Q2 HQ. by rewrite HP HQ -fupd_sep.
+ Qed.
+
+ Lemma fupd_plain `{BiPlainly PROP, !BiFUpdPlainly PROP} E1 E2 P Q `{!Plain P} :
+ E1 ⊆ E2 → (Q -∗ P) -∗ (|={E1, E2}=> Q) ={E1}=∗ (|={E1, E2}=> Q) ∗ P.
+ Proof.
+ intros HE. rewrite -(fupd_plain' _ _ E1) //. apply wand_intro_l.
+ by rewrite wand_elim_r -fupd_intro.
+ Qed.
+
+ (** Fancy updates that take a step derived rules. *)
+ Lemma step_fupd_wand E1 E2 E3 P Q : (|={E1,E2,E3}▷=> P) -∗ (P -∗ Q) -∗ |={E1,E2,E3}▷=> Q.
+ Proof.
+ apply wand_intro_l.
+ by rewrite (later_intro (P -∗ Q)%I) fupd_frame_l -later_sep fupd_frame_l
+ wand_elim_l.
+ Qed.
+
+ Lemma step_fupd_mask_frame_r E1 E2 E3 Ef P :
+ E1 ## Ef → E2 ## Ef → (|={E1,E2,E3}▷=> P) ⊢ |={E1 ∪ Ef,E2 ∪ Ef,E3 ∪ Ef}▷=> P.
+ Proof.
+ intros. rewrite -fupd_mask_frame_r //. do 2 f_equiv. by apply fupd_mask_frame_r.
+ Qed.
+
+ Lemma step_fupd_mask_mono E1 E2 F1 F2 P :
+ F1 ⊆ F2 → E1 ⊆ E2 → (|={E1,F2}▷=> P) ⊢ |={E2,F1}▷=> P.
+ Proof.
+ intros ??. rewrite -(emp_sep (|={E1,F2}â–·=> P)%I).
+ rewrite (fupd_intro_mask E2 E1 emp%I) //.
+ rewrite fupd_frame_r -(fupd_trans E2 E1 F1). f_equiv.
+ rewrite fupd_frame_l -(fupd_trans E1 F2 F1). f_equiv.
+ rewrite (fupd_intro_mask F2 F1 (|={_,_}=> emp)%I) //.
+ rewrite fupd_frame_r. f_equiv.
+ rewrite [X in (X ∗ _)%I]later_intro -later_sep. f_equiv.
+ rewrite fupd_frame_r -(fupd_trans F1 F2 E2). f_equiv.
+ rewrite fupd_frame_l -(fupd_trans F2 E1 E2). f_equiv.
+ by rewrite fupd_frame_r left_id.
+ Qed.
+
+ Lemma step_fupd_intro E1 E2 P : E2 ⊆ E1 → ▷ P -∗ |={E1,E2}▷=> P.
+ Proof. intros. by rewrite -(step_fupd_mask_mono E2 _ _ E2) // -!fupd_intro. Qed.
+End fupd_derived.
diff --git a/theories/bi/weakestpre.v b/theories/bi/weakestpre.v
new file mode 100644
index 0000000000000000000000000000000000000000..d09068871262b71ea6213fcd3bf062e64a60ba92
--- /dev/null
+++ b/theories/bi/weakestpre.v
@@ -0,0 +1,244 @@
+From stdpp Require Export coPset.
+From iris.program_logic Require Import language.
+From iris.bi Require Import interface derived_connectives.
+
+Inductive stuckness := NotStuck | MaybeStuck.
+
+Definition stuckness_leb (s1 s2 : stuckness) : bool :=
+ match s1, s2 with
+ | MaybeStuck, NotStuck => false
+ | _, _ => true
+ end.
+Instance stuckness_le : SqSubsetEq stuckness := stuckness_leb.
+Instance stuckness_le_po : PreOrder stuckness_le.
+Proof. split; by repeat intros []. Qed.
+
+Definition stuckness_to_atomicity (s : stuckness) : atomicity :=
+ if s is MaybeStuck then StronglyAtomic else WeaklyAtomic.
+
+(** Weakest preconditions [WP e @ s ; E {{ Φ }}] have an additional argument [s]
+of arbitrary type [A], that can be chosen by the one instantiating the [Wp] type
+class. This argument can be used for e.g. the stuckness bit (as in Iris) or
+thread IDs (as in iGPS).
+
+For the case of stuckness bits, there are two specific notations
+[WP e @ E {{ Φ }}] and [WP e @ E ?{{ Φ }}], which forces [A] to be [stuckness],
+and [s] to be [NotStuck] or [MaybeStuck]. This will fail to typecheck if [A] is
+not [stuckness]. If we ever want to use the notation [WP e @ E {{ Φ }}] with a
+different [A], the plan is to generalize the notation to use [Inhabited] instead
+to pick a default value depending on [A]. *)
+Class Wp (Λ : language) (PROP A : Type) :=
+ wp : A → coPset → expr Λ → (val Λ → PROP) → PROP.
+Arguments wp {_ _ _ _} _ _ _%E _%I.
+Instance: Params (@wp) 7.
+
+Class Twp (Λ : language) (PROP A : Type) :=
+ twp : A → coPset → expr Λ → (val Λ → PROP) → PROP.
+Arguments twp {_ _ _ _} _ _ _%E _%I.
+Instance: Params (@twp) 7.
+
+(** Notations for partial weakest preconditions *)
+(** Notations without binder -- only parsing because they overlap with the
+notations with binder. *)
+Notation "'WP' e @ s ; E {{ Φ } }" := (wp s E e%E Φ)
+ (at level 20, e, Φ at level 200, only parsing) : bi_scope.
+Notation "'WP' e @ E {{ Φ } }" := (wp NotStuck E e%E Φ)
+ (at level 20, e, Φ at level 200, only parsing) : bi_scope.
+Notation "'WP' e @ E ? {{ Φ } }" := (wp MaybeStuck E e%E Φ)
+ (at level 20, e, Φ at level 200, only parsing) : bi_scope.
+Notation "'WP' e {{ Φ } }" := (wp NotStuck ⊤ e%E Φ)
+ (at level 20, e, Φ at level 200, only parsing) : bi_scope.
+Notation "'WP' e ? {{ Φ } }" := (wp MaybeStuck ⊤ e%E Φ)
+ (at level 20, e, Φ at level 200, only parsing) : bi_scope.
+
+(** Notations with binder. The indentation for the inner format block is chosen
+such that *if* one has a single-character mask (e.g. [E]), the second line
+should align with the binder(s) on the first line. *)
+Notation "'WP' e @ s ; E {{ v , Q } }" := (wp s E e%E (λ v, Q))
+ (at level 20, e, Q at level 200,
+ format "'[' 'WP' e '/' '[ ' @ s ; E {{ v , Q } } ']' ']'") : bi_scope.
+Notation "'WP' e @ E {{ v , Q } }" := (wp NotStuck E e%E (λ v, Q))
+ (at level 20, e, Q at level 200,
+ format "'[' 'WP' e '/' '[ ' @ E {{ v , Q } } ']' ']'") : bi_scope.
+Notation "'WP' e @ E ? {{ v , Q } }" := (wp MaybeStuck E e%E (λ v, Q))
+ (at level 20, e, Q at level 200,
+ format "'[' 'WP' e '/' '[ ' @ E ? {{ v , Q } } ']' ']'") : bi_scope.
+Notation "'WP' e {{ v , Q } }" := (wp NotStuck ⊤ e%E (λ v, Q))
+ (at level 20, e, Q at level 200,
+ format "'[' 'WP' e '/' '[ ' {{ v , Q } } ']' ']'") : bi_scope.
+Notation "'WP' e ? {{ v , Q } }" := (wp MaybeStuck ⊤ e%E (λ v, Q))
+ (at level 20, e, Q at level 200,
+ format "'[' 'WP' e '/' '[ ' ? {{ v , Q } } ']' ']'") : bi_scope.
+
+(* Texan triples *)
+Notation "'{{{' P } } } e @ s ; E {{{ x .. y , 'RET' pat ; Q } } }" :=
+ (□ ∀ Φ,
+ P -∗ ▷ (∀ x, .. (∀ y, Q -∗ Φ pat%V) .. ) -∗ WP e @ s; E {{ Φ }})%I
+ (at level 20, x closed binder, y closed binder,
+ format "'[hv' {{{ P } } } '/ ' e '/' @ s ; E {{{ x .. y , RET pat ; Q } } } ']'") : bi_scope.
+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 "'[hv' {{{ P } } } '/ ' e '/' @ E {{{ x .. y , RET pat ; Q } } } ']'") : bi_scope.
+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 "'[hv' {{{ 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 "'[hv' {{{ P } } } '/ ' 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 "'[hv' {{{ P } } } '/ ' e '/' ? {{{ x .. y , RET pat ; Q } } } ']'") : bi_scope.
+
+Notation "'{{{' P } } } e @ s ; E {{{ 'RET' pat ; Q } } }" :=
+ (□ ∀ Φ, P -∗ ▷ (Q -∗ Φ pat%V) -∗ WP e @ s; E {{ Φ }})%I
+ (at level 20,
+ format "'[hv' {{{ P } } } '/ ' e '/' @ s ; E {{{ RET pat ; Q } } } ']'") : bi_scope.
+Notation "'{{{' P } } } e @ E {{{ 'RET' pat ; Q } } }" :=
+ (□ ∀ Φ, P -∗ ▷ (Q -∗ Φ pat%V) -∗ WP e @ E {{ Φ }})%I
+ (at level 20,
+ format "'[hv' {{{ P } } } '/ ' e '/' @ E {{{ RET pat ; Q } } } ']'") : bi_scope.
+Notation "'{{{' P } } } e @ E ? {{{ 'RET' pat ; Q } } }" :=
+ (□ ∀ Φ, P -∗ ▷ (Q -∗ Φ pat%V) -∗ WP e @ E ?{{ Φ }})%I
+ (at level 20,
+ format "'[hv' {{{ 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 "'[hv' {{{ P } } } '/ ' e '/' {{{ RET pat ; Q } } } ']'") : bi_scope.
+Notation "'{{{' P } } } e ? {{{ 'RET' pat ; Q } } }" :=
+ (□ ∀ Φ, P -∗ ▷ (Q -∗ Φ pat%V) -∗ WP e ?{{ Φ }})%I
+ (at level 20,
+ format "'[hv' {{{ P } } } '/ ' e '/' ? {{{ RET pat ; Q } } } ']'") : bi_scope.
+
+(** Aliases for stdpp scope -- they inherit the levels and format from above. *)
+Notation "'{{{' P } } } e @ s ; E {{{ x .. y , 'RET' pat ; Q } } }" :=
+ (∀ Φ, P -∗ ▷ (∀ x, .. (∀ y, Q -∗ Φ pat%V) .. ) -∗ WP e @ s; E {{ Φ }}) : stdpp_scope.
+Notation "'{{{' P } } } e @ E {{{ x .. y , 'RET' pat ; Q } } }" :=
+ (∀ Φ, P -∗ ▷ (∀ x, .. (∀ y, Q -∗ Φ pat%V) .. ) -∗ WP e @ E {{ Φ }}) : stdpp_scope.
+Notation "'{{{' P } } } e @ E ? {{{ x .. y , 'RET' pat ; Q } } }" :=
+ (∀ Φ, P -∗ ▷ (∀ x, .. (∀ y, Q -∗ Φ pat%V) .. ) -∗ WP e @ E ?{{ Φ }}) : stdpp_scope.
+Notation "'{{{' P } } } e {{{ x .. y , 'RET' pat ; Q } } }" :=
+ (∀ Φ, P -∗ ▷ (∀ x, .. (∀ y, Q -∗ Φ pat%V) .. ) -∗ WP e {{ Φ }}) : stdpp_scope.
+Notation "'{{{' P } } } e ? {{{ x .. y , 'RET' pat ; Q } } }" :=
+ (∀ Φ, P -∗ ▷ (∀ x, .. (∀ y, Q -∗ Φ pat%V) .. ) -∗ WP e ?{{ Φ }}) : stdpp_scope.
+Notation "'{{{' P } } } e @ s ; E {{{ 'RET' pat ; Q } } }" :=
+ (∀ Φ, P -∗ ▷ (Q -∗ Φ pat%V) -∗ WP e @ s; E {{ Φ }}) : stdpp_scope.
+Notation "'{{{' P } } } e @ E {{{ 'RET' pat ; Q } } }" :=
+ (∀ Φ, P -∗ ▷ (Q -∗ Φ pat%V) -∗ WP e @ E {{ Φ }}) : stdpp_scope.
+Notation "'{{{' P } } } e @ E ? {{{ 'RET' pat ; Q } } }" :=
+ (∀ Φ, P -∗ ▷ (Q -∗ Φ pat%V) -∗ WP e @ E ?{{ Φ }}) : stdpp_scope.
+Notation "'{{{' P } } } e {{{ 'RET' pat ; Q } } }" :=
+ (∀ Φ, P -∗ ▷ (Q -∗ Φ pat%V) -∗ WP e {{ Φ }}) : stdpp_scope.
+Notation "'{{{' P } } } e ? {{{ 'RET' pat ; Q } } }" :=
+ (∀ Φ, P -∗ ▷ (Q -∗ Φ pat%V) -∗ WP e ?{{ Φ }}) : stdpp_scope.
+
+(** Notations for total weakest preconditions *)
+(** Notations without binder -- only parsing because they overlap with the
+notations with binder. *)
+Notation "'WP' e @ s ; E [{ Φ } ]" := (twp s E e%E Φ)
+ (at level 20, e, Φ at level 200, only parsing) : bi_scope.
+Notation "'WP' e @ E [{ Φ } ]" := (twp NotStuck E e%E Φ)
+ (at level 20, e, Φ at level 200, only parsing) : bi_scope.
+Notation "'WP' e @ E ? [{ Φ } ]" := (twp MaybeStuck E e%E Φ)
+ (at level 20, e, Φ at level 200, only parsing) : bi_scope.
+Notation "'WP' e [{ Φ } ]" := (twp NotStuck ⊤ e%E Φ)
+ (at level 20, e, Φ at level 200, only parsing) : bi_scope.
+Notation "'WP' e ? [{ Φ } ]" := (twp MaybeStuck ⊤ e%E Φ)
+ (at level 20, e, Φ at level 200, only parsing) : bi_scope.
+
+(** Notations with binder. The indentation for the inner format block is chosen
+such that *if* one has a single-character mask (e.g. [E]), the second line
+should align with the binder(s) on the first line. *)
+Notation "'WP' e @ s ; E [{ v , Q } ]" := (twp s E e%E (λ v, Q))
+ (at level 20, e, Q at level 200,
+ format "'[' 'WP' e '/' '[ ' @ s ; E [{ v , Q } ] ']' ']'") : bi_scope.
+Notation "'WP' e @ E [{ v , Q } ]" := (twp NotStuck E e%E (λ v, Q))
+ (at level 20, e, Q at level 200,
+ format "'[' 'WP' e '/' '[ ' @ E [{ v , Q } ] ']' ']'") : bi_scope.
+Notation "'WP' e @ E ? [{ v , Q } ]" := (twp MaybeStuck E e%E (λ v, Q))
+ (at level 20, e, Q at level 200,
+ format "'[' 'WP' e '/' '[ ' @ E ? [{ v , Q } ] ']' ']'") : bi_scope.
+Notation "'WP' e [{ v , Q } ]" := (twp NotStuck ⊤ e%E (λ v, Q))
+ (at level 20, e, Q at level 200,
+ format "'[' 'WP' e '/' '[ ' [{ v , Q } ] ']' ']'") : bi_scope.
+Notation "'WP' e ? [{ v , Q } ]" := (twp MaybeStuck ⊤ e%E (λ v, Q))
+ (at level 20, e, Q at level 200,
+ format "'[' 'WP' e '/' '[ ' ? [{ v , Q } ] ']' ']'") : bi_scope.
+
+(* Texan triples *)
+Notation "'[[{' P } ] ] e @ s ; E [[{ x .. y , 'RET' pat ; Q } ] ]" :=
+ (□ ∀ Φ,
+ P -∗ (∀ x, .. (∀ y, Q -∗ Φ pat%V) .. ) -∗ WP e @ s; E [{ Φ }])%I
+ (at level 20, x closed binder, y closed binder,
+ format "'[hv' [[{ P } ] ] '/ ' e '/' @ s ; E [[{ x .. y , RET pat ; Q } ] ] ']'") : bi_scope.
+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 "'[hv' [[{ P } ] ] '/ ' e '/' @ E [[{ x .. y , RET pat ; Q } ] ] ']'") : bi_scope.
+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 "'[hv' [[{ 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 "'[hv' [[{ P } ] ] '/ ' 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 "'[hv' [[{ P } ] ] '/ ' e '/' ? [[{ x .. y , RET pat ; Q } ] ] ']'") : bi_scope.
+
+Notation "'[[{' P } ] ] e @ s ; E [[{ 'RET' pat ; Q } ] ]" :=
+ (□ ∀ Φ, P -∗ (Q -∗ Φ pat%V) -∗ WP e @ s; E [{ Φ }])%I
+ (at level 20,
+ format "'[hv' [[{ P } ] ] '/ ' e '/' @ s ; E [[{ RET pat ; Q } ] ] ']'") : bi_scope.
+Notation "'[[{' P } ] ] e @ E [[{ 'RET' pat ; Q } ] ]" :=
+ (□ ∀ Φ, P -∗ (Q -∗ Φ pat%V) -∗ WP e @ E [{ Φ }])%I
+ (at level 20,
+ format "'[hv' [[{ P } ] ] '/ ' e '/' @ E [[{ RET pat ; Q } ] ] ']'") : bi_scope.
+Notation "'[[{' P } ] ] e @ E ? [[{ 'RET' pat ; Q } ] ]" :=
+ (□ ∀ Φ, P -∗ (Q -∗ Φ pat%V) -∗ WP e @ E ?[{ Φ }])%I
+ (at level 20,
+ format "'[hv' [[{ 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 "'[hv' [[{ P } ] ] '/ ' e '/' [[{ RET pat ; Q } ] ] ']'") : bi_scope.
+Notation "'[[{' P } ] ] e ? [[{ 'RET' pat ; Q } ] ]" :=
+ (□ ∀ Φ, P -∗ (Q -∗ Φ pat%V) -∗ WP e ?[{ Φ }])%I
+ (at level 20,
+ format "'[hv' [[{ P } ] ] '/ ' e '/' ? [[{ RET pat ; Q } ] ] ']'") : bi_scope.
+
+(** Aliases for stdpp scope -- they inherit the levels and format from above. *)
+Notation "'[[{' P } ] ] e @ s ; E [[{ x .. y , 'RET' pat ; Q } ] ]" :=
+ (∀ Φ, P -∗ (∀ x, .. (∀ y, Q -∗ Φ pat%V) .. ) -∗ WP e @ s; E [{ Φ }]) : stdpp_scope.
+Notation "'[[{' P } ] ] e @ E [[{ x .. y , 'RET' pat ; Q } ] ]" :=
+ (∀ Φ, P -∗ (∀ x, .. (∀ y, Q -∗ Φ pat%V) .. ) -∗ WP e @ E [{ Φ }]) : stdpp_scope.
+Notation "'[[{' P } ] ] e @ E ? [[{ x .. y , 'RET' pat ; Q } ] ]" :=
+ (∀ Φ, P -∗ (∀ x, .. (∀ y, Q -∗ Φ pat%V) .. ) -∗ WP e @ E ?[{ Φ }]) : stdpp_scope.
+Notation "'[[{' P } ] ] e [[{ x .. y , 'RET' pat ; Q } ] ]" :=
+ (∀ Φ, P -∗ (∀ x, .. (∀ y, Q -∗ Φ pat%V) .. ) -∗ WP e [{ Φ }]) : stdpp_scope.
+Notation "'[[{' P } ] ] e ? [[{ x .. y , 'RET' pat ; Q } ] ]" :=
+ (∀ Φ, P -∗ (∀ x, .. (∀ y, Q -∗ Φ pat%V) .. ) -∗ WP e ?[{ Φ }]) : stdpp_scope.
+Notation "'[[{' P } ] ] e @ s ; E [[{ 'RET' pat ; Q } ] ]" :=
+ (∀ Φ, P -∗ (Q -∗ Φ pat%V) -∗ WP e @ s; E [{ Φ }]) : stdpp_scope.
+Notation "'[[{' P } ] ] e @ E [[{ 'RET' pat ; Q } ] ]" :=
+ (∀ Φ, P -∗ (Q -∗ Φ pat%V) -∗ WP e @ E [{ Φ }]) : stdpp_scope.
+Notation "'[[{' P } ] ] e @ E ? [[{ 'RET' pat ; Q } ] ]" :=
+ (∀ Φ, P -∗ (Q -∗ Φ pat%V) -∗ WP e @ E ?[{ Φ }]) : stdpp_scope.
+Notation "'[[{' P } ] ] e [[{ 'RET' pat ; Q } ] ]" :=
+ (∀ Φ, P -∗ (Q -∗ Φ pat%V) -∗ WP e [{ Φ }]) : stdpp_scope.
+Notation "'[[{' P } ] ] e ? [[{ 'RET' pat ; Q } ] ]" :=
+ (∀ Φ, P -∗ (Q -∗ Φ pat%V) -∗ WP e ?[{ Φ }]) : stdpp_scope.
diff --git a/theories/heap_lang/adequacy.v b/theories/heap_lang/adequacy.v
index 51529438b392a93878e3f21458f0be2b7982d7fd..9c28699974cc8596c44c1c2e31efed6dc77cdc0c 100644
--- a/theories/heap_lang/adequacy.v
+++ b/theories/heap_lang/adequacy.v
@@ -1,5 +1,4 @@
From iris.program_logic Require Export weakestpre adequacy.
-From iris.heap_lang Require Export lifting.
From iris.algebra Require Import auth.
From iris.heap_lang Require Import proofmode notation.
From iris.proofmode Require Import tactics.
diff --git a/theories/heap_lang/lang.v b/theories/heap_lang/lang.v
index 31b9b4c7f8f216db8c7157fceaba828c16c3e4b2..322bd54490fe69f05a26db3ee7e94a300992c254 100644
--- a/theories/heap_lang/lang.v
+++ b/theories/heap_lang/lang.v
@@ -4,6 +4,9 @@ From stdpp Require Export strings.
From stdpp Require Import gmap.
Set Default Proof Using "Type".
+Delimit Scope expr_scope with E.
+Delimit Scope val_scope with V.
+
Module heap_lang.
Open Scope Z_scope.
@@ -113,6 +116,38 @@ Fixpoint to_val (e : expr) : option val :=
| _ => None
end.
+(** We assume the following encoding of values to 64-bit words: The least 3
+significant bits of every word are a "tag", and we have 61 bits of payload,
+which is enough if all pointers are 8-byte-aligned (common on 64bit
+architectures). The tags have the following meaning:
+
+0: Payload is the data for a LitV (LitInt _).
+1: Payload is the data for a InjLV (LitV (LitInt _)).
+2: Payload is the data for a InjRV (LitV (LitInt _)).
+3: Payload is the data for a LitV (LitLoc _).
+4: Payload is the data for a InjLV (LitV (LitLoc _)).
+4: Payload is the data for a InjRV (LitV (LitLoc _)).
+6: Payload is one of the following finitely many values, which 61 bits are more
+ than enough to encode:
+ LitV LitUnit, InjLV (LitV LitUnit), InjRV (LitV LitUnit),
+ LitV (LitBool _), InjLV (LitV (LitBool _)), InjRV (LitV (LitBool _)).
+7: Value is boxed, i.e., payload is a pointer to some read-only memory area on
+ the heap which stores whether this is a RecV, PairV, InjLV or InjRV and the
+ relevant data for those cases. However, the boxed representation is never
+ used if any of the above representations could be used.
+
+Ignoring (as usual) the fact that we have to fit the infinite Z/loc into 61
+bits, this means every value is machine-word-sized and can hence be atomically
+read and written. Also notice that the sets of boxed and unboxed values are
+disjoint. *)
+Definition val_is_unboxed (v : val) : Prop :=
+ match v with
+ | LitV _ => True
+ | InjLV (LitV _) => True
+ | InjRV (LitV _) => True
+ | _ => False
+ end.
+
(** The state: heaps of vals. *)
Definition state := gmap loc val.
@@ -358,6 +393,14 @@ Definition bin_op_eval (op : bin_op) (v1 v2 : val) : option val :=
| _, _ => None
end.
+(** CAS just compares the word-sized representation of the two values, it cannot
+look into boxed data. This works out fine if at least one of the to-be-compared
+values is unboxed (exploiting the fact that an unboxed and a boxed value can
+never be equal because these are disjoint sets). *)
+Definition vals_cas_compare_safe (vl v1 : val) : Prop :=
+ val_is_unboxed vl ∨ val_is_unboxed v1.
+Arguments vals_cas_compare_safe !_ !_ /.
+
Inductive head_step : expr → state → expr → state → list (expr) → Prop :=
| BetaS f x e1 e2 v2 e' σ :
to_val e2 = Some v2 →
@@ -402,12 +445,14 @@ Inductive head_step : expr → state → expr → state → list (expr) → Prop
| CasFailS l e1 v1 e2 v2 vl σ :
to_val e1 = Some v1 → to_val e2 = Some v2 →
σ !! l = Some vl → vl ≠v1 →
+ vals_cas_compare_safe vl v1 →
head_step (CAS (Lit $ LitLoc l) e1 e2) σ (Lit $ LitBool false) σ []
| CasSucS l e1 v1 e2 v2 σ :
to_val e1 = Some v1 → to_val e2 = Some v2 →
σ !! l = Some v1 →
+ vals_cas_compare_safe v1 v1 →
head_step (CAS (Lit $ LitLoc l) e1 e2) σ (Lit $ LitBool true) (<[l:=v2]>σ) []
- | FaaS l i1 e2 i2 σ :
+ | FaaS l i1 e2 i2 σ :
to_val e2 = Some (LitV (LitInt i2)) →
σ !! l = Some (LitV (LitInt i1)) →
head_step (FAA (Lit $ LitLoc l) e2) σ (Lit $ LitInt i1) (<[l:=LitV (LitInt (i1 + i2))]>σ) [].
@@ -530,7 +575,7 @@ Canonical Structure heap_lang := LanguageOfEctx heap_ectx_lang.
(* Prefer heap_lang names over ectx_language names. *)
Export heap_lang.
-(** Define some derived forms *)
+(** Define some derived forms. *)
Notation Lam x e := (Rec BAnon x e) (only parsing).
Notation Let x e1 e2 := (App (Lam x e2) e1) (only parsing).
Notation Seq e1 e2 := (Let BAnon e1 e2) (only parsing).
diff --git a/theories/heap_lang/lib/atomic_heap.v b/theories/heap_lang/lib/atomic_heap.v
new file mode 100644
index 0000000000000000000000000000000000000000..ad3f079a38ab3281c597ca7b9ed075d1ccbbcd12
--- /dev/null
+++ b/theories/heap_lang/lib/atomic_heap.v
@@ -0,0 +1,113 @@
+From iris.heap_lang Require Export lifting notation.
+From iris.base_logic.lib Require Export invariants.
+From iris.program_logic Require Export atomic.
+From iris.proofmode Require Import tactics.
+From iris.heap_lang Require Import proofmode notation.
+Set Default Proof Using "Type".
+
+(** A general logically atomic interface for a heap. *)
+Structure atomic_heap {Σ} `{!heapG Σ} := AtomicHeap {
+ (* -- operations -- *)
+ alloc : val;
+ load : val;
+ store : val;
+ cas : val;
+ (* -- predicates -- *)
+ (* name is used to associate locked with is_lock *)
+ mapsto (l : loc) (q: Qp) (v : val) : iProp Σ;
+ (* -- general properties -- *)
+ mapsto_timeless l q v : Timeless (mapsto l q v);
+ (* -- operation specs -- *)
+ alloc_spec v :
+ {{{ True }}} alloc v {{{ l, RET #l; mapsto l 1 v }}};
+ load_spec (l : loc) :
+ atomic_wp (load #l)%E
+ ⊤ ⊤
+ (λ '(v, q), mapsto l q v)
+ (λ '(v, q) (_:()), mapsto l q v)
+ (λ '(v, q) _, v);
+ store_spec (l : loc) (e : expr) (w : val) :
+ IntoVal e w →
+ atomic_wp (store (#l, e))%E
+ ⊤ ⊤
+ (λ v, mapsto l 1 v)
+ (λ v (_:()), mapsto l 1 w)
+ (λ _ _, #()%V);
+ (* This spec is slightly weaker than it could be: It is sufficient for [w1]
+ *or* [v] to be unboxed. However, by writing it this way the [val_is_unboxed]
+ is outside the atomic triple, which makes it much easier to use -- and the
+ spec is still good enough for all our applications. *)
+ cas_spec (l : loc) (e1 e2 : expr) (w1 w2 : val) :
+ IntoVal e1 w1 → IntoVal e2 w2 → val_is_unboxed w1 →
+ atomic_wp (cas (#l, e1, e2))%E
+ ⊤ ⊤
+ (λ v, mapsto l 1 v)%I
+ (λ v (_:()), if decide (v = w1) then mapsto l 1 w2 else mapsto l 1 v)
+ (λ v _, #(if decide (v = w1) then true else false)%V);
+}.
+Arguments atomic_heap _ {_}.
+
+(** Proof that the primitive physical operations of heap_lang satisfy said interface. *)
+Definition primitive_alloc : val :=
+ λ: "v", ref "v".
+Definition primitive_load : val :=
+ λ: "l", !"l".
+Definition primitive_store : val :=
+ λ: "p", (Fst "p") <- (Snd "p").
+Definition primitive_cas : val :=
+ λ: "p", CAS (Fst (Fst "p")) (Snd (Fst "p")) (Snd "p").
+
+Section proof.
+ Context `{!heapG Σ}.
+
+ Lemma primitive_alloc_spec v :
+ {{{ True }}} primitive_alloc v {{{ l, RET #l; l ↦ v }}}.
+ Proof.
+ iIntros (Φ) "_ HΦ". wp_let. wp_alloc l. iApply "HΦ". done.
+ Qed.
+
+ Lemma primitive_load_spec (l : loc) :
+ atomic_wp (primitive_load #l)%E
+ ⊤ ⊤
+ (λ '(v, q), l ↦{q} v)%I
+ (λ '(v, q) (_:()), l ↦{q} v)%I
+ (λ '(v, q) _, v).
+ Proof.
+ iIntros (Q Φ) "? AU". wp_let.
+ iMod (aupd_acc with "AU") as ((v, q)) "[H↦ [_ Hclose]]"; first solve_ndisj.
+ wp_load. iMod ("Hclose" $! () with "H↦") as "HΦ". by iApply "HΦ".
+ Qed.
+
+ Lemma primitive_store_spec (l : loc) (e : expr) (w : val) :
+ IntoVal e w →
+ atomic_wp (primitive_store (#l, e))%E
+ ⊤ ⊤
+ (λ v, l ↦ v)%I
+ (λ v (_:()), l ↦ w)%I
+ (λ _ _, #()%V).
+ Proof.
+ iIntros (<- Q Φ) "? AU". wp_let. wp_proj. wp_proj.
+ iMod (aupd_acc with "AU") as (v) "[H↦ [_ Hclose]]"; first solve_ndisj.
+ wp_store. iMod ("Hclose" $! () with "H↦") as "HΦ". by iApply "HΦ".
+ Qed.
+
+ Lemma primitive_cas_spec (l : loc) e1 e2 (w1 w2 : val) :
+ IntoVal e1 w1 → IntoVal e2 w2 → val_is_unboxed w1 →
+ atomic_wp (primitive_cas (#l, e1, e2))%E
+ ⊤ ⊤
+ (λ v, l ↦ v)%I
+ (λ v (_:()), if decide (v = w1) then l ↦ w2 else l ↦ v)%I
+ (λ v _, #(if decide (v = w1) then true else false)%V).
+ Proof.
+ iIntros (<- <- ? Q Φ) "? AU". wp_let. repeat wp_proj.
+ iMod (aupd_acc with "AU") as (v) "[H↦ [_ Hclose]]"; first solve_ndisj.
+ destruct (decide (v = w1)) as [<-|Hv]; [wp_cas_suc|wp_cas_fail];
+ iMod ("Hclose" $! () with "H↦") as "HΦ"; by iApply "HΦ".
+ Qed.
+
+ Definition primitive_atomic_heap : atomic_heap Σ :=
+ {| alloc_spec := primitive_alloc_spec;
+ load_spec := primitive_load_spec;
+ store_spec := primitive_store_spec;
+ cas_spec := primitive_cas_spec |}.
+End proof.
diff --git a/theories/heap_lang/lib/counter.v b/theories/heap_lang/lib/counter.v
index a7ba3898b9a1b2bab152e941895d1a59f12109ad..788eb85800e92526c9ea674b08cfee97001306fc 100644
--- a/theories/heap_lang/lib/counter.v
+++ b/theories/heap_lang/lib/counter.v
@@ -46,24 +46,24 @@ Section mono_proof.
{{{ mcounter l n }}} incr #l {{{ RET #(); mcounter l (S n) }}}.
Proof.
iIntros (Φ) "Hl HΦ". iLöb as "IH". wp_rec.
- iDestruct "Hl" as (γ) "[#Hinv Hγf]".
- wp_bind (! _)%E. iInv N as (c) ">[Hγ Hl]" "Hclose".
- wp_load. iMod ("Hclose" with "[Hl Hγ]") as "_"; [iNext; iExists c; by iFrame|].
- iModIntro. wp_let. wp_op.
- wp_bind (CAS _ _ _). iInv N as (c') ">[Hγ Hl]" "Hclose".
+ iDestruct "Hl" as (γ) "[#? Hγf]".
+ wp_bind (! _)%E. iInv N as (c) ">[Hγ Hl]".
+ wp_load. iModIntro. iSplitL "Hl Hγ"; [iNext; iExists c; by iFrame|].
+ wp_let. wp_op.
+ wp_bind (CAS _ _ _). iInv N as (c') ">[Hγ Hl]".
destruct (decide (c' = c)) as [->|].
- iDestruct (own_valid_2 with "Hγ Hγf")
as %[?%mnat_included _]%auth_valid_discrete_2.
iMod (own_update_2 with "Hγ Hγf") as "[Hγ Hγf]".
{ apply auth_update, (mnat_local_update _ _ (S c)); auto. }
- wp_cas_suc. iMod ("Hclose" with "[Hl Hγ]") as "_".
+ wp_cas_suc. iModIntro. iSplitL "Hl Hγ".
{ iNext. iExists (S c). rewrite Nat2Z.inj_succ Z.add_1_l. by iFrame. }
- iModIntro. wp_if. iApply "HΦ"; iExists γ; repeat iSplit; eauto.
+ wp_if. iApply "HΦ"; iExists γ; repeat iSplit; eauto.
iApply (own_mono with "Hγf"). apply: auth_frag_mono.
by apply mnat_included, le_n_S.
- - wp_cas_fail; first (by intros [= ?%Nat2Z.inj]).
- iMod ("Hclose" with "[Hl Hγ]") as "_"; [iNext; iExists c'; by iFrame|].
- iModIntro. wp_if. iApply ("IH" with "[Hγf] [HΦ]"); last by auto.
+ - wp_cas_fail; first (by intros [= ?%Nat2Z.inj]). iModIntro.
+ iSplitL "Hl Hγ"; [iNext; iExists c'; by iFrame|].
+ wp_if. iApply ("IH" with "[Hγf] [HΦ]"); last by auto.
rewrite {3}/mcounter; eauto 10.
Qed.
@@ -71,12 +71,13 @@ Section mono_proof.
{{{ mcounter l j }}} read #l {{{ i, RET #i; ⌜j ≤ iâŒ%nat ∧ mcounter l i }}}.
Proof.
iIntros (ϕ) "Hc HΦ". iDestruct "Hc" as (γ) "[#Hinv Hγf]".
- rewrite /read /=. wp_let. iInv N as (c) ">[Hγ Hl]" "Hclose". wp_load.
+ rewrite /read /=. wp_let. iInv N as (c) ">[Hγ Hl]".
+ wp_load.
iDestruct (own_valid_2 with "Hγ Hγf")
as %[?%mnat_included _]%auth_valid_discrete_2.
iMod (own_update_2 with "Hγ Hγf") as "[Hγ Hγf]".
{ apply auth_update, (mnat_local_update _ _ c); auto. }
- iMod ("Hclose" with "[Hl Hγ]") as "_"; [iNext; iExists c; by iFrame|].
+ iModIntro. iSplitL "Hl Hγ"; [iNext; iExists c; by iFrame|].
iApply ("HΦ" with "[-]"). rewrite /mcounter; eauto 10.
Qed.
End mono_proof.
@@ -123,19 +124,19 @@ Section contrib_spec.
{{{ RET #(); ccounter γ q (S n) }}}.
Proof.
iIntros (Φ) "[#? Hγf] HΦ". iLöb as "IH". wp_rec.
- wp_bind (! _)%E. iInv N as (c) ">[Hγ Hl]" "Hclose".
- wp_load. iMod ("Hclose" with "[Hl Hγ]") as "_"; [iNext; iExists c; by iFrame|].
- iModIntro. wp_let. wp_op.
- wp_bind (CAS _ _ _). iInv N as (c') ">[Hγ Hl]" "Hclose".
+ wp_bind (! _)%E. iInv N as (c) ">[Hγ Hl]".
+ wp_load. iModIntro. iSplitL "Hl Hγ"; [iNext; iExists c; by iFrame|].
+ wp_let. wp_op.
+ wp_bind (CAS _ _ _). iInv N as (c') ">[Hγ Hl]".
destruct (decide (c' = c)) as [->|].
- iMod (own_update_2 with "Hγ Hγf") as "[Hγ Hγf]".
- { apply frac_auth_update, (nat_local_update _ _ (S c) (S n)); omega. }
- wp_cas_suc. iMod ("Hclose" with "[Hl Hγ]") as "_".
+ { apply frac_auth_update, (nat_local_update _ _ (S c) (S n)); lia. }
+ wp_cas_suc. iModIntro. iSplitL "Hl Hγ".
{ iNext. iExists (S c). rewrite Nat2Z.inj_succ Z.add_1_l. by iFrame. }
- iModIntro. wp_if. by iApply "HΦ".
+ wp_if. by iApply "HΦ".
- wp_cas_fail; first (by intros [= ?%Nat2Z.inj]).
- iMod ("Hclose" with "[Hl Hγ]") as "_"; [iNext; iExists c'; by iFrame|].
- iModIntro. wp_if. by iApply ("IH" with "[Hγf] [HΦ]"); auto.
+ iModIntro. iSplitL "Hl Hγ"; [iNext; iExists c'; by iFrame|].
+ wp_if. by iApply ("IH" with "[Hγf] [HΦ]"); auto.
Qed.
Lemma read_contrib_spec γ l q n :
@@ -143,9 +144,9 @@ Section contrib_spec.
{{{ c, RET #c; ⌜n ≤ câŒ%nat ∧ ccounter γ q n }}}.
Proof.
iIntros (Φ) "[#? Hγf] HΦ".
- rewrite /read /=. wp_let. iInv N as (c) ">[Hγ Hl]" "Hclose". wp_load.
+ rewrite /read /=. wp_let. iInv N as (c) ">[Hγ Hl]". wp_load.
iDestruct (own_valid_2 with "Hγ Hγf") as % ?%frac_auth_included_total%nat_included.
- iMod ("Hclose" with "[Hl Hγ]") as "_"; [iNext; iExists c; by iFrame|].
+ iModIntro. iSplitL "Hl Hγ"; [iNext; iExists c; by iFrame|].
iApply ("HΦ" with "[-]"); rewrite /ccounter; eauto 10.
Qed.
@@ -154,9 +155,9 @@ Section contrib_spec.
{{{ n, RET #n; ccounter γ 1 n }}}.
Proof.
iIntros (Φ) "[#? Hγf] HΦ".
- rewrite /read /=. wp_let. iInv N as (c) ">[Hγ Hl]" "Hclose". wp_load.
+ rewrite /read /=. wp_let. iInv N as (c) ">[Hγ Hl]". wp_load.
iDestruct (own_valid_2 with "Hγ Hγf") as % <-%frac_auth_agreeL.
- iMod ("Hclose" with "[Hl Hγ]") as "_"; [iNext; iExists c; by iFrame|].
+ iModIntro. iSplitL "Hl Hγ"; [iNext; iExists c; by iFrame|].
by iApply "HΦ".
Qed.
End contrib_spec.
diff --git a/theories/heap_lang/lib/increment.v b/theories/heap_lang/lib/increment.v
new file mode 100644
index 0000000000000000000000000000000000000000..4640f7c0167214e2bc091b1c408e6280dae655ae
--- /dev/null
+++ b/theories/heap_lang/lib/increment.v
@@ -0,0 +1,84 @@
+From iris.base_logic.lib Require Export invariants.
+From iris.program_logic Require Export atomic.
+From iris.proofmode Require Import tactics.
+From iris.heap_lang Require Import proofmode notation atomic_heap par.
+Set Default Proof Using "Type".
+
+(** Show that implementing fetch-and-add on top of CAS preserves logical
+atomicity. *)
+
+(* TODO: Move this to iris-examples once gen_proofmode is merged. *)
+Section increment.
+ Context `{!heapG Σ} (aheap: atomic_heap Σ).
+
+ Definition incr: val :=
+ rec: "incr" "l" :=
+ let: "oldv" := aheap.(load) "l" in
+ if: aheap.(cas) ("l", "oldv", ("oldv" + #1))
+ then "oldv" (* return old value if success *)
+ else "incr" "l".
+
+ Lemma incr_spec (l: loc) :
+ atomic_wp (incr #l)
+ ⊤ ⊤
+ (λ (v: Z), aheap.(mapsto) l 1 #v)%I
+ (λ v (_:()), aheap.(mapsto) l 1 #(v + 1))%I
+ (λ v _, #v).
+ Proof.
+ iIntros (Q Φ) "HQ AU". iLöb as "IH". wp_let.
+ wp_apply (load_spec with "[HQ]"); first by iAccu.
+ (* Prove the atomic shift for load *)
+ iAuIntro. iApply (aacc_aupd_abort with "AU"); first done.
+ iIntros (x) "H↦".
+ iApply (aacc_intro (_, _) with "[H↦]"); [solve_ndisj|done|iSplit].
+ { iIntros "$ !> $ !> //". }
+ iIntros ([]) "$ !> AU !> HQ".
+ (* Now go on *)
+ wp_let. wp_op. wp_bind (aheap.(cas) _)%I.
+ wp_apply (cas_spec with "[HQ]"); first done; first by iAccu.
+ (* Prove the atomic shift for CAS *)
+ iAuIntro. iApply (aacc_aupd with "AU"); first done.
+ iIntros (x') "H↦".
+ iApply (aacc_intro with "[H↦]"); [solve_ndisj|done|iSplit].
+ { eauto 10 with iFrame. }
+ iIntros ([]) "H↦ !>".
+ destruct (decide (#x' = #x)) as [[= ->]|Hx].
+ - iRight. iExists (). iFrame. iIntros "HΦ !> HQ".
+ wp_if. by iApply "HΦ".
+ - iLeft. iFrame. iIntros "AU !> HQ".
+ wp_if. iApply ("IH" with "HQ"). done.
+ Qed.
+
+End increment.
+
+Section increment_client.
+ Context `{!heapG Σ, !spawnG Σ}.
+
+ Definition incr_client : val :=
+ λ: "x",
+ let: "l" := ref "x" in
+ incr primitive_atomic_heap "l" ||| incr primitive_atomic_heap "l".
+
+ Lemma incr_client_safe (x: Z):
+ WP incr_client #x {{ _, True }}%I.
+ Proof using Type*.
+ wp_let. wp_alloc l as "Hl". wp_let.
+ iMod (inv_alloc nroot _ (∃x':Z, l ↦ #x')%I with "[Hl]") as "#Hinv"; first eauto.
+ (* FIXME: I am only using persistent stuff, so I should be allowed
+ to move this to the persisten context even without the additional â–¡. *)
+ iAssert (â–¡ WP incr primitive_atomic_heap #l {{ _, True }})%I as "#Aupd".
+ { iAlways. wp_apply (incr_spec with "[]"); first by iAccu. clear x.
+ iAuIntro. iInv nroot as (x) ">H↦".
+ iApply (aacc_intro with "[H↦]"); [solve_ndisj|done|iSplit].
+ { by eauto 10. }
+ iIntros ([]) "H↦ !>". iSplitL "H↦"; first by eauto 10.
+ (* The continuation: From after the atomic triple to the postcondition of the WP *)
+ done.
+ }
+ wp_apply wp_par.
+ - iAssumption.
+ - iAssumption.
+ - iIntros (??) "_ !>". done.
+ Qed.
+
+End increment_client.
diff --git a/theories/heap_lang/lib/par.v b/theories/heap_lang/lib/par.v
index f37cf4ebd65845d13360a69f0bb912fcf498f839..eaf7d05cb6ac5e2b1ef327b887238573bed16a1e 100644
--- a/theories/heap_lang/lib/par.v
+++ b/theories/heap_lang/lib/par.v
@@ -21,13 +21,13 @@ Context `{!heapG Σ, !spawnG Σ}.
brought together. That is strictly stronger than first stripping a later
and then merging them, as demonstrated by [tests/joining_existentials.v].
This is why these are not Texan triples. *)
-Lemma par_spec (Ψ1 Ψ2 : val → iProp Σ) e (f1 f2 : val) (Φ : val → iProp Σ)
- `{Hef : !IntoVal e (f1,f2)} :
+Lemma par_spec (Ψ1 Ψ2 : val → iProp Σ) e (f1 f2 : val) (Φ : val → iProp Σ) :
+ IntoVal e (f1,f2) →
WP f1 #() {{ Ψ1 }} -∗ WP f2 #() {{ Ψ2 }} -∗
(▷ ∀ v1 v2, Ψ1 v1 ∗ Ψ2 v2 -∗ ▷ Φ (v1,v2)%V) -∗
WP par e {{ Φ }}.
Proof.
- apply of_to_val in Hef as <-. iIntros "Hf1 Hf2 HΦ".
+ iIntros (<-) "Hf1 Hf2 HΦ".
rewrite /par /=. wp_let. wp_proj.
wp_apply (spawn_spec parN with "Hf1").
iIntros (l) "Hl". wp_let. wp_proj. wp_bind (f2 _).
diff --git a/theories/heap_lang/lib/spawn.v b/theories/heap_lang/lib/spawn.v
index f9059566e4b4ded7c276d72aac613f4ece56f56a..75175fe82e3fbda945f08ce00ef0a5594e4807e6 100644
--- a/theories/heap_lang/lib/spawn.v
+++ b/theories/heap_lang/lib/spawn.v
@@ -44,10 +44,11 @@ Global Instance join_handle_ne n l :
Proof. solve_proper. Qed.
(** The main proofs. *)
-Lemma spawn_spec (Ψ : val → iProp Σ) e (f : val) `{Hef : !IntoVal e f} :
+Lemma spawn_spec (Ψ : val → iProp Σ) e (f : val) :
+ IntoVal e f →
{{{ WP f #() {{ Ψ }} }}} spawn e {{{ l, RET #l; join_handle l Ψ }}}.
Proof.
- apply of_to_val in Hef as <-. iIntros (Φ) "Hf HΦ". rewrite /spawn /=.
+ iIntros (<- Φ) "Hf HΦ". rewrite /spawn /=.
wp_let. wp_alloc l as "Hl". wp_let.
iMod (own_alloc (Excl ())) as (γ) "Hγ"; first done.
iMod (inv_alloc N _ (spawn_inv γ l Ψ) with "[Hl]") as "#?".
@@ -55,21 +56,21 @@ Proof.
wp_apply wp_fork; simpl. iSplitR "Hf".
- wp_seq. iApply "HΦ". rewrite /join_handle. eauto.
- wp_bind (f _). iApply (wp_wand with "Hf"); iIntros (v) "Hv".
- iInv N as (v') "[Hl _]" "Hclose".
- wp_store. iApply "Hclose". iNext. iExists (SOMEV v). iFrame. eauto.
+ iInv N as (v') "[Hl _]".
+ wp_store. iSplitL; last done. iIntros "!> !>". iExists (SOMEV v). iFrame. eauto.
Qed.
Lemma join_spec (Ψ : val → iProp Σ) l :
{{{ join_handle l Ψ }}} join #l {{{ v, RET v; Ψ v }}}.
Proof.
iIntros (Φ) "H HΦ". iDestruct "H" as (γ) "[Hγ #?]".
- iLöb as "IH". wp_rec. wp_bind (! _)%E. iInv N as (v) "[Hl Hinv]" "Hclose".
+ iLöb as "IH". wp_rec. wp_bind (! _)%E. iInv N as (v) "[Hl Hinv]".
wp_load. iDestruct "Hinv" as "[%|Hinv]"; subst.
- - iMod ("Hclose" with "[Hl]"); [iNext; iExists _; iFrame; eauto|].
- iModIntro. wp_match. iApply ("IH" with "Hγ [HΦ]"). auto.
+ - iModIntro. iSplitL "Hl"; [iNext; iExists _; iFrame; eauto|].
+ wp_match. iApply ("IH" with "Hγ [HΦ]"). auto.
- iDestruct "Hinv" as (v' ->) "[HΨ|Hγ']".
- + iMod ("Hclose" with "[Hl Hγ]"); [iNext; iExists _; iFrame; eauto|].
- iModIntro. wp_match. by iApply "HΦ".
+ + iModIntro. iSplitL "Hl Hγ"; [iNext; iExists _; iFrame; eauto|].
+ wp_match. by iApply "HΦ".
+ iDestruct (own_valid_2 with "Hγ Hγ'") as %[].
Qed.
End proof.
diff --git a/theories/heap_lang/lib/spin_lock.v b/theories/heap_lang/lib/spin_lock.v
index 23b63251c0c89912fd501d080765eb22d5000196..f3cf0e07244a3b1512166dab528cd144a3cd31dd 100644
--- a/theories/heap_lang/lib/spin_lock.v
+++ b/theories/heap_lang/lib/spin_lock.v
@@ -61,12 +61,12 @@ Section proof.
{{{ b, RET #b; if b is true then locked γ ∗ R else True }}}.
Proof.
iIntros (Φ) "#Hl HΦ". iDestruct "Hl" as (l ->) "#Hinv".
- wp_rec. iInv N as ([]) "[Hl HR]" "Hclose".
- - wp_cas_fail. iMod ("Hclose" with "[Hl]"); first (iNext; iExists true; eauto).
- iModIntro. iApply ("HΦ" $! false). done.
+ wp_rec. iInv N as ([]) "[Hl HR]".
+ - wp_cas_fail. iModIntro. iSplitL "Hl"; first (iNext; iExists true; eauto).
+ iApply ("HΦ" $! false). done.
- wp_cas_suc. iDestruct "HR" as "[Hγ HR]".
- iMod ("Hclose" with "[Hl]"); first (iNext; iExists true; eauto).
- iModIntro. rewrite /locked. by iApply ("HΦ" $! true with "[$Hγ $HR]").
+ iModIntro. iSplitL "Hl"; first (iNext; iExists true; eauto).
+ rewrite /locked. by iApply ("HΦ" $! true with "[$Hγ $HR]").
Qed.
Lemma acquire_spec γ lk R :
@@ -83,8 +83,9 @@ Section proof.
Proof.
iIntros (Φ) "(Hlock & Hlocked & HR) HΦ".
iDestruct "Hlock" as (l ->) "#Hinv".
- rewrite /release /=. wp_let. iInv N as (b) "[Hl _]" "Hclose".
- wp_store. iApply "HΦ". iApply "Hclose". iNext. iExists false. by iFrame.
+ rewrite /release /=. wp_let. iInv N as (b) "[Hl _]".
+ wp_store. iSplitR "HΦ"; last by iApply "HΦ".
+ iModIntro. iNext. iExists false. by iFrame.
Qed.
End proof.
diff --git a/theories/heap_lang/lib/ticket_lock.v b/theories/heap_lang/lib/ticket_lock.v
index c108b3f36103123f7a063778b7eaf0ca7a600cf5..db6c9ab28e9b0b7da3b2d2b30c71c4253140d35c 100644
--- a/theories/heap_lang/lib/ticket_lock.v
+++ b/theories/heap_lang/lib/ticket_lock.v
@@ -88,20 +88,18 @@ Section proof.
Proof.
iIntros (Φ) "[Hl Ht] HΦ". iDestruct "Hl" as (lo ln ->) "#Hinv".
iLöb as "IH". wp_rec. subst. wp_let. wp_proj. wp_bind (! _)%E.
- iInv N as (o n) "(Hlo & Hln & Ha)" "Hclose".
+ iInv N as (o n) "(Hlo & Hln & Ha)".
wp_load. destruct (decide (x = o)) as [->|Hneq].
- iDestruct "Ha" as "[Hainv [[Ho HR] | Haown]]".
- + iMod ("Hclose" with "[Hlo Hln Hainv Ht]") as "_".
+ + iModIntro. iSplitL "Hlo Hln Hainv Ht".
{ iNext. iExists o, n. iFrame. }
- iModIntro. wp_let. wp_op. case_bool_decide; [|done].
- wp_if.
+ wp_let. wp_op. case_bool_decide; [|done]. wp_if.
iApply ("HΦ" with "[-]"). rewrite /locked. iFrame. eauto.
+ iDestruct (own_valid_2 with "Ht Haown") as % [_ ?%gset_disj_valid_op].
set_solver.
- - iMod ("Hclose" with "[Hlo Hln Ha]").
+ - iModIntro. iSplitL "Hlo Hln Ha".
{ iNext. iExists o, n. by iFrame. }
- iModIntro. wp_let.
- wp_op. case_bool_decide; [simplify_eq |].
+ wp_let. wp_op. case_bool_decide; [simplify_eq |].
wp_if. iApply ("IH" with "Ht"). iNext. by iExact "HΦ".
Qed.
@@ -110,30 +108,28 @@ Section proof.
Proof.
iIntros (ϕ) "Hl HΦ". iDestruct "Hl" as (lo ln ->) "#Hinv".
iLöb as "IH". wp_rec. wp_bind (! _)%E. simplify_eq/=. wp_proj.
- iInv N as (o n) "[Hlo [Hln Ha]]" "Hclose".
- wp_load. iMod ("Hclose" with "[Hlo Hln Ha]") as "_".
+ iInv N as (o n) "[Hlo [Hln Ha]]".
+ wp_load. iModIntro. iSplitL "Hlo Hln Ha".
{ iNext. iExists o, n. by iFrame. }
- iModIntro. wp_let. wp_proj. wp_op.
- wp_bind (CAS _ _ _).
- iInv N as (o' n') "(>Hlo' & >Hln' & >Hauth & Haown)" "Hclose".
+ wp_let. wp_proj. wp_op. wp_bind (CAS _ _ _).
+ iInv N as (o' n') "(>Hlo' & >Hln' & >Hauth & Haown)".
destruct (decide (#n' = #n))%V as [[= ->%Nat2Z.inj] | Hneq].
- - wp_cas_suc.
- iMod (own_update with "Hauth") as "[Hauth Hofull]".
+ - iMod (own_update with "Hauth") as "[Hauth Hofull]".
{ eapply auth_update_alloc, prod_local_update_2.
eapply (gset_disj_alloc_empty_local_update _ {[ n ]}).
apply (seq_set_S_disjoint 0). }
rewrite -(seq_set_S_union_L 0).
- iMod ("Hclose" with "[Hlo' Hln' Haown Hauth]") as "_".
+ wp_cas_suc. iModIntro. iSplitL "Hlo' Hln' Haown Hauth".
{ iNext. iExists o', (S n).
rewrite Nat2Z.inj_succ -Z.add_1_r. by iFrame. }
- iModIntro. wp_if.
+ wp_if.
iApply (wait_loop_spec γ (#lo, #ln) with "[-HΦ]").
+ iFrame. rewrite /is_lock; eauto 10.
+ by iNext.
- - wp_cas_fail.
- iMod ("Hclose" with "[Hlo' Hln' Hauth Haown]") as "_".
+ - wp_cas_fail. iModIntro.
+ iSplitL "Hlo' Hln' Hauth Haown".
{ iNext. iExists o', n'. by iFrame. }
- iModIntro. wp_if. by iApply "IH"; auto.
+ wp_if. by iApply "IH"; auto.
Qed.
Lemma release_spec γ lk R :
@@ -142,15 +138,15 @@ Section proof.
iIntros (Φ) "(Hl & Hγ & HR) HΦ". iDestruct "Hl" as (lo ln ->) "#Hinv".
iDestruct "Hγ" as (o) "Hγo".
wp_let. wp_proj. wp_proj. wp_bind (! _)%E.
- iInv N as (o' n) "(>Hlo & >Hln & >Hauth & Haown)" "Hclose".
+ iInv N as (o' n) "(>Hlo & >Hln & >Hauth & Haown)".
wp_load.
iDestruct (own_valid_2 with "Hauth Hγo") as
%[[<-%Excl_included%leibniz_equiv _]%prod_included _]%auth_valid_discrete_2.
- iMod ("Hclose" with "[Hlo Hln Hauth Haown]") as "_".
+ iModIntro. iSplitL "Hlo Hln Hauth Haown".
{ iNext. iExists o, n. by iFrame. }
- iModIntro. wp_op.
- iInv N as (o' n') "(>Hlo & >Hln & >Hauth & Haown)" "Hclose".
- wp_store.
+ wp_op.
+ iInv N as (o' n') "(>Hlo & >Hln & >Hauth & Haown)".
+ iApply wp_fupd. wp_store.
iDestruct (own_valid_2 with "Hauth Hγo") as
%[[<-%Excl_included%leibniz_equiv _]%prod_included _]%auth_valid_discrete_2.
iDestruct "Haown" as "[[Hγo' _]|Haown]".
@@ -158,8 +154,8 @@ Section proof.
iMod (own_update_2 with "Hauth Hγo") as "[Hauth Hγo]".
{ apply auth_update, prod_local_update_1.
by apply option_local_update, (exclusive_local_update _ (Excl (S o))). }
- iMod ("Hclose" with "[Hlo Hln Hauth Haown Hγo HR]") as "_"; last by iApply "HΦ".
- iNext. iExists (S o), n'.
+ iModIntro. iSplitR "HΦ"; last by iApply "HΦ".
+ iIntros "!> !>". iExists (S o), n'.
rewrite Nat2Z.inj_succ -Z.add_1_r. iFrame. iLeft. by iFrame.
Qed.
End proof.
diff --git a/theories/heap_lang/lifting.v b/theories/heap_lang/lifting.v
index 94c8b1e8942243bc0bba771d1498ed8eb2e8d1b1..b6734455cd0c135483a48cd801de2f90891136ef 100644
--- a/theories/heap_lang/lifting.v
+++ b/theories/heap_lang/lifting.v
@@ -16,16 +16,15 @@ Instance heapG_irisG `{heapG Σ} : irisG heap_lang Σ := {
iris_invG := heapG_invG;
state_interp := gen_heap_ctx
}.
-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
@@ -52,8 +51,8 @@ Local Hint Resolve to_of_val.
Local Ltac solve_exec_safe := intros; subst; do 3 eexists; econstructor; eauto.
Local Ltac solve_exec_puredet := simpl; intros; by inv_head_step.
Local Ltac solve_pure_exec :=
- unfold IntoVal, AsVal in *; subst;
- repeat match goal with H : is_Some _ |- _ => destruct H as [??] end;
+ unfold IntoVal in *;
+ repeat match goal with H : AsVal _ |- _ => destruct H as [??] end; subst;
apply det_head_step_pure_exec; [ solve_exec_safe | solve_exec_puredet ].
Class AsRec (e : expr) (f x : binder) (erec : expr) :=
@@ -107,7 +106,7 @@ Implicit Types σ : state.
(** Base axioms for core primitives of the language: Stateless reductions *)
Lemma wp_fork s E e Φ :
- ▷ Φ (LitV LitUnit) ∗ ▷ WP e @ s; ⊤ {{ _, True }} ⊢ WP Fork e @ s; E {{ Φ }}.
+ ▷ (Φ (LitV LitUnit) ∗ WP e @ s; ⊤ {{ _, True }}) ⊢ WP Fork e @ s; E {{ Φ }}.
Proof.
iIntros "[HΦ He]".
iApply wp_lift_pure_det_head_step; [auto|intros; inv_head_step; eauto|].
@@ -126,7 +125,7 @@ Lemma wp_alloc s E e v :
IntoVal e v →
{{{ True }}} Alloc e @ s; E {{{ l, RET LitV (LitLoc l); l ↦ v }}}.
Proof.
- iIntros (<-%of_to_val Φ) "_ HΦ". iApply wp_lift_atomic_head_step_no_fork; auto.
+ iIntros (<- Φ) "_ HΦ". iApply wp_lift_atomic_head_step_no_fork; auto.
iIntros (σ1) "Hσ !>"; iSplit; first by auto.
iNext; iIntros (v2 σ2 efs Hstep); inv_head_step.
iMod (@gen_heap_alloc with "Hσ") as "[Hσ Hl]"; first done.
@@ -136,7 +135,7 @@ Lemma twp_alloc s E e v :
IntoVal e v →
[[{ True }]] Alloc e @ s; E [[{ l, RET LitV (LitLoc l); l ↦ v }]].
Proof.
- iIntros (<-%of_to_val Φ) "_ HΦ". iApply twp_lift_atomic_head_step_no_fork; auto.
+ iIntros (<- Φ) "_ HΦ". iApply twp_lift_atomic_head_step_no_fork; auto.
iIntros (σ1) "Hσ !>"; iSplit; first by auto.
iIntros (v2 σ2 efs Hstep); inv_head_step.
iMod (@gen_heap_alloc with "Hσ") as "[Hσ Hl]"; first done.
@@ -166,7 +165,7 @@ Lemma wp_store s E l v' e v :
IntoVal e v →
{{{ ▷ l ↦ v' }}} Store (Lit (LitLoc l)) e @ s; E {{{ RET LitV LitUnit; l ↦ v }}}.
Proof.
- iIntros (<-%of_to_val Φ) ">Hl HΦ".
+ iIntros (<- Φ) ">Hl HΦ".
iApply wp_lift_atomic_head_step_no_fork; auto.
iIntros (σ1) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?.
iSplit; first by eauto. iNext; iIntros (v2 σ2 efs Hstep); inv_head_step.
@@ -177,7 +176,7 @@ Lemma twp_store s E l v' e v :
IntoVal e v →
[[{ l ↦ v' }]] Store (Lit (LitLoc l)) e @ s; E [[{ RET LitV LitUnit; l ↦ v }]].
Proof.
- iIntros (<-%of_to_val Φ) "Hl HΦ".
+ iIntros (<- Φ) "Hl HΦ".
iApply twp_lift_atomic_head_step_no_fork; auto.
iIntros (σ1) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?.
iSplit; first by eauto. iIntros (v2 σ2 efs Hstep); inv_head_step.
@@ -186,22 +185,22 @@ Proof.
Qed.
Lemma wp_cas_fail s E l q v' e1 v1 e2 :
- IntoVal e1 v1 → AsVal e2 → v' ≠v1 →
+ IntoVal e1 v1 → AsVal e2 → v' ≠v1 → vals_cas_compare_safe v' v1 →
{{{ ▷ l ↦{q} v' }}} CAS (Lit (LitLoc l)) e1 e2 @ s; E
{{{ RET LitV (LitBool false); l ↦{q} v' }}}.
Proof.
- iIntros (<-%of_to_val [v2 <-%of_to_val] ? Φ) ">Hl HΦ".
+ iIntros (<- [v2 <-] ?? Φ) ">Hl HΦ".
iApply wp_lift_atomic_head_step_no_fork; auto.
iIntros (σ1) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?.
iSplit; first by eauto. iNext; iIntros (v2' σ2 efs Hstep); inv_head_step.
iModIntro; iSplit=> //. iFrame. by iApply "HΦ".
Qed.
Lemma twp_cas_fail s E l q v' e1 v1 e2 :
- IntoVal e1 v1 → AsVal e2 → v' ≠v1 →
+ IntoVal e1 v1 → AsVal e2 → v' ≠v1 → vals_cas_compare_safe v' v1 →
[[{ l ↦{q} v' }]] CAS (Lit (LitLoc l)) e1 e2 @ s; E
[[{ RET LitV (LitBool false); l ↦{q} v' }]].
Proof.
- iIntros (<-%of_to_val [v2 <-%of_to_val] ? Φ) "Hl HΦ".
+ iIntros (<- [v2 <-] ?? Φ) "Hl HΦ".
iApply twp_lift_atomic_head_step_no_fork; auto.
iIntros (σ1) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?.
iSplit; first by eauto. iIntros (v2' σ2 efs Hstep); inv_head_step.
@@ -209,11 +208,11 @@ Proof.
Qed.
Lemma wp_cas_suc s E l e1 v1 e2 v2 :
- IntoVal e1 v1 → IntoVal e2 v2 →
+ IntoVal e1 v1 → IntoVal e2 v2 → vals_cas_compare_safe v1 v1 →
{{{ ▷ l ↦ v1 }}} CAS (Lit (LitLoc l)) e1 e2 @ s; E
{{{ RET LitV (LitBool true); l ↦ v2 }}}.
Proof.
- iIntros (<-%of_to_val <-%of_to_val Φ) ">Hl HΦ".
+ iIntros (<- <- ? Φ) ">Hl HΦ".
iApply wp_lift_atomic_head_step_no_fork; auto.
iIntros (σ1) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?.
iSplit; first by eauto. iNext; iIntros (v2' σ2 efs Hstep); inv_head_step.
@@ -221,11 +220,11 @@ Proof.
iModIntro. iSplit=>//. by iApply "HΦ".
Qed.
Lemma twp_cas_suc s E l e1 v1 e2 v2 :
- IntoVal e1 v1 → IntoVal e2 v2 →
+ IntoVal e1 v1 → IntoVal e2 v2 → vals_cas_compare_safe v1 v1 →
[[{ l ↦ v1 }]] CAS (Lit (LitLoc l)) e1 e2 @ s; E
[[{ RET LitV (LitBool true); l ↦ v2 }]].
Proof.
- iIntros (<-%of_to_val <-%of_to_val Φ) "Hl HΦ".
+ iIntros (<- <- ? Φ) "Hl HΦ".
iApply twp_lift_atomic_head_step_no_fork; auto.
iIntros (σ1) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?.
iSplit; first by eauto. iIntros (v2' σ2 efs Hstep); inv_head_step.
@@ -238,7 +237,7 @@ Lemma wp_faa s E l i1 e2 i2 :
{{{ ▷ l ↦ LitV (LitInt i1) }}} FAA (Lit (LitLoc l)) e2 @ s; E
{{{ RET LitV (LitInt i1); l ↦ LitV (LitInt (i1 + i2)) }}}.
Proof.
- iIntros (<-%of_to_val Φ) ">Hl HΦ".
+ iIntros (<- Φ) ">Hl HΦ".
iApply wp_lift_atomic_head_step_no_fork; auto.
iIntros (σ1) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?.
iSplit; first by eauto. iNext; iIntros (v2' σ2 efs Hstep); inv_head_step.
@@ -250,7 +249,7 @@ Lemma twp_faa s E l i1 e2 i2 :
[[{ l ↦ LitV (LitInt i1) }]] FAA (Lit (LitLoc l)) e2 @ s; E
[[{ RET LitV (LitInt i1); l ↦ LitV (LitInt (i1 + i2)) }]].
Proof.
- iIntros (<-%of_to_val Φ) "Hl HΦ".
+ iIntros (<- Φ) "Hl HΦ".
iApply twp_lift_atomic_head_step_no_fork; auto.
iIntros (σ1) "Hσ !>". iDestruct (@gen_heap_valid with "Hσ Hl") as %?.
iSplit; first by eauto. iIntros (v2' σ2 efs Hstep); inv_head_step.
diff --git a/theories/heap_lang/notation.v b/theories/heap_lang/notation.v
index 3751417fa10d2a6f30996a34389d880a86993bcb..f8ef7a58517e001c25d35b3bcbeccdcbc9714547 100644
--- a/theories/heap_lang/notation.v
+++ b/theories/heap_lang/notation.v
@@ -2,6 +2,9 @@ From iris.program_logic Require Import language.
From iris.heap_lang Require Export lang tactics.
Set Default Proof Using "Type".
+Delimit Scope expr_scope with E.
+Delimit Scope val_scope with V.
+
Coercion LitInt : Z >-> base_lit.
Coercion LitBool : bool >-> base_lit.
Coercion LitLoc : loc >-> base_lit.
@@ -141,10 +144,10 @@ Notation "e1 || e2" :=
(If e1%E (Lit (LitBool true)) e2%E) (only parsing) : expr_scope.
(** Notations for option *)
-Notation NONE := (InjL #()) (only parsing).
+Notation NONE := (InjL (Lit LitUnit)) (only parsing).
Notation SOME x := (InjR x) (only parsing).
-Notation NONEV := (InjLV #()) (only parsing).
+Notation NONEV := (InjLV (LitV LitUnit)) (only parsing).
Notation SOMEV x := (InjRV x) (only parsing).
Notation "'match:' e0 'with' 'NONE' => e1 | 'SOME' x => e2 'end'" :=
diff --git a/theories/heap_lang/proofmode.v b/theories/heap_lang/proofmode.v
index d291d51c85eae613c8938b827e12090e18851196..e2324fd403309de1cc3c35b452bb0fdd9f2d83ba 100644
--- a/theories/heap_lang/proofmode.v
+++ b/theories/heap_lang/proofmode.v
@@ -1,7 +1,8 @@
From iris.program_logic Require Export weakestpre total_weakestpre.
-From iris.proofmode Require Import coq_tactics.
+From iris.proofmode Require Import coq_tactics reduction.
From iris.proofmode Require Export tactics.
From iris.heap_lang Require Export tactics lifting.
+From iris.heap_lang Require Import notation.
Set Default Proof Using "Type".
Import uPred.
@@ -36,7 +37,7 @@ Lemma tac_wp_pure `{heapG Σ} Δ Δ' s E e1 e2 φ Φ :
envs_entails Δ' (WP e2 @ s; E {{ Φ }}) →
envs_entails Δ (WP e1 @ s; E {{ Φ }}).
Proof.
- rewrite /envs_entails=> ??? HΔ'. rewrite into_laterN_env_sound /=.
+ rewrite envs_entails_eq=> ??? HΔ'. rewrite into_laterN_env_sound /=.
rewrite HΔ' -lifting.wp_pure_step_later //.
Qed.
Lemma tac_twp_pure `{heapG Σ} Δ s E e1 e2 φ Φ :
@@ -45,22 +46,22 @@ Lemma tac_twp_pure `{heapG Σ} Δ s E e1 e2 φ Φ :
envs_entails Δ (WP e2 @ s; E [{ Φ }]) →
envs_entails Δ (WP e1 @ s; E [{ Φ }]).
Proof.
- rewrite /envs_entails=> ?? ->. rewrite -total_lifting.twp_pure_step //.
+ rewrite envs_entails_eq=> ?? ->. rewrite -total_lifting.twp_pure_step //.
Qed.
Lemma tac_wp_value `{heapG Σ} Δ s E Φ e v :
IntoVal e v →
envs_entails Δ (Φ v) → envs_entails Δ (WP e @ s; E {{ Φ }}).
-Proof. rewrite /envs_entails=> ? ->. by apply wp_value. Qed.
+Proof. rewrite envs_entails_eq=> ? ->. by apply wp_value. Qed.
Lemma tac_twp_value `{heapG Σ} Δ s E Φ e v :
IntoVal e v →
envs_entails Δ (Φ v) → envs_entails Δ (WP e @ s; E [{ Φ }]).
-Proof. rewrite /envs_entails=> ? ->. by apply twp_value. Qed.
+Proof. rewrite envs_entails_eq=> ? ->. by apply twp_value. Qed.
Ltac wp_value_head :=
first [eapply tac_wp_value || eapply tac_twp_value];
- [apply _
- |iEval (lazy beta; simpl of_val)].
+ [iSolveTC
+ |reduction.pm_prettify; iEval (simpl of_val)].
Tactic Notation "wp_pure" open_constr(efoc) :=
iStartProof;
@@ -70,9 +71,9 @@ Tactic Notation "wp_pure" open_constr(efoc) :=
reshape_expr e ltac:(fun K e' =>
unify e' efoc;
eapply (tac_wp_pure _ _ _ _ (fill K e'));
- [apply _ (* PureExec *)
+ [iSolveTC (* PureExec *)
|try fast_done (* The pure condition for PureExec *)
- |apply _ (* IntoLaters *)
+ |iSolveTC (* IntoLaters *)
|wp_expr_simpl_subst; try wp_value_head (* new goal *)
])
|| fail "wp_pure: cannot find" efoc "in" e "or" efoc "is not a redex"
@@ -81,7 +82,7 @@ Tactic Notation "wp_pure" open_constr(efoc) :=
reshape_expr e ltac:(fun K e' =>
unify e' efoc;
eapply (tac_twp_pure _ _ _ (fill K e'));
- [apply _ (* PureExec *)
+ [iSolveTC (* PureExec *)
|try fast_done (* The pure condition for PureExec *)
|wp_expr_simpl_subst; try wp_value_head (* new goal *)
])
@@ -107,22 +108,22 @@ Lemma tac_wp_bind `{heapG Σ} K Δ s E Φ e f :
f = (λ e, fill K e) → (* as an eta expanded hypothesis so that we can `simpl` it *)
envs_entails Δ (WP e @ s; E {{ v, WP f (of_val v) @ s; E {{ Φ }} }})%I →
envs_entails Δ (WP fill K e @ s; E {{ Φ }}).
-Proof. rewrite /envs_entails=> -> ->. by apply: wp_bind. Qed.
+Proof. rewrite envs_entails_eq=> -> ->. by apply: wp_bind. Qed.
Lemma tac_twp_bind `{heapG Σ} K Δ s E Φ e f :
f = (λ e, fill K e) → (* as an eta expanded hypothesis so that we can `simpl` it *)
envs_entails Δ (WP e @ s; E [{ v, WP f (of_val v) @ s; E [{ Φ }] }])%I →
envs_entails Δ (WP fill K e @ s; E [{ Φ }]).
-Proof. rewrite /envs_entails=> -> ->. by apply: twp_bind. Qed.
+Proof. rewrite envs_entails_eq=> -> ->. by apply: twp_bind. Qed.
Ltac wp_bind_core K :=
lazymatch eval hnf in K with
| [] => idtac
- | _ => eapply (tac_wp_bind K); [simpl; reflexivity|lazy beta]
+ | _ => eapply (tac_wp_bind K); [simpl; reflexivity|reduction.pm_prettify]
end.
Ltac twp_bind_core K :=
lazymatch eval hnf in K with
| [] => idtac
- | _ => eapply (tac_twp_bind K); [simpl; reflexivity|lazy beta]
+ | _ => eapply (tac_twp_bind K); [simpl; reflexivity|reduction.pm_prettify]
end.
Tactic Notation "wp_bind" open_constr(efoc) :=
@@ -142,7 +143,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 Δ Δ' s E j K e v Φ :
IntoVal e v →
@@ -152,7 +153,7 @@ Lemma tac_wp_alloc Δ Δ' s E j K e v Φ :
envs_entails Δ'' (WP fill K (Lit (LitLoc l)) @ s; E {{ Φ }})) →
envs_entails Δ (WP fill K (Alloc e) @ s; E {{ Φ }}).
Proof.
- rewrite /envs_entails=> ?? HΔ.
+ rewrite envs_entails_eq=> ?? HΔ.
rewrite -wp_bind. eapply wand_apply; first exact: wp_alloc.
rewrite left_id into_laterN_env_sound; apply later_mono, forall_intro=> l.
destruct (HΔ l) as (Δ''&?&HΔ'). rewrite envs_app_sound //; simpl.
@@ -165,7 +166,7 @@ Lemma tac_twp_alloc Δ s E j K e v Φ :
envs_entails Δ' (WP fill K (Lit (LitLoc l)) @ s; E [{ Φ }])) →
envs_entails Δ (WP fill K (Alloc e) @ s; E [{ Φ }]).
Proof.
- rewrite /envs_entails=> ? HΔ.
+ rewrite envs_entails_eq=> ? HΔ.
rewrite -twp_bind. eapply wand_apply; first exact: twp_alloc.
rewrite left_id. apply forall_intro=> l.
destruct (HΔ l) as (Δ'&?&HΔ'). rewrite envs_app_sound //; simpl.
@@ -178,7 +179,7 @@ Lemma tac_wp_load Δ Δ' s E i K l q v Φ :
envs_entails Δ' (WP fill K (of_val v) @ s; E {{ Φ }}) →
envs_entails Δ (WP fill K (Load (Lit (LitLoc l))) @ s; E {{ Φ }}).
Proof.
- rewrite /envs_entails=> ???.
+ rewrite envs_entails_eq=> ???.
rewrite -wp_bind. eapply wand_apply; first exact: wp_load.
rewrite into_laterN_env_sound -later_sep envs_lookup_split //; simpl.
by apply later_mono, sep_mono_r, wand_mono.
@@ -188,7 +189,7 @@ Lemma tac_twp_load Δ s E i K l q v Φ :
envs_entails Δ (WP fill K (of_val v) @ s; E [{ Φ }]) →
envs_entails Δ (WP fill K (Load (Lit (LitLoc l))) @ s; E [{ Φ }]).
Proof.
- rewrite /envs_entails=> ??.
+ rewrite envs_entails_eq=> ??.
rewrite -twp_bind. eapply wand_apply; first exact: twp_load.
rewrite envs_lookup_split //; simpl.
by apply sep_mono_r, wand_mono.
@@ -202,7 +203,7 @@ Lemma tac_wp_store Δ Δ' Δ'' s E i K l v e v' Φ :
envs_entails Δ'' (WP fill K (Lit LitUnit) @ s; E {{ Φ }}) →
envs_entails Δ (WP fill K (Store (Lit (LitLoc l)) e) @ s; E {{ Φ }}).
Proof.
- rewrite /envs_entails=> ?????.
+ rewrite envs_entails_eq=> ?????.
rewrite -wp_bind. eapply wand_apply; first by eapply wp_store.
rewrite into_laterN_env_sound -later_sep envs_simple_replace_sound //; simpl.
rewrite right_id. by apply later_mono, sep_mono_r, wand_mono.
@@ -214,54 +215,101 @@ Lemma tac_twp_store Δ Δ' s E i K l v e v' Φ :
envs_entails Δ' (WP fill K (Lit LitUnit) @ s; E [{ Φ }]) →
envs_entails Δ (WP fill K (Store (Lit (LitLoc l)) e) @ s; E [{ Φ }]).
Proof.
- intros. rewrite -twp_bind. eapply wand_apply; first by eapply twp_store.
+ rewrite envs_entails_eq. intros. rewrite -twp_bind.
+ eapply wand_apply; first by eapply twp_store.
rewrite envs_simple_replace_sound //; simpl.
rewrite right_id. by apply sep_mono_r, wand_mono.
Qed.
+Lemma tac_wp_cas Δ Δ' Δ'' s E i K l v e1 v1 e2 v2 Φ :
+ IntoVal e1 v1 → IntoVal e2 v2 →
+ MaybeIntoLaterNEnvs 1 Δ Δ' →
+ envs_lookup i Δ' = Some (false, l ↦ v)%I →
+ envs_simple_replace i false (Esnoc Enil i (l ↦ v2)) Δ' = Some Δ'' →
+ vals_cas_compare_safe v v1 →
+ (v = v1 → envs_entails Δ'' (WP fill K (Lit (LitBool true)) @ s; E {{ Φ }})) →
+ (v ≠v1 → envs_entails Δ' (WP fill K (Lit (LitBool false)) @ s; E {{ Φ }})) →
+ envs_entails Δ (WP fill K (CAS (Lit (LitLoc l)) e1 e2) @ s; E {{ Φ }}).
+Proof.
+ rewrite envs_entails_eq=> ?????? Hsuc Hfail. destruct (decide (v = v1)) as [<-|Hne].
+ - rewrite -wp_bind. eapply wand_apply; first exact: wp_cas_suc.
+ rewrite into_laterN_env_sound -later_sep /= {1}envs_simple_replace_sound //; simpl.
+ apply later_mono, sep_mono_r. rewrite right_id. apply wand_mono; auto.
+ - rewrite -wp_bind. eapply wand_apply.
+ { eapply wp_cas_fail; eauto. by eexists. }
+ rewrite into_laterN_env_sound -later_sep /= {1}envs_lookup_split //; simpl.
+ apply later_mono, sep_mono_r. apply wand_mono; auto.
+Qed.
+Lemma tac_twp_cas Δ Δ' s E i K l v e1 v1 e2 v2 Φ :
+ IntoVal e1 v1 → IntoVal e2 v2 →
+ envs_lookup i Δ = Some (false, l ↦ v)%I →
+ envs_simple_replace i false (Esnoc Enil i (l ↦ v2)) Δ = Some Δ' →
+ vals_cas_compare_safe v v1 →
+ (v = v1 → envs_entails Δ' (WP fill K (Lit (LitBool true)) @ s; E [{ Φ }])) →
+ (v ≠v1 → envs_entails Δ (WP fill K (Lit (LitBool false)) @ s; E [{ Φ }])) →
+ envs_entails Δ (WP fill K (CAS (Lit (LitLoc l)) e1 e2) @ s; E [{ Φ }]).
+Proof.
+ rewrite envs_entails_eq=> ????? Hsuc Hfail. destruct (decide (v = v1)) as [<-|Hne].
+ - rewrite -twp_bind. eapply wand_apply; first exact: twp_cas_suc.
+ rewrite /= {1}envs_simple_replace_sound //; simpl.
+ apply sep_mono_r. rewrite right_id. apply wand_mono; auto.
+ - rewrite -twp_bind. eapply wand_apply.
+ { eapply twp_cas_fail; eauto. by eexists. }
+ rewrite /= {1}envs_lookup_split //; simpl.
+ apply sep_mono_r. apply wand_mono; auto.
+Qed.
+
Lemma tac_wp_cas_fail Δ Δ' s E i K l q v e1 v1 e2 Φ :
IntoVal e1 v1 → AsVal e2 →
MaybeIntoLaterNEnvs 1 Δ Δ' →
- envs_lookup i Δ' = Some (false, l ↦{q} v)%I → v ≠v1 →
+ envs_lookup i Δ' = Some (false, l ↦{q} v)%I →
+ v ≠v1 → vals_cas_compare_safe v v1 →
envs_entails Δ' (WP fill K (Lit (LitBool false)) @ s; E {{ Φ }}) →
envs_entails Δ (WP fill K (CAS (Lit (LitLoc l)) e1 e2) @ s; E {{ Φ }}).
Proof.
- rewrite /envs_entails=> ??????.
+ rewrite envs_entails_eq=> ???????.
rewrite -wp_bind. eapply wand_apply; first exact: wp_cas_fail.
rewrite into_laterN_env_sound -later_sep envs_lookup_split //; simpl.
by apply later_mono, sep_mono_r, wand_mono.
Qed.
Lemma tac_twp_cas_fail Δ s E i K l q v e1 v1 e2 Φ :
IntoVal e1 v1 → AsVal e2 →
- envs_lookup i Δ = Some (false, l ↦{q} v)%I → v ≠v1 →
+ envs_lookup i Δ = Some (false, l ↦{q} v)%I →
+ v ≠v1 → vals_cas_compare_safe v v1 →
envs_entails Δ (WP fill K (Lit (LitBool false)) @ s; E [{ Φ }]) →
envs_entails Δ (WP fill K (CAS (Lit (LitLoc l)) e1 e2) @ s; E [{ Φ }]).
Proof.
- intros. rewrite -twp_bind. eapply wand_apply; first exact: twp_cas_fail.
- rewrite envs_lookup_split //; simpl. by apply sep_mono_r, wand_mono.
+ rewrite envs_entails_eq. intros. rewrite -twp_bind.
+ eapply wand_apply; first exact: twp_cas_fail.
+ rewrite envs_lookup_split //=. by do 2 f_equiv.
Qed.
Lemma tac_wp_cas_suc Δ Δ' Δ'' s E i K l v e1 v1 e2 v2 Φ :
IntoVal e1 v1 → IntoVal e2 v2 →
MaybeIntoLaterNEnvs 1 Δ Δ' →
- envs_lookup i Δ' = Some (false, l ↦ v)%I → v = v1 →
+ envs_lookup i Δ' = Some (false, l ↦ v)%I →
envs_simple_replace i false (Esnoc Enil i (l ↦ v2)) Δ' = Some Δ'' →
+ v = v1 → val_is_unboxed v →
envs_entails Δ'' (WP fill K (Lit (LitBool true)) @ s; E {{ Φ }}) →
envs_entails Δ (WP fill K (CAS (Lit (LitLoc l)) e1 e2) @ s; E {{ Φ }}).
Proof.
- rewrite /envs_entails=> ???????; subst.
- rewrite -wp_bind. eapply wand_apply; first exact: wp_cas_suc.
+ rewrite envs_entails_eq=> ????????; subst.
+ rewrite -wp_bind. eapply wand_apply.
+ { eapply wp_cas_suc; eauto. by left. }
rewrite into_laterN_env_sound -later_sep envs_simple_replace_sound //; simpl.
rewrite right_id. by apply later_mono, sep_mono_r, wand_mono.
Qed.
Lemma tac_twp_cas_suc Δ Δ' s E i K l v e1 v1 e2 v2 Φ :
IntoVal e1 v1 → IntoVal e2 v2 →
- envs_lookup i Δ = Some (false, l ↦ v)%I → v = v1 →
+ envs_lookup i Δ = Some (false, l ↦ v)%I →
envs_simple_replace i false (Esnoc Enil i (l ↦ v2)) Δ = Some Δ' →
+ v = v1 → val_is_unboxed v →
envs_entails Δ' (WP fill K (Lit (LitBool true)) @ s; E [{ Φ }]) →
envs_entails Δ (WP fill K (CAS (Lit (LitLoc l)) e1 e2) @ s; E [{ Φ }]).
Proof.
- intros; subst. rewrite -twp_bind. eapply wand_apply; first exact: twp_cas_suc.
+ rewrite envs_entails_eq. intros; subst.
+ rewrite -twp_bind. eapply wand_apply.
+ { eapply twp_cas_suc; eauto. by left. }
rewrite envs_simple_replace_sound //; simpl.
rewrite right_id. by apply sep_mono_r, wand_mono.
Qed.
@@ -274,7 +322,7 @@ Lemma tac_wp_faa Δ Δ' Δ'' s E i K l i1 e2 i2 Φ :
envs_entails Δ'' (WP fill K (Lit (LitInt i1)) @ s; E {{ Φ }}) →
envs_entails Δ (WP fill K (FAA (Lit (LitLoc l)) e2) @ s; E {{ Φ }}).
Proof.
- rewrite /envs_entails=> ?????; subst.
+ rewrite envs_entails_eq=> ?????; subst.
rewrite -wp_bind. eapply wand_apply; first exact: (wp_faa _ _ _ i1 _ i2).
rewrite into_laterN_env_sound -later_sep envs_simple_replace_sound //; simpl.
rewrite right_id. by apply later_mono, sep_mono_r, wand_mono.
@@ -286,7 +334,7 @@ Lemma tac_twp_faa Δ Δ' s E i K l i1 e2 i2 Φ :
envs_entails Δ' (WP fill K (Lit (LitInt i1)) @ s; E [{ Φ }]) →
envs_entails Δ (WP fill K (FAA (Lit (LitLoc l)) e2) @ s; E [{ Φ }]).
Proof.
- rewrite /envs_entails=> ????; subst.
+ rewrite envs_entails_eq=> ????; subst.
rewrite -twp_bind. eapply wand_apply; first exact: (twp_faa _ _ _ i1 _ i2).
rewrite envs_simple_replace_sound //; simpl.
rewrite right_id. by apply sep_mono_r, wand_mono.
@@ -312,31 +360,32 @@ Tactic Notation "wp_apply" open_constr(lem) :=
end).
Tactic Notation "wp_alloc" ident(l) "as" constr(H) :=
+ let Htmp := iFresh in
let finish _ :=
first [intros l | fail 1 "wp_alloc:" l "not fresh"];
eexists; split;
- [env_cbv; reflexivity || fail "wp_alloc:" H "not fresh"
- |wp_expr_simpl; try wp_value_head] in
+ [pm_reflexivity || fail "wp_alloc:" H "not fresh"
+ |iDestructHyp Htmp as H; wp_expr_simpl; try wp_value_head] in
iStartProof;
lazymatch goal with
| |- envs_entails _ (wp ?s ?E ?e ?Q) =>
first
[reshape_expr e ltac:(fun K e' =>
- eapply (tac_wp_alloc _ _ _ _ H K); [apply _|..])
+ eapply (tac_wp_alloc _ _ _ _ Htmp K); [iSolveTC|..])
|fail 1 "wp_alloc: cannot find 'Alloc' in" e];
- [apply _
+ [iSolveTC
|finish ()]
| |- envs_entails _ (twp ?s ?E ?e ?Q) =>
first
[reshape_expr e ltac:(fun K e' =>
- eapply (tac_twp_alloc _ _ _ H K); [apply _|..])
+ eapply (tac_twp_alloc _ _ _ Htmp K); [iSolveTC|..])
|fail 1 "wp_alloc: cannot find 'Alloc' in" e];
finish ()
| _ => fail "wp_alloc: not a 'wp'"
end.
Tactic Notation "wp_alloc" ident(l) :=
- let H := iFresh in wp_alloc l as H.
+ wp_alloc l as "?".
Tactic Notation "wp_load" :=
let solve_mapsto _ :=
@@ -348,7 +397,7 @@ Tactic Notation "wp_load" :=
first
[reshape_expr e ltac:(fun K e' => eapply (tac_wp_load _ _ _ _ _ K))
|fail 1 "wp_load: cannot find 'Load' in" e];
- [apply _
+ [iSolveTC
|solve_mapsto ()
|wp_expr_simpl; try wp_value_head]
| |- envs_entails _ (twp ?s ?E ?e ?Q) =>
@@ -371,23 +420,53 @@ Tactic Notation "wp_store" :=
| |- envs_entails _ (wp ?s ?E ?e ?Q) =>
first
[reshape_expr e ltac:(fun K e' =>
- eapply (tac_wp_store _ _ _ _ _ _ K); [apply _|..])
+ eapply (tac_wp_store _ _ _ _ _ _ K); [iSolveTC|..])
|fail 1 "wp_store: cannot find 'Store' in" e];
- [apply _
+ [iSolveTC
|solve_mapsto ()
- |env_cbv; reflexivity
+ |pm_reflexivity
|finish ()]
| |- envs_entails _ (twp ?s ?E ?e ?Q) =>
first
[reshape_expr e ltac:(fun K e' =>
- eapply (tac_twp_store _ _ _ _ _ K); [apply _|..])
+ eapply (tac_twp_store _ _ _ _ _ K); [iSolveTC|..])
|fail 1 "wp_store: cannot find 'Store' in" e];
[solve_mapsto ()
- |env_cbv; reflexivity
+ |pm_reflexivity
|finish ()]
| _ => fail "wp_store: not a 'wp'"
end.
+Tactic Notation "wp_cas" "as" simple_intropattern(H1) "|" simple_intropattern(H2) :=
+ let solve_mapsto _ :=
+ let l := match goal with |- _ = Some (_, (?l ↦{_} _)%I) => l end in
+ iAssumptionCore || fail "wp_cas: cannot find" l "↦ ?" in
+ iStartProof;
+ lazymatch goal with
+ | |- envs_entails _ (wp ?s ?E ?e ?Q) =>
+ first
+ [reshape_expr e ltac:(fun K e' =>
+ eapply (tac_wp_cas _ _ _ _ _ _ K); [iSolveTC|iSolveTC|..])
+ |fail 1 "wp_cas: cannot find 'CAS' in" e];
+ [iSolveTC
+ |solve_mapsto ()
+ |pm_reflexivity
+ |try (fast_done || (left; fast_done) || (right; fast_done)) (* vals_cas_compare_safe *)
+ |intros H1; wp_expr_simpl; try wp_value_head
+ |intros H2; wp_expr_simpl; try wp_value_head]
+ | |- envs_entails _ (twp ?E ?e ?Q) =>
+ first
+ [reshape_expr e ltac:(fun K e' =>
+ eapply (tac_twp_cas _ _ _ _ _ K); [iSolveTC|iSolveTC|..])
+ |fail 1 "wp_cas: cannot find 'CAS' in" e];
+ [solve_mapsto ()
+ |pm_reflexivity
+ |try (fast_done || (left; fast_done) || (right; fast_done)) (* vals_cas_compare_safe *)
+ |intros H1; wp_expr_simpl; try wp_value_head
+ |intros H2; wp_expr_simpl; try wp_value_head]
+ | _ => fail "wp_cas: not a 'wp'"
+ end.
+
Tactic Notation "wp_cas_fail" :=
let solve_mapsto _ :=
let l := match goal with |- _ = Some (_, (?l ↦{_} _)%I) => l end in
@@ -397,19 +476,21 @@ Tactic Notation "wp_cas_fail" :=
| |- envs_entails _ (wp ?s ?E ?e ?Q) =>
first
[reshape_expr e ltac:(fun K e' =>
- eapply (tac_wp_cas_fail _ _ _ _ _ K); [apply _|apply _|..])
+ eapply (tac_wp_cas_fail _ _ _ _ _ K); [iSolveTC|iSolveTC|..])
|fail 1 "wp_cas_fail: cannot find 'CAS' in" e];
- [apply _
+ [iSolveTC
|solve_mapsto ()
|try congruence
+ |try (fast_done || (left; fast_done) || (right; fast_done)) (* vals_cas_compare_safe *)
|simpl; try wp_value_head]
| |- envs_entails _ (twp ?s ?E ?e ?Q) =>
first
[reshape_expr e ltac:(fun K e' =>
- eapply (tac_twp_cas_fail _ _ _ _ K); [apply _|apply _|..])
+ eapply (tac_twp_cas_fail _ _ _ _ K); [iSolveTC|iSolveTC|..])
|fail 1 "wp_cas_fail: cannot find 'CAS' in" e];
[solve_mapsto ()
|try congruence
+ |try (fast_done || (left; fast_done) || (right; fast_done)) (* vals_cas_compare_safe *)
|wp_expr_simpl; try wp_value_head]
| _ => fail "wp_cas_fail: not a 'wp'"
end.
@@ -423,21 +504,23 @@ Tactic Notation "wp_cas_suc" :=
| |- envs_entails _ (wp ?s ?E ?e ?Q) =>
first
[reshape_expr e ltac:(fun K e' =>
- eapply (tac_wp_cas_suc _ _ _ _ _ _ K); [apply _|apply _|..])
+ eapply (tac_wp_cas_suc _ _ _ _ _ _ K); [iSolveTC|iSolveTC|..])
|fail 1 "wp_cas_suc: cannot find 'CAS' in" e];
- [apply _
+ [iSolveTC
|solve_mapsto ()
+ |pm_reflexivity
|try congruence
- |env_cbv; reflexivity
+ |try fast_done (* vals_cas_compare_safe *)
|simpl; try wp_value_head]
| |- envs_entails _ (twp ?E ?e ?Q) =>
first
[reshape_expr e ltac:(fun K e' =>
- eapply (tac_twp_cas_suc _ _ _ _ _ K); [apply _|apply _|..])
+ eapply (tac_twp_cas_suc _ _ _ _ _ K); [iSolveTC|iSolveTC|..])
|fail 1 "wp_cas_suc: cannot find 'CAS' in" e];
[solve_mapsto ()
+ |pm_reflexivity
|try congruence
- |env_cbv; reflexivity
+ |try fast_done (* vals_cas_compare_safe *)
|wp_expr_simpl; try wp_value_head]
| _ => fail "wp_cas_suc: not a 'wp'"
end.
@@ -451,19 +534,19 @@ Tactic Notation "wp_faa" :=
| |- envs_entails _ (wp ?s ?E ?e ?Q) =>
first
[reshape_expr e ltac:(fun K e' =>
- eapply (tac_wp_faa _ _ _ _ _ _ K); [apply _|..])
+ eapply (tac_wp_faa _ _ _ _ _ _ K); [iSolveTC|..])
|fail 1 "wp_faa: cannot find 'CAS' in" e];
- [apply _
+ [iSolveTC
|solve_mapsto ()
- |env_cbv; reflexivity
+ |pm_reflexivity
|wp_expr_simpl; try wp_value_head]
| |- envs_entails _ (twp ?s ?E ?e ?Q) =>
first
[reshape_expr e ltac:(fun K e' =>
- eapply (tac_twp_faa _ _ _ _ _ K); [apply _|..])
+ eapply (tac_twp_faa _ _ _ _ _ K); [iSolveTC|..])
|fail 1 "wp_faa: cannot find 'CAS' in" e];
[solve_mapsto ()
- |env_cbv; reflexivity
+ |pm_reflexivity
|wp_expr_simpl; try wp_value_head]
| _ => fail "wp_faa: not a 'wp'"
end.
diff --git a/theories/heap_lang/tactics.v b/theories/heap_lang/tactics.v
index 1789ca57080da7b48708345567d2701eafcaed5f..604a7244d5da7fd724012fafd4d6110e684cf6c5 100644
--- a/theories/heap_lang/tactics.v
+++ b/theories/heap_lang/tactics.v
@@ -96,6 +96,7 @@ Ltac of_expr e :=
let e1 := of_expr e1 in let e2 := of_expr e2 in constr:(FAA e1 e2)
| to_expr ?e => e
| of_val ?v => constr:(Val v (of_val v) (to_of_val v))
+ | language.of_val ?v => constr:(Val v (of_val v) (to_of_val v))
| _ => match goal with
| H : to_val e = Some ?v |- _ => constr:(Val v e H)
| H : Closed [] e |- _ => constr:(@ClosedExpr e H)
@@ -138,14 +139,12 @@ Fixpoint to_val (e : expr) : option val :=
| _ => None
end.
Lemma to_val_Some e v :
- to_val e = Some v → heap_lang.to_val (to_expr e) = Some v.
+ to_val e = Some v → heap_lang.of_val v = W.to_expr e.
Proof.
- revert v. induction e; intros; simplify_option_eq; rewrite ?to_of_val; auto.
- - do 2 f_equal. apply proof_irrel.
- - exfalso. unfold Closed in *; eauto using is_closed_correct.
+ revert v. induction e; intros; simplify_option_eq; try f_equal; auto using of_to_val.
Qed.
Lemma to_val_is_Some e :
- is_Some (to_val e) → is_Some (heap_lang.to_val (to_expr e)).
+ is_Some (to_val e) → ∃ v, heap_lang.of_val v = to_expr e.
Proof. intros [v ?]; exists v; eauto using to_val_Some. Qed.
Fixpoint subst (x : string) (es : expr) (e : expr) : expr :=
@@ -201,8 +200,8 @@ Proof.
inversion 1; simplify_eq/=; rewrite ?to_of_val; eauto.
unfold subst'; repeat (simplify_eq/=; case_match=>//); eauto.
- apply ectxi_language_sub_redexes_are_values=> /= Ki e' Hfill.
- destruct e=> //; destruct Ki; repeat (simplify_eq/=; case_match=>//);
- naive_solver eauto using to_val_is_Some.
+ destruct e=> //; destruct Ki; repeat (simplify_eq/=; case_match=>//); try
+ naive_solver eauto using as_val_is_Some, to_val_is_Some.
Qed.
End W.
@@ -217,7 +216,7 @@ Hint Extern 0 (Closed _ _) => solve_closed : typeclass_instances.
Ltac solve_into_val :=
match goal with
| |- IntoVal ?e ?v =>
- let e' := W.of_expr e in change (to_val (W.to_expr e') = Some v);
+ let e' := W.of_expr e in change (of_val v = W.to_expr e');
apply W.to_val_Some; simpl; unfold W.to_expr; reflexivity
end.
Hint Extern 10 (IntoVal _ _) => solve_into_val : typeclass_instances.
@@ -225,7 +224,7 @@ Hint Extern 10 (IntoVal _ _) => solve_into_val : typeclass_instances.
Ltac solve_as_val :=
match goal with
| |- AsVal ?e =>
- let e' := W.of_expr e in change (is_Some (to_val (W.to_expr e')));
+ let e' := W.of_expr e in change (∃ v, of_val v = W.to_expr e');
apply W.to_val_is_Some, (bool_decide_unpack _); vm_compute; exact I
end.
Hint Extern 10 (AsVal _) => solve_as_val : typeclass_instances.
diff --git a/theories/program_logic/adequacy.v b/theories/program_logic/adequacy.v
index fb5a6b41e4f6fb32ed12e94a6ce592d342ac8dc7..9d5a3bceefbd710bf46caf7bf5ad8d8cc7a74e02 100644
--- a/theories/program_logic/adequacy.v
+++ b/theories/program_logic/adequacy.v
@@ -1,6 +1,6 @@
+From stdpp Require Import namespaces.
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.lib Require Import wsat.
From iris.proofmode Require Import tactics.
Set Default Proof Using "Type".
@@ -76,10 +76,10 @@ Lemma wp_step s E e1 σ1 e2 σ2 efs Φ :
==∗ ▷ |==> ◇ (world' E σ2 ∗ WP e2 @ s; E {{ Φ }} ∗ wptp s efs).
Proof.
rewrite {1}wp_unfold /wp_pre. iIntros (?) "[(Hw & HE & Hσ) H]".
- rewrite (val_stuck e1 σ1 e2 σ2 efs) // fupd_eq /fupd_def.
+ rewrite (val_stuck e1 σ1 e2 σ2 efs) // uPred_fupd_eq.
iMod ("H" $! σ1 with "Hσ [Hw HE]") as ">(Hw & HE & _ & H)"; first by iFrame.
- iModIntro; iNext.
- iMod ("H" $! e2 σ2 efs with "[%] [$Hw $HE]") as ">($ & $ & $ & $)"; auto.
+ iMod ("H" $! e2 σ2 efs with "[//] [$Hw $HE]") as ">(Hw & HE & H)".
+ iIntros "!> !>". by iMod ("H" with "[$Hw $HE]") as ">($ & $ & $)".
Qed.
Lemma wptp_step s e1 t1 t2 σ1 σ2 Φ :
@@ -128,7 +128,7 @@ Lemma wptp_result s n e1 t1 v2 t2 σ1 σ2 φ :
Proof.
intros. rewrite wptp_steps // laterN_later. apply: bupd_iter_laterN_mono.
iDestruct 1 as (e2 t2' ?) "((Hw & HE & _) & H & _)"; simplify_eq.
- iDestruct (wp_value_inv' with "H") as "H". rewrite fupd_eq /fupd_def.
+ iDestruct (wp_value_inv' with "H") as "H". rewrite uPred_fupd_eq.
iMod ("H" with "[Hw HE]") as ">(_ & _ & $)"; iFrame; auto.
Qed.
@@ -138,7 +138,7 @@ Proof.
rewrite wp_unfold /wp_pre. iIntros "(Hw&HE&Hσ) H".
destruct (to_val e) as [v|] eqn:?.
{ iIntros "!> !> !%". left. by exists v. }
- rewrite fupd_eq. iMod ("H" with "Hσ [-]") as ">(?&?&%&?)"; first by iFrame.
+ rewrite uPred_fupd_eq. iMod ("H" with "Hσ [-]") as ">(?&?&%&?)"; first by iFrame.
iIntros "!> !> !%". by right.
Qed.
@@ -162,7 +162,7 @@ Proof.
intros ?. rewrite wptp_steps // bupd_iter_frame_l laterN_later.
apply: bupd_iter_laterN_mono.
iIntros "[Hback H]"; iDestruct "H" as (e2' t2' ->) "[(Hw&HE&Hσ) _]".
- rewrite fupd_eq.
+ rewrite uPred_fupd_eq.
iMod ("Hback" with "Hσ [$Hw $HE]") as "> (_ & _ & $)"; auto.
Qed.
End adequacy.
@@ -177,14 +177,14 @@ Proof.
intros Hwp; split.
- intros t2 σ2 v2 [n ?]%rtc_nsteps.
eapply (soundness (M:=iResUR Σ) _ (S (S n))).
- iMod wsat_alloc as (Hinv) "[Hw HE]".
- rewrite fupd_eq in Hwp; iMod (Hwp with "[$Hw $HE]") as ">(Hw & HE & Hwp)".
+ iMod wsat_alloc as (Hinv) "[Hw HE]". specialize (Hwp _).
+ rewrite uPred_fupd_eq in Hwp; iMod (Hwp with "[$Hw $HE]") as ">(Hw & HE & Hwp)".
iDestruct "Hwp" as (Istate) "[HI Hwp]".
iApply (@wptp_result _ _ (IrisG _ _ Hinv Istate)); eauto with iFrame.
- destruct s; last done. intros t2 σ2 e2 _ [n ?]%rtc_nsteps ?.
eapply (soundness (M:=iResUR Σ) _ (S (S n))).
- iMod wsat_alloc as (Hinv) "[Hw HE]".
- rewrite fupd_eq in Hwp; iMod (Hwp with "[$Hw $HE]") as ">(Hw & HE & Hwp)".
+ iMod wsat_alloc as (Hinv) "[Hw HE]". specialize (Hwp _).
+ rewrite uPred_fupd_eq in Hwp; iMod (Hwp with "[$Hw $HE]") as ">(Hw & HE & Hwp)".
iDestruct "Hwp" as (Istate) "[HI Hwp]".
iApply (@wptp_safe _ _ (IrisG _ _ Hinv Istate)); eauto with iFrame.
Qed.
@@ -199,8 +199,25 @@ Theorem wp_invariance Σ Λ `{invPreG Σ} s e σ1 t2 σ2 φ :
Proof.
intros Hwp [n ?]%rtc_nsteps.
eapply (soundness (M:=iResUR Σ) _ (S (S n))).
- iMod wsat_alloc as (Hinv) "[Hw HE]".
- rewrite {1}fupd_eq in Hwp; iMod (Hwp with "[$Hw $HE]") as ">(Hw & HE & Hwp)".
+ iMod wsat_alloc as (Hinv) "[Hw HE]". specialize (Hwp _).
+ rewrite {1}uPred_fupd_eq in Hwp; iMod (Hwp with "[$Hw $HE]") as ">(Hw & HE & Hwp)".
iDestruct "Hwp" as (Istate) "(HIstate & Hwp & Hclose)".
iApply (@wptp_invariance _ _ (IrisG _ _ Hinv Istate)); eauto with iFrame.
Qed.
+
+(* An equivalent version that does not require finding [fupd_intro_mask'], but
+can be confusing to use. *)
+Corollary wp_invariance' Σ Λ `{invPreG Σ} s e σ1 t2 σ2 φ :
+ (∀ `{Hinv : invG Σ},
+ (|={⊤}=> ∃ stateI : state Λ → iProp Σ,
+ let _ : irisG Λ Σ := IrisG _ _ Hinv stateI in
+ stateI σ1 ∗ WP e @ s; ⊤ {{ _, True }} ∗ (stateI σ2 -∗ ∃ E, |={⊤,E}=> ⌜φâŒ))%I) →
+ rtc step ([e], σ1) (t2, σ2) →
+ φ.
+Proof.
+ intros Hwp. eapply wp_invariance; first done.
+ intros Hinv. iMod (Hwp Hinv) as (stateI) "(? & ? & Hφ)".
+ iModIntro. iExists stateI. iFrame. iIntros "Hσ".
+ iDestruct ("Hφ" with "Hσ") as (E) ">Hφ".
+ iMod (fupd_intro_mask') as "_"; last by iModIntro. solve_ndisj.
+Qed.
diff --git a/theories/program_logic/atomic.v b/theories/program_logic/atomic.v
new file mode 100644
index 0000000000000000000000000000000000000000..b8a395fc27f0fec783b494f375b851fae292c7d5
--- /dev/null
+++ b/theories/program_logic/atomic.v
@@ -0,0 +1,16 @@
+From iris.program_logic Require Export weakestpre.
+From iris.proofmode Require Import tactics classes.
+From iris.bi.lib Require Export atomic.
+Set Default Proof Using "Type".
+
+Definition atomic_wp `{irisG Λ Σ} {A B : Type}
+ (e: expr Λ) (* expression *)
+ (Eo Em : coPset) (* outside/module masks *)
+ (α: A → iProp Σ) (* atomic pre-condition *)
+ (β: A → B → iProp Σ) (* atomic post-condition *)
+ (f: A → B → val Λ) (* Turn the return data into the return value *)
+ : iProp Σ :=
+ (∀ Q Φ, Q -∗ atomic_update Eo Em α β (λ x y, Q -∗ Φ (f x y)) -∗
+ WP e {{ Φ }})%I.
+(* Note: To add a private postcondition, use
+ atomic_update α β Eo Em (λ x y, POST x y -∗ Φ (f x y)) *)
diff --git a/theories/program_logic/ectx_lifting.v b/theories/program_logic/ectx_lifting.v
index e0ec8c01d5c1037e3f07498161beb5a7c7f8cb61..419f8365e19ae3b506ec399a8096a4383624d5af 100644
--- a/theories/program_logic/ectx_lifting.v
+++ b/theories/program_logic/ectx_lifting.v
@@ -14,20 +14,32 @@ Hint Resolve head_prim_reducible head_reducible_prim_step.
Hint Resolve (reducible_not_val _ inhabitant).
Hint Resolve head_stuck_stuck.
-Lemma wp_lift_head_step {s E Φ} e1 :
+Lemma wp_lift_head_step_fupd {s E Φ} e1 :
to_val e1 = None →
(∀ σ1, state_interp σ1 ={E,∅}=∗
⌜head_reducible e1 σ1⌠∗
- ▷ ∀ e2 σ2 efs, ⌜head_step e1 σ1 e2 σ2 efs⌠={∅,E}=∗
+ ∀ e2 σ2 efs, ⌜head_step e1 σ1 e2 σ2 efs⌠={∅,∅,E}▷=∗
state_interp σ2 ∗ WP e2 @ s; E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }})
⊢ WP e1 @ s; E {{ Φ }}.
Proof.
- iIntros (?) "H". iApply wp_lift_step=>//. iIntros (σ1) "Hσ".
+ iIntros (?) "H". iApply wp_lift_step_fupd=>//. iIntros (σ1) "Hσ".
iMod ("H" with "Hσ") as "[% H]"; iModIntro.
- iSplit; first by destruct s; eauto. iNext. iIntros (e2 σ2 efs) "%".
+ iSplit; first by destruct s; eauto. iIntros (e2 σ2 efs) "%".
iApply "H"; eauto.
Qed.
+Lemma wp_lift_head_step {s E Φ} e1 :
+ to_val e1 = None →
+ (∀ σ1, state_interp σ1 ={E,∅}=∗
+ ⌜head_reducible e1 σ1⌠∗
+ ▷ ∀ e2 σ2 efs, ⌜head_step e1 σ1 e2 σ2 efs⌠={∅,E}=∗
+ state_interp σ2 ∗ WP e2 @ s; E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }})
+ ⊢ WP e1 @ s; E {{ Φ }}.
+Proof.
+ iIntros (?) "H". iApply wp_lift_head_step_fupd; [done|]. iIntros (?) "?".
+ iMod ("H" with "[$]") as "[$ H]". iIntros "!>" (e2 σ2 efs ?) "!> !>". by iApply "H".
+Qed.
+
Lemma wp_lift_head_stuck E Φ e :
to_val e = None →
sub_redexes_are_values e →
@@ -45,7 +57,7 @@ Lemma wp_lift_pure_head_step {s E E' Φ} e1 :
WP e2 @ s; E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }})
⊢ WP e1 @ s; E {{ Φ }}.
Proof using Hinh.
- iIntros (??) "H". iApply wp_lift_pure_step; eauto.
+ iIntros (??) "H". iApply wp_lift_pure_step; [|by eauto|].
{ by destruct s; auto. }
iApply (step_fupd_wand with "H"); iIntros "H".
iIntros (????). iApply "H"; eauto.
@@ -62,6 +74,21 @@ Proof using Hinh.
by auto.
Qed.
+Lemma wp_lift_atomic_head_step_fupd {s E1 E2 Φ} e1 :
+ to_val e1 = None →
+ (∀ σ1, state_interp σ1 ={E1}=∗
+ ⌜head_reducible e1 σ1⌠∗
+ ∀ e2 σ2 efs, ⌜head_step e1 σ1 e2 σ2 efs⌠={E1,E2}▷=∗
+ state_interp σ2 ∗
+ from_option Φ False (to_val e2) ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }})
+ ⊢ WP e1 @ s; E1 {{ Φ }}.
+Proof.
+ iIntros (?) "H". iApply wp_lift_atomic_step_fupd; [done|].
+ iIntros (σ1) "Hσ1". iMod ("H" with "Hσ1") as "[% H]"; iModIntro.
+ iSplit; first by destruct s; auto. iIntros (e2 σ2 efs) "%".
+ iApply "H"; auto.
+Qed.
+
Lemma wp_lift_atomic_head_step {s E Φ} e1 :
to_val e1 = None →
(∀ σ1, state_interp σ1 ={E}=∗
@@ -77,6 +104,20 @@ Proof.
iApply "H"; auto.
Qed.
+Lemma wp_lift_atomic_head_step_no_fork_fupd {s E1 E2 Φ} e1 :
+ to_val e1 = None →
+ (∀ σ1, state_interp σ1 ={E1}=∗
+ ⌜head_reducible e1 σ1⌠∗
+ ∀ e2 σ2 efs, ⌜head_step e1 σ1 e2 σ2 efs⌠={E1,E2}▷=∗
+ ⌜efs = []⌠∗ state_interp σ2 ∗ from_option Φ False (to_val e2))
+ ⊢ WP e1 @ s; E1 {{ Φ }}.
+Proof.
+ iIntros (?) "H". iApply wp_lift_atomic_head_step_fupd; [done|].
+ iIntros (σ1) "Hσ1". iMod ("H" $! σ1 with "Hσ1") as "[$ H]"; iModIntro.
+ iIntros (v2 σ2 efs) "%". iMod ("H" $! v2 σ2 efs with "[# //]") as "H".
+ iIntros "!> !>". iMod "H" as "(% & $ & $)"; subst; auto.
+Qed.
+
Lemma wp_lift_atomic_head_step_no_fork {s E Φ} e1 :
to_val e1 = None →
(∀ σ1, state_interp σ1 ={E}=∗
diff --git a/theories/program_logic/hoare.v b/theories/program_logic/hoare.v
index 23857734d46f7caf190cbed7db95704390d4ad7e..f75756fa6f60781987fe52f4739eb84d839c7125 100644
--- a/theories/program_logic/hoare.v
+++ b/theories/program_logic/hoare.v
@@ -56,10 +56,10 @@ Global Instance ht_proper s E :
Proof. solve_proper. Qed.
Lemma ht_mono s E P P' Φ Φ' e :
(P ⊢ P') → (∀ v, Φ' v ⊢ Φ v) → {{ P' }} e @ s; E {{ Φ' }} ⊢ {{ P }} e @ s; E {{ Φ }}.
-Proof. by intros; apply persistently_mono, wand_mono, wp_mono. Qed.
+Proof. by intros; apply affinely_mono, persistently_mono, wand_mono, wp_mono. Qed.
Lemma ht_stuck_mono s1 s2 E P Φ e :
s1 ⊑ s2 → {{ P }} e @ s1; E {{ Φ }} ⊢ {{ P }} e @ s2; E {{ Φ }}.
-Proof. by intros; apply persistently_mono, wand_mono, wp_stuck_mono. Qed.
+Proof. by intros; apply affinely_mono, persistently_mono, wand_mono, wp_stuck_mono. Qed.
Global Instance ht_mono' s E :
Proper (flip (⊢) ==> eq ==> pointwise_relation _ (⊢) ==> (⊢)) (ht s E).
Proof. solve_proper. Qed.
diff --git a/theories/program_logic/language.v b/theories/program_logic/language.v
index 707f9c671861cf99218208bf490f352c8637849f..b067bb1eb86be223aee337d5bc1ae3a7f5d9e835 100644
--- a/theories/program_logic/language.v
+++ b/theories/program_logic/language.v
@@ -160,14 +160,17 @@ Section language.
(* This is a family of frequent assumptions for PureExec *)
Class IntoVal (e : expr Λ) (v : val Λ) :=
- into_val : to_val e = Some v.
+ into_val : of_val v = e.
- Class AsVal (e : expr Λ) := as_val : is_Some (to_val e).
+ Class AsVal (e : expr Λ) := as_val : ∃ v, of_val v = e.
(* There is no instance [IntoVal → AsVal] as often one can solve [AsVal] more
efficiently since no witness has to be computed. *)
Global Instance as_vals_of_val vs : TCForall AsVal (of_val <$> vs).
Proof.
apply TCForall_Forall, Forall_fmap, Forall_true=> v.
- rewrite /AsVal /= to_of_val; eauto.
+ rewrite /AsVal /=; eauto.
Qed.
+ Lemma as_val_is_Some e :
+ (∃ v, of_val v = e) → is_Some (to_val e).
+ Proof. intros [v <-]. rewrite to_of_val. eauto. Qed.
End language.
diff --git a/theories/program_logic/lifting.v b/theories/program_logic/lifting.v
index 38f6e3a803cdef266ff9cb8d6f849ca2b1b546ab..8cc97b7e2d283d145ee44a2ec3551bcadc3f03c0 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".
@@ -12,16 +11,16 @@ Implicit Types σ : state Λ.
Implicit Types P Q : iProp Σ.
Implicit Types Φ : val Λ → iProp Σ.
-Lemma wp_lift_step s E Φ e1 :
+Lemma wp_lift_step_fupd s E Φ e1 :
to_val e1 = None →
(∀ σ1, state_interp σ1 ={E,∅}=∗
⌜if s is NotStuck then reducible e1 σ1 else True⌠∗
- ▷ ∀ e2 σ2 efs, ⌜prim_step e1 σ1 e2 σ2 efs⌠={∅,E}=∗
+ ∀ e2 σ2 efs, ⌜prim_step e1 σ1 e2 σ2 efs⌠={∅,∅,E}▷=∗
state_interp σ2 ∗ WP e2 @ s; E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }})
⊢ WP e1 @ s; E {{ Φ }}.
Proof.
rewrite wp_unfold /wp_pre=>->. iIntros "H" (σ1) "Hσ".
- iMod ("H" with "Hσ") as "(%&?)". iModIntro. iSplit. by destruct s. done.
+ iMod ("H" with "Hσ") as "(%&H)". iModIntro. iSplit. by destruct s. done.
Qed.
Lemma wp_lift_stuck E Φ e :
@@ -31,10 +30,22 @@ Lemma wp_lift_stuck E Φ e :
Proof.
rewrite wp_unfold /wp_pre=>->. iIntros "H" (σ1) "Hσ".
iMod ("H" with "Hσ") as %[? Hirr]. iModIntro. iSplit; first done.
- iIntros "!>" (e2 σ2 efs) "%". by case: (Hirr e2 σ2 efs).
+ iIntros (e2 σ2 efs) "% !> !>". by case: (Hirr e2 σ2 efs).
Qed.
(** Derived lifting lemmas. *)
+Lemma wp_lift_step s E Φ e1 :
+ to_val e1 = None →
+ (∀ σ1, state_interp σ1 ={E,∅}=∗
+ ⌜if s is NotStuck then reducible e1 σ1 else True⌠∗
+ ▷ ∀ e2 σ2 efs, ⌜prim_step e1 σ1 e2 σ2 efs⌠={∅,E}=∗
+ state_interp σ2 ∗ WP e2 @ s; E {{ Φ }} ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }})
+ ⊢ WP e1 @ s; E {{ Φ }}.
+Proof.
+ iIntros (?) "H". iApply wp_lift_step_fupd; [done|]. iIntros (?) "Hσ".
+ iMod ("H" with "Hσ") as "[$ H]". iIntros "!> * % !>". by iApply "H".
+Qed.
+
Lemma wp_lift_pure_step `{Inhabited (state Λ)} s E E' Φ e1 :
(∀ σ1, if s is NotStuck then reducible e1 σ1 else to_val e1 = None) →
(∀ σ1 e2 σ2 efs, prim_step e1 σ1 e2 σ2 efs → σ1 = σ2) →
@@ -66,6 +77,26 @@ Qed.
(* Atomic steps don't need any mask-changing business here, one can
use the generic lemmas here. *)
+Lemma wp_lift_atomic_step_fupd {s E1 E2 Φ} e1 :
+ to_val e1 = None →
+ (∀ σ1, state_interp σ1 ={E1}=∗
+ ⌜if s is NotStuck then reducible e1 σ1 else True⌠∗
+ ∀ e2 σ2 efs, ⌜prim_step e1 σ1 e2 σ2 efs⌠={E1,E2}▷=∗
+ state_interp σ2 ∗
+ from_option Φ False (to_val e2) ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }})
+ ⊢ WP e1 @ s; E1 {{ Φ }}.
+Proof.
+ iIntros (?) "H". iApply (wp_lift_step_fupd s E1 _ e1)=>//; iIntros (σ1) "Hσ1".
+ iMod ("H" $! σ1 with "Hσ1") as "[$ H]".
+ iMod (fupd_intro_mask' E1 ∅) as "Hclose"; first set_solver.
+ iIntros "!>" (e2 σ2 efs ?). iMod "Hclose" as "_".
+ iMod ("H" $! e2 σ2 efs with "[#]") as "H"; [done|].
+ iMod (fupd_intro_mask' E2 ∅) as "Hclose"; [set_solver|]. iIntros "!> !>".
+ iMod "Hclose" as "_". iMod "H" as "($ & HΦ & $)".
+ destruct (to_val e2) eqn:?; last by iExFalso.
+ iApply wp_value; last done. by apply of_to_val.
+Qed.
+
Lemma wp_lift_atomic_step {s E Φ} e1 :
to_val e1 = None →
(∀ σ1, state_interp σ1 ={E}=∗
@@ -75,13 +106,9 @@ Lemma wp_lift_atomic_step {s E Φ} e1 :
from_option Φ False (to_val e2) ∗ [∗ list] ef ∈ efs, WP ef @ s; ⊤ {{ _, True }})
⊢ WP e1 @ s; E {{ Φ }}.
Proof.
- iIntros (?) "H". iApply (wp_lift_step s E _ e1)=>//; iIntros (σ1) "Hσ1".
- iMod ("H" $! σ1 with "Hσ1") as "[$ H]".
- iMod (fupd_intro_mask' E ∅) as "Hclose"; first set_solver.
- iModIntro; iNext; iIntros (e2 σ2 efs) "%". iMod "Hclose" as "_".
- iMod ("H" $! e2 σ2 efs with "[#]") as "($ & HΦ & $)"; first by eauto.
- destruct (to_val e2) eqn:?; last by iExFalso.
- by iApply wp_value.
+ iIntros (?) "H". iApply wp_lift_atomic_step_fupd; [done|].
+ iIntros (?) "?". iMod ("H" with "[$]") as "[$ H]". iIntros "!> * % !> !>".
+ by iApply "H".
Qed.
Lemma wp_lift_pure_det_step `{Inhabited (state Λ)} {s E E' Φ} e1 e2 efs :
diff --git a/theories/program_logic/ownp.v b/theories/program_logic/ownp.v
index 3927d60e4cfb8ece04289ecad857fd1c1594d369..7fa9d42b1570e04e98e009009ea3c1e478a9e0f8 100644
--- a/theories/program_logic/ownp.v
+++ b/theories/program_logic/ownp.v
@@ -44,7 +44,7 @@ Theorem ownP_adequacy Σ `{ownPPreG Λ Σ} s e σ φ :
adequate s 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 Λ Σ} s e σ1 t2 σ2 φ :
φ σ2.
Proof.
intros Hwp Hsteps. eapply (wp_invariance Σ Λ s 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.
@@ -147,7 +147,7 @@ Section lifting.
iNext; iIntros (e2 σ2 efs) "% Hσ".
iDestruct ("H" $! e2 σ2 efs with "[] [Hσ]") as "[HΦ $]"; [by eauto..|].
destruct (to_val e2) eqn:?; last by iExFalso.
- by iMod "Hclose"; iApply wp_value; auto using to_of_val.
+ iMod "Hclose"; iApply wp_value; last done. by apply of_to_val.
Qed.
Lemma ownP_lift_atomic_det_step {s E Φ e1} σ1 v2 σ2 efs :
@@ -170,7 +170,7 @@ Section lifting.
{{{ ▷ ownP σ1 }}} e1 @ s; E {{{ RET v2; ownP σ2 }}}.
Proof.
intros. rewrite -(ownP_lift_atomic_det_step σ1 v2 σ2 []); [|done..].
- rewrite big_sepL_nil right_id. by apply uPred.wand_intro_r.
+ rewrite big_sepL_nil right_id. by apply bi.wand_intro_r.
Qed.
Lemma ownP_lift_pure_det_step `{Inhabited (state Λ)} {s E Φ} e1 e2 efs :
diff --git a/theories/program_logic/total_adequacy.v b/theories/program_logic/total_adequacy.v
index 648d934571fd8d628932554a45737a2c2c2040ec..ebb8c9b0c663541bd460479580ebf7258ea00eb6 100644
--- a/theories/program_logic/total_adequacy.v
+++ b/theories/program_logic/total_adequacy.v
@@ -1,6 +1,6 @@
From iris.program_logic Require Export total_weakestpre adequacy.
-From iris.algebra Require Import gmap auth agree gset coPset.
-From iris.base_logic Require Import big_op soundness fixpoint.
+From iris.algebra Require Import gmap auth agree gset coPset list.
+From iris.bi Require Import big_op fixpoint.
From iris.base_logic.lib Require Import wsat.
From iris.proofmode Require Import tactics.
Set Default Proof Using "Type".
@@ -16,7 +16,7 @@ Definition twptp_pre (twptp : list (expr Λ) → iProp Σ)
state_interp σ1 ={⊤}=∗ state_interp σ2 ∗ twptp t2)%I.
Lemma twptp_pre_mono (twptp1 twptp2 : list (expr Λ) → iProp Σ) :
- ((□ ∀ t, twptp1 t -∗ twptp2 t) →
+ (<pers> (∀ t, twptp1 t -∗ twptp2 t) →
∀ t, twptp_pre twptp1 t -∗ twptp_pre twptp2 t)%I.
Proof.
iIntros "#H"; iIntros (t) "Hwp". rewrite /twptp_pre.
@@ -24,14 +24,14 @@ Proof.
by iApply "H".
Qed.
-Local Instance twptp_pre_mono' : BIMonoPred twptp_pre.
+Local Instance twptp_pre_mono' : BiMonoPred twptp_pre.
Proof.
constructor; first apply twptp_pre_mono.
intros wp Hwp n t1 t2 ?%(discrete_iff _ _)%leibniz_equiv; solve_proper.
Qed.
Definition twptp (t : list (expr Λ)) : iProp Σ :=
- uPred_least_fixpoint twptp_pre t.
+ bi_least_fixpoint twptp_pre t.
Lemma twptp_unfold t : twptp t ⊣⊢ twptp_pre twptp t.
Proof. by rewrite /twptp least_fixpoint_unfold. Qed.
@@ -106,7 +106,7 @@ Proof.
iIntros "Hw Ht". iRevert (σ) "Hw". iRevert (t) "Ht".
iApply twptp_ind; iIntros "!#" (t) "IH"; iIntros (σ) "(Hw&HE&Hσ)".
iApply (pure_mono _ _ (Acc_intro _)). iIntros ([t' σ'] Hstep).
- rewrite /twptp_pre fupd_eq /fupd_def.
+ rewrite /twptp_pre uPred_fupd_eq /uPred_fupd_def.
iMod ("IH" with "[% //] Hσ [$Hw $HE]") as ">(Hw & HE & Hσ & [IH _])".
iApply "IH". by iFrame.
Qed.
@@ -121,8 +121,8 @@ Theorem twp_total Σ Λ `{invPreG Σ} s e σ Φ :
Proof.
intros Hwp.
eapply (soundness (M:=iResUR Σ) _ 1); iIntros "/=".
- iMod wsat_alloc as (Hinv) "[Hw HE]".
- rewrite fupd_eq in Hwp; iMod (Hwp with "[$Hw $HE]") as ">(Hw & HE & Hwp)".
+ iMod wsat_alloc as (Hinv) "[Hw HE]". specialize (Hwp Hinv).
+ rewrite uPred_fupd_eq in Hwp; iMod (Hwp with "[$Hw $HE]") as ">(Hw & HE & Hwp)".
iDestruct "Hwp" as (Istate) "[HI Hwp]".
iApply (@twptp_total _ _ (IrisG _ _ Hinv Istate) with "[$Hw $HE $HI]").
by iApply (@twp_twptp _ _ (IrisG _ _ Hinv Istate)).
diff --git a/theories/program_logic/total_lifting.v b/theories/program_logic/total_lifting.v
index 0c64555d0e5ed6b6dbcc8c5ad2612bfc3de3994d..57117988947aae18b0a58e5f8c8aebf0ff1e033f 100644
--- a/theories/program_logic/total_lifting.v
+++ b/theories/program_logic/total_lifting.v
@@ -1,5 +1,5 @@
From iris.program_logic Require Export total_weakestpre.
-From iris.base_logic Require Export big_op.
+From iris.bi Require Export big_op.
From iris.proofmode Require Import tactics.
Set Default Proof Using "Type".
@@ -54,7 +54,7 @@ Proof.
iIntros "!>" (e2 σ2 efs) "%". iMod "Hclose" as "_".
iMod ("H" $! e2 σ2 efs with "[#]") as "($ & HΦ & $)"; first by eauto.
destruct (to_val e2) eqn:?; last by iExFalso.
- by iApply twp_value.
+ iApply twp_value; last done. by apply of_to_val.
Qed.
Lemma twp_lift_pure_det_step `{Inhabited (state Λ)} {s E Φ} e1 e2 efs :
diff --git a/theories/program_logic/total_weakestpre.v b/theories/program_logic/total_weakestpre.v
index 1218551ca96dff2d810910af5ec0964dc9ba8e15..9e8cf93ef64db490eef628c30a2c05887a4ef101 100644
--- a/theories/program_logic/total_weakestpre.v
+++ b/theories/program_logic/total_weakestpre.v
@@ -1,6 +1,6 @@
From iris.program_logic Require Export weakestpre.
From iris.proofmode Require Import tactics.
-From iris.base_logic Require Import fixpoint big_op.
+From iris.bi Require Import fixpoint big_op.
Set Default Proof Using "Type".
Import uPred.
@@ -37,7 +37,7 @@ Definition twp_pre' `{irisG Λ Σ} (s : stuckness) :
prodC (prodC (leibnizC coPset) (exprC Λ)) (val Λ -c> iProp Σ) → iProp Σ :=
curry3 ∘ twp_pre s ∘ uncurry3.
-Local Instance twp_pre_mono' `{irisG Λ Σ} s : BIMonoPred (twp_pre' s).
+Local Instance twp_pre_mono' `{irisG Λ Σ} s : BiMonoPred (twp_pre' s).
Proof.
constructor.
- iIntros (wp1 wp2) "#H"; iIntros ([[E e1] Φ]); iRevert (E e1 Φ).
@@ -49,143 +49,14 @@ Qed.
Definition twp_def `{irisG Λ Σ} (s : stuckness) (E : coPset)
(e : expr Λ) (Φ : val Λ → iProp Σ) :
- iProp Σ := uPred_least_fixpoint (twp_pre' s) (E,e,Φ).
-Definition twp_aux : seal (@twp_def). by eexists. Qed.
-Definition twp := unseal twp_aux.
-Definition twp_eq : @twp = @twp_def := seal_eq twp_aux.
-
-Arguments twp {_ _ _} _ _ _%E _.
-Instance: Params (@twp) 6.
-
-(* Note that using '[[' instead of '[{' results in conflicts with the list
-notations. *)
-Notation "'WP' e @ s ; E [{ Φ } ]" := (twp s E e%E Φ)
- (at level 20, e, Φ at level 200,
- format "'[' 'WP' e '/' @ s ; E [{ Φ } ] ']'") : uPred_scope.
-Notation "'WP' e @ E [{ Φ } ]" := (twp NotStuck E e%E Φ)
- (at level 20, e, Φ at level 200,
- format "'[' 'WP' e '/' @ E [{ Φ } ] ']'") : uPred_scope.
-Notation "'WP' e @ E ? [{ Φ } ]" := (twp MaybeStuck E e%E Φ)
- (at level 20, e, Φ at level 200,
- format "'[' 'WP' e '/' @ E ? [{ Φ } ] ']'") : uPred_scope.
-Notation "'WP' e [{ Φ } ]" := (twp NotStuck ⊤ e%E Φ)
- (at level 20, e, Φ at level 200,
- format "'[' 'WP' e '/' [{ Φ } ] ']'") : uPred_scope.
-Notation "'WP' e ? [{ Φ } ]" := (twp MaybeStuck ⊤ e%E Φ)
- (at level 20, e, Φ at level 200,
- format "'[' 'WP' e '/' ? [{ Φ } ] ']'") : uPred_scope.
-
-Notation "'WP' e @ s ; E [{ v , Q } ]" := (twp s E e%E (λ v, Q))
- (at level 20, e, Q at level 200,
- format "'[' 'WP' e '/' @ s ; E [{ v , Q } ] ']'") : uPred_scope.
-Notation "'WP' e @ E [{ v , Q } ]" := (twp NotStuck E e%E (λ v, Q))
- (at level 20, e, Q at level 200,
- format "'[' 'WP' e '/' @ E [{ v , Q } ] ']'") : uPred_scope.
-Notation "'WP' e @ E ? [{ v , Q } ]" := (twp MaybeStuck E e%E (λ v, Q))
- (at level 20, e, Q at level 200,
- format "'[' 'WP' e '/' @ E ? [{ v , Q } ] ']'") : uPred_scope.
-Notation "'WP' e [{ v , Q } ]" := (twp NotStuck ⊤ e%E (λ v, Q))
- (at level 20, e, Q at level 200,
- format "'[' 'WP' e '/' [{ v , Q } ] ']'") : uPred_scope.
-Notation "'WP' e ? [{ v , Q } ]" := (twp MaybeStuck ⊤ e%E (λ v, Q))
- (at level 20, e, Q at level 200,
- format "'[' 'WP' e '/' ? [{ v , Q } ] ']'") : uPred_scope.
-
-(* Texan triples *)
-Notation "'[[{' P } ] ] e @ s ; E [[{ x .. y , 'RET' pat ; Q } ] ]" :=
- (□ ∀ Φ,
- P -∗ (∀ x, .. (∀ y, Q -∗ Φ pat%V) .. ) -∗ WP e @ s; E [{ Φ }])%I
- (at level 20, x closed binder, y closed binder,
- format "[[{ P } ] ] e @ s ; E [[{ x .. y , RET pat ; Q } ] ]") : uPred_scope.
-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.
-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.
-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.
-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.
-Notation "'[[{' P } ] ] e @ s ; E [[{ 'RET' pat ; Q } ] ]" :=
- (□ ∀ Φ, P -∗ (Q -∗ Φ pat%V) -∗ WP e @ s; E [{ Φ }])%I
- (at level 20,
- format "[[{ P } ] ] e @ s ; E [[{ RET pat ; Q } ] ]") : uPred_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.
-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.
-Notation "'[[{' P } ] ] e [[{ 'RET' pat ; Q } ] ]" :=
- (□ ∀ Φ, P -∗ (Q -∗ Φ pat%V) -∗ WP e [{ Φ }])%I
- (at level 20,
- format "[[{ P } ] ] e [[{ RET pat ; Q } ] ]") : uPred_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.
-
-Notation "'[[{' P } ] ] e @ s ; E [[{ x .. y , 'RET' pat ; Q } ] ]" :=
- (∀ Φ : _ → uPred _,
- P -∗ (∀ x, .. (∀ y, Q -∗ Φ pat%V) .. ) -∗ WP e @ s; E [{ Φ }])
- (at level 20, x closed binder, y closed binder,
- format "[[{ P } ] ] e @ s ; E [[{ x .. y , RET pat ; Q } ] ]") : stdpp_scope.
-Notation "'[[{' P } ] ] e @ E [[{ x .. y , 'RET' pat ; Q } ] ]" :=
- (∀ Φ : _ → uPred _,
- P -∗ (∀ x, .. (∀ y, Q -∗ Φ pat%V) .. ) -∗ WP e @ E [{ Φ }])
- (at level 20, x closed binder, y closed binder,
- format "[[{ P } ] ] e @ E [[{ x .. y , RET pat ; Q } ] ]") : stdpp_scope.
-Notation "'[[{' P } ] ] e @ E ? [[{ x .. y , 'RET' pat ; Q } ] ]" :=
- (∀ Φ : _ → uPred _,
- P -∗ (∀ x, .. (∀ y, Q -∗ Φ pat%V) .. ) -∗ WP e @ E ?[{ Φ }])
- (at level 20, x closed binder, y closed binder,
- format "[[{ P } ] ] e @ E ? [[{ x .. y , RET pat ; Q } ] ]") : stdpp_scope.
-Notation "'[[{' P } ] ] e [[{ x .. y , 'RET' pat ; Q } ] ]" :=
- (∀ Φ : _ → uPred _,
- P -∗ (∀ x, .. (∀ y, Q -∗ Φ pat%V) .. ) -∗ WP e [{ Φ }])
- (at level 20, x closed binder, y closed binder,
- format "[[{ P } ] ] e [[{ x .. y , RET pat ; Q } ] ]") : stdpp_scope.
-Notation "'[[{' P } ] ] e ? [[{ x .. y , 'RET' pat ; Q } ] ]" :=
- (∀ Φ : _ → uPred _,
- P -∗ (∀ x, .. (∀ y, Q -∗ Φ pat%V) .. ) -∗ WP e ?[{ Φ }])
- (at level 20, x closed binder, y closed binder,
- format "[[{ P } ] ] e ? [[{ x .. y , RET pat ; Q } ] ]") : stdpp_scope.
-Notation "'[[{' P } ] ] e @ s ; E [[{ 'RET' pat ; Q } ] ]" :=
- (∀ Φ : _ → uPred _, P -∗ (Q -∗ Φ pat%V) -∗ WP e @ s; E [{ Φ }])
- (at level 20,
- format "[[{ P } ] ] e @ s ; E [[{ RET pat ; Q } ] ]") : stdpp_scope.
-Notation "'[[{' P } ] ] e @ E [[{ 'RET' pat ; Q } ] ]" :=
- (∀ Φ : _ → uPred _, P -∗ (Q -∗ Φ pat%V) -∗ WP e @ E [{ Φ }])
- (at level 20,
- format "[[{ P } ] ] e @ E [[{ RET pat ; Q } ] ]") : stdpp_scope.
-Notation "'[[{' P } ] ] e @ E ? [[{ 'RET' pat ; Q } ] ]" :=
- (∀ Φ : _ → uPred _, P -∗ (Q -∗ Φ pat%V) -∗ WP e @ E ?[{ Φ }])
- (at level 20,
- format "[[{ P } ] ] e @ E ? [[{ RET pat ; Q } ] ]") : stdpp_scope.
-Notation "'[[{' P } ] ] e [[{ 'RET' pat ; Q } ] ]" :=
- (∀ Φ : _ → uPred _, P -∗ (Q -∗ Φ pat%V) -∗ WP e [{ Φ }])
- (at level 20,
- format "[[{ P } ] ] e [[{ RET pat ; Q } ] ]") : stdpp_scope.
-Notation "'[[{' P } ] ] e ? [[{ 'RET' pat ; Q } ] ]" :=
- (∀ Φ : _ → uPred _, P -∗ (Q -∗ Φ pat%V) -∗ WP e ?[{ Φ }])
- (at level 20,
- format "[[{ P } ] ] e ? [[{ RET pat ; Q } ] ]") : stdpp_scope.
+ iProp Σ := bi_least_fixpoint (twp_pre' s) (E,e,Φ).
+Definition twp_aux `{irisG Λ Σ} : seal (@twp_def Λ Σ _). by eexists. Qed.
+Instance twp' `{irisG Λ Σ} : Twp Λ (iProp Σ) stuckness := twp_aux.(unseal).
+Definition twp_eq `{irisG Λ Σ} : twp = @twp_def Λ Σ _ := twp_aux.(seal_eq).
Section twp.
Context `{irisG Λ Σ}.
+Implicit Types s : stuckness.
Implicit Types P : iProp Σ.
Implicit Types Φ : val Λ → iProp Σ.
Implicit Types v : val Λ.
@@ -210,12 +81,12 @@ Proof.
Qed.
Global Instance twp_ne s E e n :
- Proper (pointwise_relation _ (dist n) ==> dist n) (@twp Λ Σ _ s E e).
+ Proper (pointwise_relation _ (dist n) ==> dist n) (twp (PROP:=iProp Σ) s E e).
Proof.
intros Φ1 Φ2 HΦ. rewrite !twp_eq. by apply (least_fixpoint_ne _), pair_ne, HΦ.
Qed.
Global Instance twp_proper s E e :
- Proper (pointwise_relation _ (≡) ==> (≡)) (@twp Λ Σ _ s E e).
+ Proper (pointwise_relation _ (≡) ==> (≡)) (twp (PROP:=iProp Σ) s E e).
Proof.
by intros Φ Φ' ?; apply equiv_dist=>n; apply twp_ne=>v; apply equiv_dist.
Qed.
@@ -315,9 +186,9 @@ Lemma twp_wp s E e Φ : WP e @ s; E [{ Φ }] -∗ WP e @ s; E {{ Φ }}.
Proof.
iIntros "H". iLöb as "IH" forall (E e Φ).
rewrite wp_unfold twp_unfold /wp_pre /twp_pre. destruct (to_val e) as [v|]=>//.
- iIntros (σ1) "Hσ". iMod ("H" with "Hσ") as "[$ H]". iModIntro; iNext.
- iIntros (e2 σ2 efs) "Hstep".
- iMod ("H" with "Hstep") as "($ & H & Hfork)"; iModIntro.
+ iIntros (σ1) "Hσ". iMod ("H" with "Hσ") as "[$ H]". iIntros "!>".
+ iIntros (e2 σ2 efs) "Hstep". iMod ("H" with "Hstep") as "($ & H & Hfork)".
+ iApply step_fupd_intro; [set_solver+|]. iNext.
iSplitL "H". by iApply "IH". iApply (@big_sepL_impl with "[$Hfork]").
iIntros "!#" (k e' _) "H". by iApply "IH".
Qed.
@@ -339,17 +210,17 @@ Lemma twp_mask_mono s E1 E2 e Φ :
E1 ⊆ E2 → WP e @ s; E1 [{ Φ }] -∗ WP e @ s; E2 [{ Φ }].
Proof. iIntros (?) "H"; iApply (twp_strong_mono with "H"); auto. Qed.
Global Instance twp_mono' s E e :
- Proper (pointwise_relation _ (⊢) ==> (⊢)) (@twp Λ Σ _ s E e).
+ Proper (pointwise_relation _ (⊢) ==> (⊢)) (twp (PROP:=iProp Σ) s E e).
Proof. by intros Φ Φ' ?; apply twp_mono. Qed.
-Lemma twp_value s E Φ e v `{!IntoVal e v} : Φ v -∗ WP e @ s; E [{ Φ }].
-Proof. intros; rewrite -(of_to_val e v) //; by apply twp_value'. Qed.
+Lemma twp_value s E Φ e v : IntoVal e v → Φ v -∗ WP e @ s; E [{ Φ }].
+Proof. intros <-. by apply twp_value'. Qed.
Lemma twp_value_fupd' s E Φ v : (|={E}=> Φ v) -∗ WP of_val v @ s; E [{ Φ }].
Proof. intros. by rewrite -twp_fupd -twp_value'. Qed.
-Lemma twp_value_fupd s E Φ e v `{!IntoVal e v} : (|={E}=> Φ v) -∗ WP e @ s; E [{ Φ }].
-Proof. intros. rewrite -twp_fupd -twp_value //. Qed.
-Lemma twp_value_inv s E Φ e v `{!IntoVal e v} : WP e @ s; E [{ Φ }] ={E}=∗ Φ v.
-Proof. intros; rewrite -(of_to_val e v) //; by apply twp_value_inv'. Qed.
+Lemma twp_value_fupd s E Φ e v : IntoVal e v → (|={E}=> Φ v) -∗ WP e @ s; E [{ Φ }].
+Proof. intros ?. rewrite -twp_fupd -twp_value //. Qed.
+Lemma twp_value_inv s E Φ e v : IntoVal e v → WP e @ s; E [{ Φ }] ={E}=∗ Φ v.
+Proof. intros <-. by apply twp_value_inv'. Qed.
Lemma twp_frame_l s E e Φ R : R ∗ WP e @ s; E [{ Φ }] -∗ WP e @ s; E [{ v, R ∗ Φ v }].
Proof. iIntros "[? H]". iApply (twp_strong_mono with "H"); auto with iFrame. Qed.
@@ -377,25 +248,35 @@ Section proofmode_classes.
Implicit Types Φ : val Λ → iProp Σ.
Global Instance frame_twp p s E e R Φ Ψ :
- (∀ v, Frame p R (Φ v) (Ψ v)) → Frame p R (WP e @ s; E [{ Φ }]) (WP e @ s; E [{ Ψ }]).
+ (∀ v, Frame p R (Φ v) (Ψ v)) →
+ Frame p R (WP e @ s; E [{ Φ }]) (WP e @ s; E [{ Ψ }]).
Proof. rewrite /Frame=> HR. rewrite twp_frame_l. apply twp_mono, HR. Qed.
Global Instance is_except_0_wp s E e Φ : IsExcept0 (WP e @ s; E [{ Φ }]).
Proof. by rewrite /IsExcept0 -{2}fupd_twp -except_0_fupd -fupd_intro. Qed.
- Global Instance elim_modal_bupd_twp s E e P Φ :
- ElimModal (|==> P) P (WP e @ s; E [{ Φ }]) (WP e @ s; E [{ Φ }]).
- Proof. by rewrite /ElimModal (bupd_fupd E) fupd_frame_r wand_elim_r fupd_twp. Qed.
+ Global Instance elim_modal_bupd_twp p s E e P Φ :
+ ElimModal True p false (|==> P) P (WP e @ s; E [{ Φ }]) (WP e @ s; E [{ Φ }]).
+ Proof.
+ by rewrite /ElimModal intuitionistically_if_elim
+ (bupd_fupd E) fupd_frame_r wand_elim_r fupd_twp.
+ Qed.
- Global Instance elim_modal_fupd_twp s E e P Φ :
- ElimModal (|={E}=> P) P (WP e @ s; E [{ Φ }]) (WP e @ s; E [{ Φ }]).
- Proof. by rewrite /ElimModal fupd_frame_r wand_elim_r fupd_twp. Qed.
+ Global Instance elim_modal_fupd_twp p s E e P Φ :
+ ElimModal True p false (|={E}=> P) P (WP e @ s; E [{ Φ }]) (WP e @ s; E [{ Φ }]).
+ Proof.
+ by rewrite /ElimModal intuitionistically_if_elim
+ fupd_frame_r wand_elim_r fupd_twp.
+ Qed.
- Global Instance elim_modal_fupd_twp_atomic s E1 E2 e P Φ :
+ Global Instance elim_modal_fupd_twp_atomic p s E1 E2 e P Φ :
Atomic (stuckness_to_atomicity s) e →
- ElimModal (|={E1,E2}=> P) P
+ ElimModal True p false (|={E1,E2}=> P) P
(WP e @ s; E1 [{ Φ }]) (WP e @ s; E2 [{ v, |={E2,E1}=> Φ v }])%I.
- Proof. intros. by rewrite /ElimModal fupd_frame_r wand_elim_r twp_atomic. Qed.
+ Proof.
+ intros. by rewrite /ElimModal intuitionistically_if_elim
+ fupd_frame_r wand_elim_r twp_atomic.
+ Qed.
Global Instance add_modal_fupd_twp s E e P Φ :
AddModal (|={E}=> P) P (WP e @ s; E [{ Φ }]).
diff --git a/theories/program_logic/weakestpre.v b/theories/program_logic/weakestpre.v
index a48f9807026d054958cda375cac8a98fa1fe4109..023966eb01f2494650a7a9d950d22c994434681b 100644
--- a/theories/program_logic/weakestpre.v
+++ b/theories/program_logic/weakestpre.v
@@ -1,7 +1,7 @@
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.
+From iris.bi Require Export weakestpre.
+From iris.proofmode Require Import base tactics classes.
Set Default Proof Using "Type".
Import uPred.
@@ -10,20 +10,7 @@ Class irisG' (Λstate : Type) (Σ : gFunctors) := IrisG {
state_interp : Λstate → iProp Σ;
}.
Notation irisG Λ Σ := (irisG' (state Λ) Σ).
-
-Inductive stuckness := NotStuck | MaybeStuck.
-
-Definition stuckness_leb (s1 s2 : stuckness) : bool :=
- match s1, s2 with
- | MaybeStuck, NotStuck => false
- | _, _ => true
- end.
-Instance stuckness_le : SqSubsetEq stuckness := stuckness_leb.
-Instance stuckness_le_po : PreOrder stuckness_le.
-Proof. split; by repeat intros []. Qed.
-
-Definition stuckness_to_atomicity (s : stuckness) : atomicity :=
- if s is MaybeStuck then StronglyAtomic else WeaklyAtomic.
+Global Opaque iris_invG.
Definition wp_pre `{irisG Λ Σ} (s : stuckness)
(wp : coPset -c> expr Λ -c> (val Λ -c> iProp Σ) -c> iProp Σ) :
@@ -32,7 +19,7 @@ Definition wp_pre `{irisG Λ Σ} (s : stuckness)
| Some v => |={E}=> Φ v
| None => ∀ σ1,
state_interp σ1 ={E,∅}=∗ ⌜if s is NotStuck then reducible e1 σ1 else True⌠∗
- ▷ ∀ e2 σ2 efs, ⌜prim_step e1 σ1 e2 σ2 efs⌠={∅,E}=∗
+ ∀ e2 σ2 efs, ⌜prim_step e1 σ1 e2 σ2 efs⌠={∅,∅,E}▷=∗
state_interp σ2 ∗ wp E e2 Φ ∗
[∗ list] ef ∈ efs, wp ⊤ ef (λ _, True)
end%I.
@@ -45,137 +32,9 @@ Qed.
Definition wp_def `{irisG Λ Σ} (s : stuckness) :
coPset → expr Λ → (val Λ → iProp Σ) → iProp Σ := fixpoint (wp_pre s).
-Definition wp_aux : seal (@wp_def). by eexists. Qed.
-Definition wp := unseal wp_aux.
-Definition wp_eq : @wp = @wp_def := seal_eq wp_aux.
-
-Arguments wp {_ _ _} _ _ _%E _.
-Instance: Params (@wp) 6.
-
-Notation "'WP' e @ s ; E {{ Φ } }" := (wp s E e%E Φ)
- (at level 20, e, Φ at level 200,
- format "'[' 'WP' e '/' @ s ; E {{ Φ } } ']'") : uPred_scope.
-Notation "'WP' e @ E {{ Φ } }" := (wp NotStuck E e%E Φ)
- (at level 20, e, Φ at level 200,
- format "'[' 'WP' e '/' @ E {{ Φ } } ']'") : uPred_scope.
-Notation "'WP' e @ E ? {{ Φ } }" := (wp MaybeStuck E e%E Φ)
- (at level 20, e, Φ at level 200,
- format "'[' 'WP' e '/' @ E ? {{ Φ } } ']'") : uPred_scope.
-Notation "'WP' e {{ Φ } }" := (wp NotStuck ⊤ e%E Φ)
- (at level 20, e, Φ at level 200,
- format "'[' 'WP' e '/' {{ Φ } } ']'") : uPred_scope.
-Notation "'WP' e ? {{ Φ } }" := (wp MaybeStuck ⊤ e%E Φ)
- (at level 20, e, Φ at level 200,
- format "'[' 'WP' e '/' ? {{ Φ } } ']'") : uPred_scope.
-
-Notation "'WP' e @ s ; E {{ v , Q } }" := (wp s E e%E (λ v, Q))
- (at level 20, e, Q at level 200,
- format "'[' 'WP' e '/' @ s ; E {{ v , Q } } ']'") : uPred_scope.
-Notation "'WP' e @ E {{ v , Q } }" := (wp NotStuck E e%E (λ v, Q))
- (at level 20, e, Q at level 200,
- format "'[' 'WP' e '/' @ E {{ v , Q } } ']'") : uPred_scope.
-Notation "'WP' e @ E ? {{ v , Q } }" := (wp MaybeStuck E e%E (λ v, Q))
- (at level 20, e, Q at level 200,
- format "'[' 'WP' e '/' @ E ? {{ v , Q } } ']'") : uPred_scope.
-Notation "'WP' e {{ v , Q } }" := (wp NotStuck ⊤ e%E (λ v, Q))
- (at level 20, e, Q at level 200,
- format "'[' 'WP' e '/' {{ v , Q } } ']'") : uPred_scope.
-Notation "'WP' e ? {{ v , Q } }" := (wp MaybeStuck ⊤ e%E (λ v, Q))
- (at level 20, e, Q at level 200,
- format "'[' 'WP' e '/' ? {{ v , Q } } ']'") : uPred_scope.
-
-(* Texan triples *)
-Notation "'{{{' P } } } e @ s ; E {{{ x .. y , 'RET' pat ; Q } } }" :=
- (□ ∀ Φ,
- P -∗ ▷ (∀ x, .. (∀ y, Q -∗ Φ pat%V) .. ) -∗ WP e @ s; E {{ Φ }})%I
- (at level 20, x closed binder, y closed binder,
- format "{{{ P } } } e @ s ; E {{{ x .. y , RET pat ; Q } } }") : uPred_scope.
-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.
-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.
-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.
-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.
-Notation "'{{{' P } } } e @ s ; E {{{ 'RET' pat ; Q } } }" :=
- (□ ∀ Φ, P -∗ ▷ (Q -∗ Φ pat%V) -∗ WP e @ s; E {{ Φ }})%I
- (at level 20,
- format "{{{ P } } } e @ s ; E {{{ RET pat ; Q } } }") : uPred_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.
-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.
-Notation "'{{{' P } } } e {{{ 'RET' pat ; Q } } }" :=
- (□ ∀ Φ, P -∗ ▷ (Q -∗ Φ pat%V) -∗ WP e {{ Φ }})%I
- (at level 20,
- format "{{{ P } } } e {{{ RET pat ; Q } } }") : uPred_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.
-
-Notation "'{{{' P } } } e @ s ; E {{{ x .. y , 'RET' pat ; Q } } }" :=
- (∀ Φ : _ → uPred _,
- P -∗ ▷ (∀ x, .. (∀ y, Q -∗ Φ pat%V) .. ) -∗ WP e @ s; E {{ Φ }})
- (at level 20, x closed binder, y closed binder,
- format "{{{ P } } } e @ s ; E {{{ x .. y , RET pat ; Q } } }") : stdpp_scope.
-Notation "'{{{' P } } } e @ E {{{ x .. y , 'RET' pat ; Q } } }" :=
- (∀ Φ : _ → uPred _,
- P -∗ ▷ (∀ x, .. (∀ y, Q -∗ Φ pat%V) .. ) -∗ WP e @ E {{ Φ }})
- (at level 20, x closed binder, y closed binder,
- format "{{{ P } } } e @ E {{{ x .. y , RET pat ; Q } } }") : stdpp_scope.
-Notation "'{{{' P } } } e @ E ? {{{ x .. y , 'RET' pat ; Q } } }" :=
- (∀ Φ : _ → uPred _,
- P -∗ ▷ (∀ x, .. (∀ y, Q -∗ Φ pat%V) .. ) -∗ WP e @ E ?{{ Φ }})
- (at level 20, x closed binder, y closed binder,
- format "{{{ P } } } e @ E ? {{{ x .. y , RET pat ; Q } } }") : stdpp_scope.
-Notation "'{{{' P } } } e {{{ x .. y , 'RET' pat ; Q } } }" :=
- (∀ Φ : _ → uPred _,
- P -∗ ▷ (∀ x, .. (∀ y, Q -∗ Φ pat%V) .. ) -∗ WP e {{ Φ }})
- (at level 20, x closed binder, y closed binder,
- format "{{{ P } } } e {{{ x .. y , RET pat ; Q } } }") : stdpp_scope.
-Notation "'{{{' P } } } e ? {{{ x .. y , 'RET' pat ; Q } } }" :=
- (∀ Φ : _ → uPred _,
- P -∗ ▷ (∀ x, .. (∀ y, Q -∗ Φ pat%V) .. ) -∗ WP e ?{{ Φ }})
- (at level 20, x closed binder, y closed binder,
- format "{{{ P } } } e ? {{{ x .. y , RET pat ; Q } } }") : stdpp_scope.
-Notation "'{{{' P } } } e @ s ; E {{{ 'RET' pat ; Q } } }" :=
- (∀ Φ : _ → uPred _, P -∗ ▷ (Q -∗ Φ pat%V) -∗ WP e @ s; E {{ Φ }})
- (at level 20,
- format "{{{ P } } } e @ s ; E {{{ RET pat ; Q } } }") : stdpp_scope.
-Notation "'{{{' P } } } e @ E {{{ 'RET' pat ; Q } } }" :=
- (∀ Φ : _ → uPred _, P -∗ ▷ (Q -∗ Φ pat%V) -∗ WP e @ E {{ Φ }})
- (at level 20,
- format "{{{ P } } } e @ E {{{ RET pat ; Q } } }") : stdpp_scope.
-Notation "'{{{' P } } } e @ E ? {{{ 'RET' pat ; Q } } }" :=
- (∀ Φ : _ → uPred _, P -∗ ▷ (Q -∗ Φ pat%V) -∗ WP e @ E ?{{ Φ }})
- (at level 20,
- format "{{{ P } } } e @ E ? {{{ RET pat ; Q } } }") : stdpp_scope.
-Notation "'{{{' P } } } e {{{ 'RET' pat ; Q } } }" :=
- (∀ Φ : _ → uPred _, P -∗ ▷ (Q -∗ Φ pat%V) -∗ WP e {{ Φ }})
- (at level 20,
- format "{{{ P } } } e {{{ RET pat ; Q } } }") : stdpp_scope.
-Notation "'{{{' P } } } e ? {{{ 'RET' pat ; Q } } }" :=
- (∀ Φ : _ → uPred _, P -∗ ▷ (Q -∗ Φ pat%V) -∗ WP e ?{{ Φ }})
- (at level 20,
- format "{{{ P } } } e ? {{{ RET pat ; Q } } }") : stdpp_scope.
+Definition wp_aux `{irisG Λ Σ} : seal (@wp_def Λ Σ _). by eexists. Qed.
+Instance wp' `{irisG Λ Σ} : Wp Λ (iProp Σ) stuckness := wp_aux.(unseal).
+Definition wp_eq `{irisG Λ Σ} : wp = @wp_def Λ Σ _ := wp_aux.(seal_eq).
Section wp.
Context `{irisG Λ Σ}.
@@ -186,22 +45,23 @@ Implicit Types v : val Λ.
Implicit Types e : expr Λ.
(* Weakest pre *)
-Lemma wp_unfold s E e Φ : WP e @ s; E {{ Φ }} ⊣⊢ wp_pre s (wp s) E e Φ.
+Lemma wp_unfold s E e Φ :
+ WP e @ s; E {{ Φ }} ⊣⊢ wp_pre s (wp (PROP:=iProp Σ) s) E e Φ.
Proof. rewrite wp_eq. apply (fixpoint_unfold (wp_pre s)). Qed.
Global Instance wp_ne s E e n :
- Proper (pointwise_relation _ (dist n) ==> dist n) (@wp Λ Σ _ s E e).
+ Proper (pointwise_relation _ (dist n) ==> dist n) (wp (PROP:=iProp Σ) s E e).
Proof.
revert e. induction (lt_wf n) as [n _ IH]=> e Φ Ψ HΦ.
rewrite !wp_unfold /wp_pre.
(* FIXME: figure out a way to properly automate this proof *)
(* FIXME: reflexivity, as being called many times by f_equiv and f_contractive
is very slow here *)
- do 17 (f_contractive || f_equiv). apply IH; first lia.
- intros v. eapply dist_le; eauto with omega.
+ do 18 (f_contractive || f_equiv). apply IH; first lia.
+ intros v. eapply dist_le; eauto with lia.
Qed.
Global Instance wp_proper s E e :
- Proper (pointwise_relation _ (≡) ==> (≡)) (@wp Λ Σ _ s E e).
+ Proper (pointwise_relation _ (≡) ==> (≡)) (wp (PROP:=iProp Σ) s E e).
Proof.
by intros Φ Φ' ?; apply equiv_dist=>n; apply wp_ne=>v; apply equiv_dist.
Qed.
@@ -221,8 +81,8 @@ Proof.
{ iApply ("HΦ" with "[> -]"). by iApply (fupd_mask_mono E1 _). }
iIntros (σ1) "Hσ". iMod (fupd_intro_mask' E2 E1) as "Hclose"; first done.
iMod ("H" with "[$]") as "[% H]".
- iModIntro. iSplit; [by destruct s1, s2|]. iNext. iIntros (e2 σ2 efs Hstep).
- iMod ("H" with "[//]") as "($ & H & Hefs)".
+ iModIntro. iSplit; [by destruct s1, s2|]. iIntros (e2 σ2 efs Hstep).
+ iMod ("H" with "[//]") as "H". iIntros "!> !>". iMod "H" as "($ & H & Hefs)".
iMod "Hclose" as "_". iModIntro. iSplitR "Hefs".
- iApply ("IH" with "[//] H HΦ").
- iApply (big_sepL_impl with "[$Hefs]"); iIntros "!#" (k ef _) "H".
@@ -245,8 +105,8 @@ Proof.
destruct (to_val e) as [v|] eqn:He.
{ by iDestruct "H" as ">>> $". }
iIntros (σ1) "Hσ". iMod "H". iMod ("H" $! σ1 with "Hσ") as "[$ H]".
- iModIntro. iNext. iIntros (e2 σ2 efs Hstep).
- iMod ("H" with "[//]") as "(Hphy & H & $)". destruct s.
+ iModIntro. iIntros (e2 σ2 efs Hstep).
+ iMod ("H" with "[//]") as "H". iIntros "!>!>". iMod "H" as "(Hphy & H & $)". destruct s.
- rewrite !wp_unfold /wp_pre. destruct (to_val e2) as [v2|] eqn:He2.
+ iDestruct "H" as ">> $". by iFrame.
+ iMod ("H" with "[$]") as "[H _]". iDestruct "H" as %(? & ? & ? & ?).
@@ -261,8 +121,8 @@ Lemma wp_step_fupd s E1 E2 e P Φ :
Proof.
rewrite !wp_unfold /wp_pre. iIntros (-> ?) "HR H".
iIntros (σ1) "Hσ". iMod "HR". iMod ("H" with "[$]") as "[$ H]".
- iModIntro; iNext; iIntros (e2 σ2 efs Hstep).
- iMod ("H" $! e2 σ2 efs with "[% //]") as "($ & H & $)".
+ iIntros "!>" (e2 σ2 efs Hstep). iMod ("H" $! e2 σ2 efs with "[% //]") as "H".
+ iIntros "!>!>". iMod "H" as "($ & H & $)".
iMod "HR". iModIntro. iApply (wp_strong_mono s s E2 with "H"); [done..|].
iIntros (v) "H". by iApply "H".
Qed.
@@ -277,10 +137,10 @@ Proof.
iIntros (σ1) "Hσ". iMod ("H" with "[$]") as "[% H]". iModIntro; iSplit.
{ iPureIntro. destruct s; last done.
unfold reducible in *. naive_solver eauto using fill_step. }
- iNext; iIntros (e2 σ2 efs Hstep).
+ iIntros (e2 σ2 efs Hstep).
destruct (fill_step_inv e σ1 e2 σ2 efs) as (e2'&->&?); auto.
- iMod ("H" $! e2' σ2 efs with "[//]") as "($ & H & $)".
- by iApply "IH".
+ iMod ("H" $! e2' σ2 efs with "[//]") as "H". iIntros "!>!>".
+ iMod "H" as "($ & H & $)". by iApply "IH".
Qed.
Lemma wp_bind_inv K `{!LanguageCtx K} s E e Φ :
@@ -292,9 +152,9 @@ Proof.
rewrite fill_not_val //.
iIntros (σ1) "Hσ". iMod ("H" with "[$]") as "[% H]". iModIntro; iSplit.
{ destruct s; eauto using reducible_fill. }
- iNext; iIntros (e2 σ2 efs Hstep).
- iMod ("H" $! (K e2) σ2 efs with "[]") as "($ & H & $)"; eauto using fill_step.
- by iApply "IH".
+ iIntros (e2 σ2 efs Hstep).
+ iMod ("H" $! (K e2) σ2 efs with "[]") as "H"; [by eauto using fill_step|].
+ iIntros "!>!>". iMod "H" as "($ & H & $)". by iApply "IH".
Qed.
(** * Derived rules *)
@@ -312,18 +172,18 @@ Proof. apply wp_stuck_mono. by destruct s. Qed.
Lemma wp_mask_mono s E1 E2 e Φ : E1 ⊆ E2 → WP e @ s; E1 {{ Φ }} ⊢ WP e @ s; E2 {{ Φ }}.
Proof. iIntros (?) "H"; iApply (wp_strong_mono with "H"); auto. Qed.
Global Instance wp_mono' s E e :
- Proper (pointwise_relation _ (⊢) ==> (⊢)) (@wp Λ Σ _ s E e).
+ Proper (pointwise_relation _ (⊢) ==> (⊢)) (wp (PROP:=iProp Σ) s E e).
Proof. by intros Φ Φ' ?; apply wp_mono. Qed.
-Lemma wp_value s E Φ e v `{!IntoVal e v} : Φ v ⊢ WP e @ s; E {{ Φ }}.
-Proof. intros; rewrite -(of_to_val e v) //; by apply wp_value'. Qed.
+Lemma wp_value s E Φ e v : IntoVal e v → Φ v ⊢ WP e @ s; E {{ Φ }}.
+Proof. intros <-. by apply wp_value'. Qed.
Lemma wp_value_fupd' s E Φ v : (|={E}=> Φ v) ⊢ WP of_val v @ s; E {{ Φ }}.
Proof. intros. by rewrite -wp_fupd -wp_value'. Qed.
Lemma wp_value_fupd s E Φ e v `{!IntoVal e v} :
(|={E}=> Φ v) ⊢ WP e @ s; E {{ Φ }}.
Proof. intros. rewrite -wp_fupd -wp_value //. Qed.
-Lemma wp_value_inv s E Φ e v `{!IntoVal e v} : WP e @ s; E {{ Φ }} ={E}=∗ Φ v.
-Proof. intros; rewrite -(of_to_val e v) //; by apply wp_value_inv'. Qed.
+Lemma wp_value_inv s E Φ e v : IntoVal e v → WP e @ s; E {{ Φ }} ={E}=∗ Φ v.
+Proof. intros <-. by apply wp_value_inv'. Qed.
Lemma wp_frame_l s E e Φ R : R ∗ WP e @ s; E {{ Φ }} ⊢ WP e @ s; E {{ v, R ∗ Φ v }}.
Proof. iIntros "[? H]". iApply (wp_strong_mono with "H"); auto with iFrame. Qed.
@@ -372,27 +232,61 @@ Section proofmode_classes.
Implicit Types Φ : val Λ → iProp Σ.
Global Instance frame_wp p s E e R Φ Ψ :
- (∀ v, Frame p R (Φ v) (Ψ v)) → Frame p R (WP e @ s; E {{ Φ }}) (WP e @ s; E {{ Ψ }}).
+ (∀ v, Frame p R (Φ v) (Ψ v)) →
+ Frame p R (WP e @ s; E {{ Φ }}) (WP e @ s; E {{ Ψ }}).
Proof. rewrite /Frame=> HR. rewrite wp_frame_l. apply wp_mono, HR. Qed.
Global Instance is_except_0_wp s E e Φ : IsExcept0 (WP e @ s; E {{ Φ }}).
Proof. by rewrite /IsExcept0 -{2}fupd_wp -except_0_fupd -fupd_intro. Qed.
- Global Instance elim_modal_bupd_wp s E e P Φ :
- ElimModal (|==> P) P (WP e @ s; E {{ Φ }}) (WP e @ s; E {{ Φ }}).
- Proof. by rewrite /ElimModal (bupd_fupd E) fupd_frame_r wand_elim_r fupd_wp. Qed.
-
- Global Instance elim_modal_fupd_wp s E e P Φ :
- ElimModal (|={E}=> P) P (WP e @ s; E {{ Φ }}) (WP e @ s; E {{ Φ }}).
- Proof. by rewrite /ElimModal fupd_frame_r wand_elim_r fupd_wp. Qed.
-
- Global Instance elim_modal_fupd_wp_atomic s E1 E2 e P Φ :
+ Global Instance elim_modal_bupd_wp p s E e P Φ :
+ ElimModal True p false (|==> P) P (WP e @ s; E {{ Φ }}) (WP e @ s; E {{ Φ }}).
+ Proof.
+ by rewrite /ElimModal intuitionistically_if_elim
+ (bupd_fupd E) fupd_frame_r wand_elim_r fupd_wp.
+ Qed.
+
+ Global Instance elim_modal_fupd_wp p s E e P Φ :
+ ElimModal True p false (|={E}=> P) P (WP e @ s; E {{ Φ }}) (WP e @ s; E {{ Φ }}).
+ Proof.
+ by rewrite /ElimModal intuitionistically_if_elim
+ fupd_frame_r wand_elim_r fupd_wp.
+ Qed.
+
+ Global Instance elim_modal_fupd_wp_atomic p s E1 E2 e P Φ :
Atomic (stuckness_to_atomicity s) e →
- ElimModal (|={E1,E2}=> P) P
+ ElimModal True p false (|={E1,E2}=> P) P
(WP e @ s; E1 {{ Φ }}) (WP e @ s; E2 {{ v, |={E2,E1}=> Φ v }})%I.
- Proof. intros. by rewrite /ElimModal fupd_frame_r wand_elim_r wp_atomic. Qed.
+ Proof.
+ intros. by rewrite /ElimModal intuitionistically_if_elim
+ fupd_frame_r wand_elim_r wp_atomic.
+ Qed.
Global Instance add_modal_fupd_wp s E e P Φ :
AddModal (|={E}=> P) P (WP e @ s; E {{ Φ }}).
Proof. by rewrite /AddModal fupd_frame_r wand_elim_r fupd_wp. Qed.
+
+ Global Instance elim_acc_wp {X} E1 E2 α β γ e s Φ :
+ Atomic (stuckness_to_atomicity s) e →
+ ElimAcc (X:=X) (fupd E1 E2) (fupd E2 E1)
+ α β γ (WP e @ s; E1 {{ Φ }})
+ (λ x, WP e @ s; E2 {{ v, |={E2}=> β x ∗ (γ x -∗? Φ v) }})%I.
+ Proof.
+ intros ?. rewrite /ElimAcc.
+ iIntros "Hinner >Hacc". iDestruct "Hacc" as (x) "[Hα Hclose]".
+ iApply (wp_wand with "[Hinner Hα]"); first by iApply "Hinner".
+ iIntros (v) ">[Hβ HΦ]". iApply "HΦ". by iApply "Hclose".
+ Qed.
+
+ Global Instance elim_acc_wp_nonatomic {X} E α β γ e s Φ :
+ ElimAcc (X:=X) (fupd E E) (fupd E E)
+ α β γ (WP e @ s; E {{ Φ }})
+ (λ x, WP e @ s; E {{ v, |={E}=> β x ∗ (γ x -∗? Φ v) }})%I.
+ Proof.
+ rewrite /ElimAcc.
+ iIntros "Hinner >Hacc". iDestruct "Hacc" as (x) "[Hα Hclose]".
+ iApply wp_fupd.
+ iApply (wp_wand with "[Hinner Hα]"); first by iApply "Hinner".
+ iIntros (v) ">[Hβ HΦ]". iApply "HΦ". by iApply "Hclose".
+ Qed.
End proofmode_classes.
diff --git a/theories/proofmode/base.v b/theories/proofmode/base.v
index 159a09b5ae02e28cbbfdc268f2704109535a512a..2fe6e8f72755dcfdbea209d5645b5d301eceef33 100644
--- a/theories/proofmode/base.v
+++ b/theories/proofmode/base.v
@@ -3,17 +3,26 @@ From iris.algebra Require Export base.
From Coq Require Import Ascii.
Set Default Proof Using "Type".
+(** * Utility definitions used by the proofmode *)
+
(* Directions of rewrites *)
Inductive direction := Left | Right.
-(* Some specific versions of operations on strings for the proof mode. We need
-those so that we can make [cbv] unfold just them, but not the actual operations
-that may appear in users' proofs. *)
+(* Some specific versions of operations on strings, booleans, positive for the
+proof mode. We need those so that we can make [cbv] unfold just them, but not
+the actual operations that may appear in users' proofs. *)
Local Notation "b1 && b2" := (if b1 then b2 else false) : bool_scope.
Lemma lazy_andb_true (b1 b2 : bool) : b1 && b2 = true ↔ b1 = true ∧ b2 = true.
Proof. destruct b1, b2; intuition congruence. Qed.
+Fixpoint Pos_succ (x : positive) : positive :=
+ match x with
+ | (p~1)%positive => ((Pos_succ p)~0)%positive
+ | (p~0)%positive => (p~1)%positive
+ | 1%positive => 2%positive
+ end.
+
Definition beq (b1 b2 : bool) : bool :=
match b1, b2 with
| false, false | true, true => true
@@ -84,6 +93,18 @@ Qed.
Lemma ident_beq_reflect i1 i2 : reflect (i1 = i2) (ident_beq i1 i2).
Proof. apply iff_reflect. by rewrite ident_beq_true. Qed.
-Definition option_bind {A B} (f : A → option B) (mx : option A) : option B :=
+(** Copies of some [option] combinators for better reduction control. *)
+Definition pm_option_bind {A B} (f : A → option B) (mx : option A) : option B :=
match mx with Some x => f x | None => None end.
-Arguments option_bind _ _ _ !_ /.
+Arguments pm_option_bind {_ _} _ !_ /.
+
+Definition pm_from_option {A B} (f : A → B) (y : B) (mx : option A) : B :=
+ match mx with None => y | Some x => f x end.
+Arguments pm_from_option {_ _} _ _ !_ /.
+
+Definition pm_option_fun {A B} (f : option (A → B)) (x : A) : option B :=
+ match f with None => None | Some f => Some (f x) end.
+Arguments pm_option_fun {_ _} !_ _ /.
+
+(* Can't write [id] here as that would not reduce. *)
+Notation pm_default := (pm_from_option (λ x, x)).
diff --git a/theories/proofmode/class_instances.v b/theories/proofmode/class_instances.v
deleted file mode 100644
index 9ee852ebc03731ddf6d0edfc3398de1ef5893907..0000000000000000000000000000000000000000
--- a/theories/proofmode/class_instances.v
+++ /dev/null
@@ -1,981 +0,0 @@
-From iris.proofmode Require Export classes.
-From iris.algebra Require Import gmap.
-From stdpp Require Import gmultiset nat_cancel.
-From iris.base_logic Require Import big_op tactics.
-Set Default Proof Using "Type".
-Import uPred.
-
-Section classes.
-Context {M : ucmraT}.
-Implicit Types P Q R : uPred M.
-
-(* 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.
-
-Global Instance from_assumption_persistently_r P Q :
- FromAssumption true P Q → FromAssumption true P (□ Q).
-Proof. rewrite /FromAssumption=><-. by rewrite persistent_persistently. Qed.
-
-Global Instance from_assumption_plainly_l p P Q :
- FromAssumption p P Q → FromAssumption p (■P) Q.
-Proof. rewrite /FromAssumption=><-. by rewrite plainly_elim. 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 :
- 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_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_plainly P φ : IntoPure P φ → IntoPure (■P) φ.
-Proof. rewrite /IntoPure=> ->. by rewrite plainly_pure. 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_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.
-
-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.
-
-(* FromPure *)
-Global Instance from_pure_pure φ : @FromPure M ⌜φ⌠φ.
-Proof. done. 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_plainly P φ : FromPure P φ → FromPure (■P) φ.
-Proof. rewrite /FromPure=> <-. by rewrite plainly_pure. 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.
-
-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_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.
-Qed.
-
-(* IntoInternalEq *)
-Global Instance into_internal_eq_internal_eq {A : ofeT} (x y : A) :
- @IntoInternalEq PROP A (x ≡ y) x y.
-Proof. by rewrite /IntoInternalEq. Qed.
-Global Instance into_internal_eq_persistently {A : ofeT} (x y : A) P :
- IntoInternalEq P x y → IntoInternalEq (□ P) x y.
-Proof. rewrite /IntoInternalEq=> ->. by rewrite persistently_elim. 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.
-Global Instance into_persistent_persistently P : IntoPersistent true P P | 1.
-Proof. done. Qed.
-Global Instance into_persistent_persistent P :
- Persistent P → IntoPersistent false P P | 100.
-Proof. done. Qed.
-
-(* FromAlways *)
-Global Instance from_always_persistently P : FromAlways false (â–¡ P) P.
-Proof. by rewrite /FromAlways. Qed.
-Global Instance from_always_plainly P : FromAlways true (â– P) P.
-Proof. by rewrite /FromAlways. Qed.
-
-(* IntoLater *)
-Class MakeLaterN (n : nat) (P lP : uPred M) := make_laterN : ▷^n P ⊣⊢ lP.
-Global Instance make_laterN_true n : MakeLaterN n True True | 0.
-Proof. by rewrite /MakeLaterN laterN_True. Qed.
-Global Instance make_laterN_0 P : MakeLaterN 0 P P | 0.
-Proof. done. Qed.
-Global Instance make_laterN_1 P : MakeLaterN 1 P (â–· P) | 2.
-Proof. done. Qed.
-Global Instance make_laterN_default P : MakeLaterN n P (â–·^n P) | 100.
-Proof. done. Qed.
-
-Global Instance into_laterN_0 only_head P : IntoLaterN only_head 0 P P.
-Proof. done. Qed.
-Global Instance into_laterN_later only_head n n' m' P Q lQ :
- NatCancel n 1 n' m' →
- (** If canceling has failed (i.e. [1 = m']), we should make progress deeper
- into [P], as such, we continue with the [IntoLaterN] class, which is required
- to make progress. If canceling has succeeded, we do not need to make further
- progress, but there may still be a left-over (i.e. [n']) to cancel more deeply
- into [P], as such, we continue with [MaybeIntoLaterN]. *)
- TCIf (TCEq 1 m') (IntoLaterN only_head n' P Q) (MaybeIntoLaterN only_head n' P Q) →
- MakeLaterN m' Q lQ →
- IntoLaterN only_head n (â–· P) lQ | 2.
-Proof.
- rewrite /MakeLaterN /IntoLaterN /MaybeIntoLaterN /NatCancel.
- move=> Hn [_ ->|->] <-;
- by rewrite -later_laterN -laterN_plus -Hn Nat.add_comm.
-Qed.
-Global Instance into_laterN_laterN only_head n m n' m' P Q lQ :
- NatCancel n m n' m' →
- TCIf (TCEq m m') (IntoLaterN only_head n' P Q) (MaybeIntoLaterN only_head n' P Q) →
- MakeLaterN m' Q lQ →
- IntoLaterN only_head n (â–·^m P) lQ | 1.
-Proof.
- rewrite /MakeLaterN /IntoLaterN /MaybeIntoLaterN /NatCancel.
- move=> Hn [_ ->|->] <-; by rewrite -!laterN_plus -Hn Nat.add_comm.
-Qed.
-
-Global Instance into_laterN_and_l n P1 P2 Q1 Q2 :
- IntoLaterN false n P1 Q1 → MaybeIntoLaterN false n P2 Q2 →
- IntoLaterN false n (P1 ∧ P2) (Q1 ∧ Q2) | 10.
-Proof. rewrite /IntoLaterN /MaybeIntoLaterN=> -> ->. by rewrite laterN_and. Qed.
-Global Instance into_laterN_and_r n P P2 Q2 :
- IntoLaterN false n P2 Q2 → IntoLaterN false n (P ∧ P2) (P ∧ Q2) | 11.
-Proof.
- rewrite /IntoLaterN /MaybeIntoLaterN=> ->. by rewrite laterN_and -(laterN_intro _ P).
-Qed.
-
-Global Instance into_later_forall {A} n (Φ Ψ : A → uPred M) :
- (∀ x, IntoLaterN false n (Φ x) (Ψ x)) →
- IntoLaterN false n (∀ x, Φ x) (∀ x, Ψ x).
-Proof. rewrite /IntoLaterN /MaybeIntoLaterN laterN_forall=> ?. by apply forall_mono. Qed.
-Global Instance into_later_exist {A} n (Φ Ψ : A → uPred M) :
- (∀ x, IntoLaterN false n (Φ x) (Ψ x)) →
- IntoLaterN false n (∃ x, Φ x) (∃ x, Ψ x).
-Proof. rewrite /IntoLaterN /MaybeIntoLaterN -laterN_exist_2=> ?. by apply exist_mono. Qed.
-
-Global Instance into_laterN_or_l n P1 P2 Q1 Q2 :
- IntoLaterN false n P1 Q1 → MaybeIntoLaterN false n P2 Q2 →
- IntoLaterN false n (P1 ∨ P2) (Q1 ∨ Q2) | 10.
-Proof. rewrite /IntoLaterN /MaybeIntoLaterN=> -> ->. by rewrite laterN_or. Qed.
-Global Instance into_laterN_or_r n P P2 Q2 :
- IntoLaterN false n P2 Q2 →
- IntoLaterN false n (P ∨ P2) (P ∨ Q2) | 11.
-Proof.
- rewrite /IntoLaterN /MaybeIntoLaterN=> ->. by rewrite laterN_or -(laterN_intro _ P).
-Qed.
-
-Global Instance into_laterN_sep_l n P1 P2 Q1 Q2 :
- IntoLaterN false n P1 Q1 → MaybeIntoLaterN false n P2 Q2 →
- IntoLaterN false n (P1 ∗ P2) (Q1 ∗ Q2) | 10.
-Proof. rewrite /IntoLaterN /MaybeIntoLaterN=> -> ->. by rewrite laterN_sep. Qed.
-Global Instance into_laterN_sep_r n P P2 Q2 :
- IntoLaterN false n P2 Q2 →
- IntoLaterN false n (P ∗ P2) (P ∗ Q2) | 11.
-Proof.
- rewrite /IntoLaterN /MaybeIntoLaterN=> ->. by rewrite laterN_sep -(laterN_intro _ P).
-Qed.
-
-Global Instance into_laterN_big_sepL n {A} (Φ Ψ : nat → A → uPred M) (l: list A) :
- (∀ x k, IntoLaterN false n (Φ k x) (Ψ k x)) →
- IntoLaterN false n ([∗ list] k ↦ x ∈ l, Φ k x) ([∗ list] k ↦ x ∈ l, Ψ k x).
-Proof.
- rewrite /IntoLaterN /MaybeIntoLaterN=> ?.
- rewrite big_opL_commute. by apply big_sepL_mono.
-Qed.
-Global Instance into_laterN_big_sepM n `{Countable K} {A}
- (Φ Ψ : K → A → uPred M) (m : gmap K A) :
- (∀ x k, IntoLaterN false n (Φ k x) (Ψ k x)) →
- IntoLaterN false n ([∗ map] k ↦ x ∈ m, Φ k x) ([∗ map] k ↦ x ∈ m, Ψ k x).
-Proof.
- rewrite /IntoLaterN /MaybeIntoLaterN=> ?.
- rewrite big_opM_commute; by apply big_sepM_mono.
-Qed.
-Global Instance into_laterN_big_sepS n `{Countable A}
- (Φ Ψ : A → uPred M) (X : gset A) :
- (∀ x, IntoLaterN false n (Φ x) (Ψ x)) →
- IntoLaterN false n ([∗ set] x ∈ X, Φ x) ([∗ set] x ∈ X, Ψ x).
-Proof.
- rewrite /IntoLaterN /MaybeIntoLaterN=> ?.
- rewrite big_opS_commute; by apply big_sepS_mono.
-Qed.
-Global Instance into_laterN_big_sepMS n `{Countable A}
- (Φ Ψ : A → uPred M) (X : gmultiset A) :
- (∀ x, IntoLaterN false n (Φ x) (Ψ x)) →
- IntoLaterN false n ([∗ mset] x ∈ X, Φ x) ([∗ mset] x ∈ X, Ψ x).
-Proof.
- rewrite /IntoLaterN /MaybeIntoLaterN=> ?.
- rewrite big_opMS_commute; by apply big_sepMS_mono.
-Qed.
-
-(* 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_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_plainly n P Q :
- FromLaterN n P Q → FromLaterN n (■P) (■Q).
-Proof. by rewrite /FromLaterN -plainly_laterN=> ->. Qed.
-Global Instance from_later_persistently n P Q :
- FromLaterN n P Q → FromLaterN n (□ P) (□ Q).
-Proof. by rewrite /FromLaterN -persistently_laterN=> ->. Qed.
-
-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.
-
-(* 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').
-Proof.
- rewrite /WandWeaken' /WandWeaken=> ->.
- by rewrite persistently_if_later -later_wand -later_intro.
-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').
-Proof.
- rewrite /WandWeaken' /WandWeaken=> ->.
- by rewrite persistently_if_laterN -laterN_wand -laterN_intro.
-Qed.
-Global Instance bupd_weaken_laterN p P Q P' Q' :
- WandWeaken false P Q P' Q' → WandWeaken' p P Q (|==> P') (|==> Q').
-Proof.
- rewrite /WandWeaken' /WandWeaken=> ->.
- apply wand_intro_l. by rewrite persistently_if_elim bupd_wand_r.
-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.
-
-Global Instance into_wand_forall_prop p (φ : Prop) P :
- IntoWand p (∀ _ : φ, P) ⌜ φ ⌠P.
-Proof.
- rewrite /FromAssumption /IntoWand persistently_if_pure -pure_impl_forall.
- by apply impl_wand_1.
-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_plainly p R P Q :
- IntoWand p R P Q → IntoWand p (■R) P Q.
-Proof. rewrite /IntoWand=> ->. by rewrite plainly_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).
-Proof.
- rewrite /IntoWand=> ->. apply wand_intro_l. by rewrite bupd_sep wand_elim_r.
-Qed.
-Global Instance into_wand_bupd_persistent R P Q :
- IntoWand true R P Q → IntoWand true (|==> R) P (|==> Q).
-Proof.
- rewrite /IntoWand=>->. apply wand_intro_l. by rewrite bupd_frame_l wand_elim_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_plainly p P Q1 Q2 :
- FromAnd false P Q1 Q2 → FromAnd p (■P) (■Q1) (■Q2).
-Proof.
- intros. apply mk_from_and_and.
- by rewrite plainly_and_sep_l' -plainly_sep -(from_and _ P).
-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.
-
-(* 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_plainly p P Q1 Q2 :
- IntoAnd true P Q1 Q2 → IntoAnd p (■P) (■Q1) (■Q2).
-Proof. rewrite /IntoAnd=>->. destruct p; by rewrite ?plainly_and and_sep_r. Qed.
-Global Instance into_and_persistently p P Q1 Q2 :
- IntoAnd true P Q1 Q2 → IntoAnd p (□ P) (□ Q1) (□ Q2).
-Proof.
- rewrite /IntoAnd=>->.
- destruct p; by rewrite ?persistently_and persistently_and_sep_r.
-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).
-Proof.
- rewrite /IntoAnd=>->. by destruct p; rewrite ?except_0_and ?except_0_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' :
- IsCons l x l' →
- IntoAnd 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 :
- IsApp l l1 l2 →
- IntoAnd 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.
-
-(* 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_pure p φ Q : FromPure Q φ → Frame p ⌜φ⌠Q True.
-Proof. rewrite /FromPure /Frame=> ->. by rewrite persistently_if_elim right_id. Qed.
-
-Class MakeSep (P Q PQ : uPred M) := make_sep : P ∗ Q ⊣⊢ PQ.
-Global Instance make_sep_true_l P : MakeSep True P P.
-Proof. by rewrite /MakeSep left_id. Qed.
-Global Instance make_sep_true_r P : MakeSep P True P.
-Proof. by rewrite /MakeSep right_id. Qed.
-Global Instance make_sep_default P Q : MakeSep P Q (P ∗ Q) | 100.
-Proof. done. Qed.
-
-Global Instance frame_sep_persistent_l progress R P1 P2 Q1 Q2 Q' :
- Frame true R P1 Q1 → MaybeFrame true R P2 Q2 progress → MakeSep Q1 Q2 Q' →
- Frame true R (P1 ∗ P2) Q' | 9.
-Proof.
- rewrite /Frame /MaybeFrame /MakeSep /= => <- <- <-.
- rewrite {1}(sep_dup (â–¡ R)). 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.
-Proof. rewrite /Frame /MakeSep => <- <-. by rewrite assoc. Qed.
-Global Instance frame_sep_r p R P1 P2 Q Q' :
- Frame p R P2 Q → MakeSep P1 Q Q' → Frame p R (P1 ∗ P2) Q' | 10.
-Proof. rewrite /Frame /MakeSep => <- <-. by rewrite assoc -(comm _ P1) assoc. Qed.
-
-Global Instance frame_big_sepL_cons {A} p (Φ : nat → A → uPred M) 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 :
- 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.
-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_default P Q : MakeAnd P Q (P ∧ Q) | 100.
-Proof. done. Qed.
-
-Global Instance frame_and p progress1 progress2 R P1 P2 Q1 Q2 Q' :
- MaybeFrame p R P1 Q1 progress1 →
- MaybeFrame p R P2 Q2 progress2 →
- TCEq (progress1 || progress2) true →
- MakeAnd Q1 Q2 Q' →
- Frame p R (P1 ∧ P2) Q' | 9.
-Proof. rewrite /MaybeFrame /Frame /MakeAnd => <- <- _ <-; eauto 10 with I. Qed.
-
-Class MakeOr (P Q PQ : uPred M) := make_or : P ∨ Q ⊣⊢ PQ.
-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_default P Q : MakeOr P Q (P ∨ Q) | 100.
-Proof. done. Qed.
-
-(* We could in principle write the instance [frame_or_spatial] by a bunch of
-instances, i.e. (omitting the parameter [p = false]):
-
- Frame R P1 Q1 → Frame R P2 Q2 → Frame R (P1 ∨ P2) (Q1 ∨ Q2)
- Frame R P1 True → Frame R (P1 ∨ P2) P2
- Frame R P2 True → Frame R (P1 ∨ P2) P1
-
-The problem here is that Coq will try to infer [Frame R P1 ?] and [Frame R P2 ?]
-multiple times, whereas the current solution makes sure that said inference
-appears at most once.
-
-If Coq would memorize the results of type class resolution, the solution with
-multiple instances would be preferred (and more Prolog-like). *)
-Global Instance frame_or_spatial progress1 progress2 R P1 P2 Q1 Q2 Q :
- MaybeFrame false R P1 Q1 progress1 → MaybeFrame false R P2 Q2 progress2 →
- TCOr (TCEq (progress1 && progress2) true) (TCOr
- (TCAnd (TCEq progress1 true) (TCEq Q1 True%I))
- (TCAnd (TCEq progress2 true) (TCEq Q2 True%I))) →
- MakeOr Q1 Q2 Q →
- Frame false R (P1 ∨ P2) Q | 9.
-Proof. rewrite /Frame /MakeOr => <- <- _ <-. by rewrite -sep_or_l. Qed.
-
-Global Instance frame_or_persistent progress1 progress2 R P1 P2 Q1 Q2 Q :
- MaybeFrame true R P1 Q1 progress1 → MaybeFrame true R P2 Q2 progress2 →
- TCEq (progress1 || progress2) true →
- MakeOr Q1 Q2 Q → Frame true R (P1 ∨ P2) Q | 9.
-Proof. rewrite /Frame /MakeOr => <- <- _ <-. by rewrite -sep_or_l. Qed.
-
-Global Instance frame_wand p R P1 P2 Q2 :
- Frame p R P2 Q2 → Frame p R (P1 -∗ P2) (P1 -∗ Q2).
-Proof.
- rewrite /Frame=> ?. apply wand_intro_l.
- by rewrite assoc (comm _ P1) -assoc wand_elim_r.
-Qed.
-
-Global Instance frame_impl_persistent R P1 P2 Q2 :
- Frame true R P2 Q2 → Frame true R (P1 → P2) (P1 → Q2).
-Proof.
- rewrite /Frame /==> ?. apply impl_intro_l.
- by rewrite -and_sep_l assoc (comm _ P1) -assoc impl_elim_r and_sep_l.
-Qed.
-Global Instance frame_impl R P1 P2 Q2 :
- Persistent P1 →
- Frame false R P2 Q2 → Frame false R (P1 → P2) (P1 → Q2).
-Proof.
- rewrite /Frame /==> ??. apply impl_intro_l.
- by rewrite and_sep_l assoc (comm _ P1) -assoc -(and_sep_l P1) impl_elim_r.
-Qed.
-
-Global Instance frame_later p R R' P Q Q' :
- NoBackTrack (MaybeIntoLaterN true 1 R' R) →
- Frame p R P Q → MakeLaterN 1 Q Q' → Frame p R' (▷ P) Q'.
-Proof.
- rewrite /Frame /MakeLaterN /MaybeIntoLaterN=>-[->] <- <-.
- by rewrite persistently_if_later later_sep.
-Qed.
-
-Global Instance frame_laterN p n R R' P Q Q' :
- NoBackTrack (MaybeIntoLaterN true n R' R) →
- Frame p R P Q → MakeLaterN n Q Q' → Frame p R' (▷^n P) Q'.
-Proof.
- rewrite /Frame /MakeLaterN /MaybeIntoLaterN=>-[->] <- <-.
- by rewrite persistently_if_laterN laterN_sep.
-Qed.
-
-Class MakePersistently (P Q : uPred M) := make_persistently : □ P ⊣⊢ Q.
-Global Instance make_persistently_true : MakePersistently True True.
-Proof. by rewrite /MakePersistently persistently_pure. Qed.
-Global Instance make_persistently_default P : MakePersistently P (â–¡ P) | 100.
-Proof. done. 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)).
-Qed.
-
-Global Instance frame_exist {A} p R (Φ Ψ : A → uPred M) :
- (∀ 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) :
- (∀ 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.
-
-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.
-
-(* 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_plainly P Q1 Q2 :
- FromOr P Q1 Q2 → FromOr (■P) (■Q1) (■Q2).
-Proof. rewrite /FromOr=> <-. by rewrite plainly_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.
-Global Instance from_or_laterN n P Q1 Q2 :
- FromOr P Q1 Q2 → FromOr (▷^n P) (▷^n Q1) (▷^n Q2).
-Proof. rewrite /FromOr=><-. by rewrite laterN_or. Qed.
-Global Instance from_or_except_0 P Q1 Q2 :
- FromOr P Q1 Q2 → FromOr (◇ P) (◇ Q1) (◇ Q2).
-Proof. rewrite /FromOr=><-. by rewrite except_0_or. Qed.
-
-(* IntoOr *)
-Global Instance into_or_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_plainly P Q1 Q2 :
- IntoOr P Q1 Q2 → IntoOr (■P) (■Q1) (■Q2).
-Proof. rewrite /IntoOr=>->. by rewrite plainly_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.
-Global Instance into_or_laterN n P Q1 Q2 :
- IntoOr P Q1 Q2 → IntoOr (▷^n P) (▷^n Q1) (▷^n Q2).
-Proof. rewrite /IntoOr=>->. by rewrite laterN_or. Qed.
-Global Instance into_or_except_0 P Q1 Q2 :
- IntoOr P Q1 Q2 → IntoOr (◇ P) (◇ Q1) (◇ Q2).
-Proof. rewrite /IntoOr=>->. by rewrite except_0_or. Qed.
-
-(* FromExist *)
-Global Instance from_exist_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_plainly {A} P (Φ : A → uPred M) :
- FromExist P Φ → FromExist (■P) (λ a, ■(Φ a))%I.
-Proof. rewrite /FromExist=> <-. by rewrite plainly_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) :
- 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) :
- 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) :
- 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_plainly {A} P (Φ : A → uPred M) :
- IntoExist P Φ → IntoExist (■P) (λ a, ■(Φ a))%I.
-Proof. rewrite /IntoExist=> HP. by rewrite HP plainly_exist. 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) :
- 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) :
- 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) :
- 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_plainly {A} P (Φ : A → uPred M) :
- IntoForall P Φ → IntoForall (■P) (λ a, ■(Φ a))%I.
-Proof. rewrite /IntoForall=> HP. by rewrite HP plainly_forall. 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) :
- IntoForall P Φ → IntoForall (▷ P) (λ a, ▷ (Φ a))%I.
-Proof. rewrite /IntoForall=> HP. by rewrite HP later_forall. Qed.
-Global Instance into_forall_except_0 {A} P (Φ : A → uPred M) :
- IntoForall P Φ → IntoForall (◇ P) (λ a, ◇ (Φ a))%I.
-Proof. rewrite /IntoForall=> HP. by rewrite HP except_0_forall. Qed.
-Global Instance into_forall_impl_pure φ P Q :
- FromPureT P φ → IntoForall (P → Q) (λ _ : φ, Q).
-Proof.
- rewrite /FromPureT /FromPure /IntoForall=> -[φ' [-> <-]].
- by rewrite pure_impl_forall.
-Qed.
-Global Instance into_forall_wand_pure φ P Q :
- FromPureT P φ → IntoForall (P -∗ Q) (λ _ : φ, Q).
-Proof.
- rewrite /FromPureT /FromPure /IntoForall=> -[φ' [-> <-]].
- by rewrite -pure_impl_forall -impl_wand.
-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_pure_not (φ : Prop) :
- @FromForall M φ (⌜¬ φâŒ) (λ a : φ, False)%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.
-Proof. rewrite /FromForall=> <-. by rewrite later_forall. Qed.
-Global Instance from_forall_except_0 {A} P (Φ : A → uPred M) :
- FromForall P Φ → FromForall (◇ P) (λ a, ◇ (Φ a))%I.
-Proof. rewrite /FromForall=> <-. by rewrite except_0_forall. 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').
-Proof.
- rewrite /ElimModal=> H. apply wand_intro_r.
- by rewrite wand_curry -assoc (comm _ P') -wand_curry wand_elim_l.
-Qed.
-Global Instance elim_modal_forall {A} P P' (Φ Ψ : A → uPred M) :
- (∀ 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.
-
-Global Instance elim_modal_plainly P Q : ElimModal (â– P) P Q Q.
-Proof. intros. by rewrite /ElimModal plainly_elim 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.
-
-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 elim_modal_bupd_plain_goal P Q : Plain Q → ElimModal (|==> P) P Q Q.
-Proof. intros. by rewrite /ElimModal bupd_frame_r wand_elim_r bupd_plain. Qed.
-
-Global Instance elim_modal_bupd_plain P Q : Plain P → ElimModal (|==> P) P Q Q.
-Proof. intros. by rewrite /ElimModal bupd_plain wand_elim_r. Qed.
-
-Global Instance elim_modal_except_0 P Q : IsExcept0 Q → ElimModal (◇ P) P Q Q.
-Proof.
- intros. rewrite /ElimModal (except_0_intro (_ -∗ _)).
- by rewrite -except_0_sep wand_elim_r.
-Qed.
-Global Instance elim_modal_later_timeless P Q :
- Timeless P → IsExcept0 Q → ElimModal (▷ P) P Q Q.
-Proof.
- intros. rewrite /ElimModal (except_0_intro (_ -∗ _)) (timeless P).
- by rewrite -except_0_sep wand_elim_r.
-Qed.
-Global Instance elim_modal_later_if_timeless p P Q :
- Timeless P → IsExcept0 Q → ElimModal (▷?p P) P Q Q.
-Proof.
- destruct p; simpl; auto using elim_modal_later_timeless.
- intros _ _. by rewrite /ElimModal wand_elim_r.
-Qed.
-
-(* AddModal *)
-Global Instance add_modal_wand P P' Q R :
- AddModal P P' Q → AddModal P P' (R -∗ Q).
-Proof.
- rewrite /AddModal=> H. apply wand_intro_r.
- by rewrite wand_curry -assoc (comm _ P') -wand_curry wand_elim_l.
-Qed.
-Global Instance add_modal_forall {A} P P' (Φ : A → uPred M) :
- (∀ x, AddModal P P' (Φ x)) → AddModal P P' (∀ x, Φ x).
-Proof.
- rewrite /AddModal=> H. apply forall_intro=> a. by rewrite (forall_elim a).
-Qed.
-Global Instance add_modal_bupd P Q : AddModal (|==> P) P (|==> Q).
-Proof. by rewrite /AddModal bupd_frame_r wand_elim_r bupd_trans. Qed.
-
-(* High priority to add a â–· rather than a â—‡ when P is timeless. *)
-Global Instance add_modal_later_except_0 P Q :
- Timeless P → AddModal (▷ P) P (◇ Q) | 0.
-Proof.
- intros. rewrite /AddModal (except_0_intro (_ -∗ _)) (timeless P).
- by rewrite -except_0_sep wand_elim_r except_0_idemp.
-Qed.
-Global Instance add_modal_later P Q :
- Timeless P → AddModal (▷ P) P (▷ Q) | 0.
-Proof.
- intros. rewrite /AddModal (except_0_intro (_ -∗ _)) (timeless P).
- by rewrite -except_0_sep wand_elim_r except_0_later.
-Qed.
-Global Instance add_modal_except_0 P Q : AddModal (â—‡ P) P (â—‡ Q) | 1.
-Proof.
- intros. rewrite /AddModal (except_0_intro (_ -∗ _)).
- by rewrite -except_0_sep wand_elim_r except_0_idemp.
-Qed.
-Global Instance add_modal_except_0_later P Q : AddModal (â—‡ P) P (â–· Q) | 1.
-Proof.
- intros. rewrite /AddModal (except_0_intro (_ -∗ _)).
- by rewrite -except_0_sep wand_elim_r except_0_later.
-Qed.
-
-(** IsExcept0 *)
-Global Instance is_except_0_except_0 P : IsExcept0 (â—‡ P).
-Proof. by rewrite /IsExcept0 except_0_idemp. Qed.
-Global Instance is_except_0_later P : IsExcept0 (â–· P).
-Proof. by rewrite /IsExcept0 except_0_later. Qed.
-Global Instance is_except_0_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.
-End classes.
diff --git a/theories/proofmode/class_instances_bi.v b/theories/proofmode/class_instances_bi.v
new file mode 100644
index 0000000000000000000000000000000000000000..d1adf1666b32c49aa063712ca6c7534589c77276
--- /dev/null
+++ b/theories/proofmode/class_instances_bi.v
@@ -0,0 +1,1108 @@
+From stdpp Require Import nat_cancel.
+From iris.bi Require Import bi tactics telescopes.
+From iris.proofmode Require Import base modality_instances classes ltac_tactics.
+Set Default Proof Using "Type".
+Import bi.
+
+Section bi_instances.
+Context {PROP : bi}.
+Implicit Types P Q R : PROP.
+Implicit Types mP : option PROP.
+
+(** AsEmpValid *)
+Global Instance as_emp_valid_emp_valid {PROP : bi} (P : PROP) : AsEmpValid0 (bi_emp_valid P) P | 0.
+Proof. by rewrite /AsEmpValid. Qed.
+Global Instance as_emp_valid_entails {PROP : bi} (P Q : PROP) : AsEmpValid0 (P ⊢ Q) (P -∗ Q).
+Proof. split. apply bi.entails_wand. apply bi.wand_entails. Qed.
+Global Instance as_emp_valid_equiv {PROP : bi} (P Q : PROP) : AsEmpValid0 (P ≡ Q) (P ∗-∗ Q).
+Proof. split. apply bi.equiv_wand_iff. apply bi.wand_iff_equiv. Qed.
+
+Global Instance as_emp_valid_forall {A : Type} (φ : A → Prop) (P : A → PROP) :
+ (∀ x, AsEmpValid (φ x) (P x)) → AsEmpValid (∀ x, φ x) (∀ x, P x).
+Proof.
+ rewrite /AsEmpValid=>H1. split=>H2.
+ - apply bi.forall_intro=>?. apply H1, H2.
+ - intros x. apply H1. revert H2. by rewrite (bi.forall_elim x).
+Qed.
+
+(* We add a useless hypothesis [BiEmbed PROP PROP'] in order to make
+ sure this instance is not used when there is no embedding between
+ PROP and PROP'.
+ The first [`{BiEmbed PROP PROP'}] is not considered as a premise by
+ Coq TC search mechanism because the rest of the hypothesis is dependent
+ on it. *)
+Global Instance as_emp_valid_embed `{BiEmbed PROP PROP'} (φ : Prop) (P : PROP) :
+ BiEmbed PROP PROP' →
+ AsEmpValid0 φ P → AsEmpValid φ ⎡P⎤.
+Proof. rewrite /AsEmpValid0 /AsEmpValid=> _ ->. rewrite embed_emp_valid //. Qed.
+
+(** FromAffinely *)
+Global Instance from_affinely_affine P : Affine P → FromAffinely P P.
+Proof. intros. by rewrite /FromAffinely affinely_elim. Qed.
+Global Instance from_affinely_default P : FromAffinely (<affine> P) P | 100.
+Proof. by rewrite /FromAffinely. Qed.
+Global Instance from_affinely_intuitionistically P :
+ FromAffinely (â–¡ P) (<pers> P) | 100.
+Proof. by rewrite /FromAffinely. Qed.
+
+(** IntoAbsorbingly *)
+Global Instance into_absorbingly_True : @IntoAbsorbingly PROP True emp | 0.
+Proof. by rewrite /IntoAbsorbingly -absorbingly_True_emp absorbingly_pure. Qed.
+Global Instance into_absorbingly_absorbing P : Absorbing P → IntoAbsorbingly P P | 1.
+Proof. intros. by rewrite /IntoAbsorbingly absorbing_absorbingly. Qed.
+Global Instance into_absorbingly_intuitionistically P :
+ IntoAbsorbingly (<pers> P) (â–¡ P) | 2.
+Proof.
+ by rewrite /IntoAbsorbingly -absorbingly_intuitionistically_into_persistently.
+Qed.
+Global Instance into_absorbingly_default P : IntoAbsorbingly (<absorb> P) P | 100.
+Proof. by rewrite /IntoAbsorbingly. Qed.
+
+(** FromAssumption *)
+Global Instance from_assumption_exact p P : FromAssumption p P P | 0.
+Proof. by rewrite /FromAssumption /= intuitionistically_if_elim. Qed.
+
+Global Instance from_assumption_persistently_r P Q :
+ FromAssumption true P Q → KnownRFromAssumption true P (<pers> Q).
+Proof.
+ rewrite /KnownRFromAssumption /FromAssumption /= =><-.
+ apply intuitionistically_persistent.
+Qed.
+Global Instance from_assumption_affinely_r P Q :
+ FromAssumption true P Q → KnownRFromAssumption true P (<affine> Q).
+Proof.
+ rewrite /KnownRFromAssumption /FromAssumption /= =><-.
+ by rewrite affinely_idemp.
+Qed.
+Global Instance from_assumption_intuitionistically_r P Q :
+ FromAssumption true P Q → KnownRFromAssumption true P (□ Q).
+Proof.
+ rewrite /KnownRFromAssumption /FromAssumption /= =><-.
+ by rewrite intuitionistically_idemp.
+Qed.
+Global Instance from_assumption_absorbingly_r p P Q :
+ FromAssumption p P Q → KnownRFromAssumption p P (<absorb> Q).
+Proof.
+ rewrite /KnownRFromAssumption /FromAssumption /= =><-.
+ apply absorbingly_intro.
+Qed.
+
+Global Instance from_assumption_intuitionistically_l p P Q :
+ FromAssumption true P Q → KnownLFromAssumption p (□ P) Q.
+Proof.
+ rewrite /KnownLFromAssumption /FromAssumption /= =><-.
+ by rewrite intuitionistically_if_elim.
+Qed.
+Global Instance from_assumption_persistently_l_true P Q :
+ FromAssumption true P Q → KnownLFromAssumption true (<pers> P) Q.
+Proof.
+ rewrite /KnownLFromAssumption /FromAssumption /= =><-.
+ rewrite intuitionistically_persistently_elim //.
+Qed.
+Global Instance from_assumption_persistently_l_false `{BiAffine PROP} P Q :
+ FromAssumption true P Q → KnownLFromAssumption false (<pers> P) Q.
+Proof.
+ rewrite /KnownLFromAssumption /FromAssumption /= =><-.
+ by rewrite intuitionistically_into_persistently.
+Qed.
+Global Instance from_assumption_affinely_l_true p P Q :
+ FromAssumption p P Q → KnownLFromAssumption p (<affine> P) Q.
+Proof.
+ rewrite /KnownLFromAssumption /FromAssumption /= =><-.
+ by rewrite affinely_elim.
+Qed.
+Global Instance from_assumption_intuitionistically_l_true p P Q :
+ FromAssumption p P Q → KnownLFromAssumption p (□ P) Q.
+Proof.
+ rewrite /KnownLFromAssumption /FromAssumption /= =><-.
+ by rewrite intuitionistically_elim.
+Qed.
+
+Global Instance from_assumption_forall {A} p (Φ : A → PROP) Q x :
+ FromAssumption p (Φ x) Q → KnownLFromAssumption p (∀ x, Φ x) Q.
+Proof.
+ rewrite /KnownLFromAssumption /FromAssumption=> <-.
+ by rewrite forall_elim.
+Qed.
+
+Global Instance from_assumption_bupd `{BiBUpd PROP} p P Q :
+ FromAssumption p P Q → KnownRFromAssumption p P (|==> Q).
+Proof. rewrite /KnownRFromAssumption /FromAssumption=>->. apply bupd_intro. Qed.
+
+(** IntoPure *)
+Global Instance into_pure_pure φ : @IntoPure PROP ⌜φ⌠φ.
+Proof. by rewrite /IntoPure. Qed.
+
+Global Instance into_pure_pure_and (φ1 φ2 : Prop) P1 P2 :
+ IntoPure P1 φ1 → IntoPure P2 φ2 → IntoPure (P1 ∧ P2) (φ1 ∧ φ2).
+Proof. rewrite /IntoPure pure_and. by intros -> ->. Qed.
+Global Instance into_pure_pure_or (φ1 φ2 : Prop) P1 P2 :
+ IntoPure P1 φ1 → IntoPure P2 φ2 → IntoPure (P1 ∨ P2) (φ1 ∨ φ2).
+Proof. rewrite /IntoPure pure_or. by intros -> ->. Qed.
+Global Instance into_pure_pure_impl (φ1 φ2 : Prop) P1 P2 :
+ FromPure false P1 φ1 → IntoPure P2 φ2 → IntoPure (P1 → P2) (φ1 → φ2).
+Proof. rewrite /FromPure /IntoPure pure_impl=> <- -> //. 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 true P1 φ1 → IntoPure P2 φ2 → IntoPure (P1 -∗ P2) (φ1 → φ2).
+Proof.
+ rewrite /FromPure /IntoPure=> <- -> /=.
+ rewrite pure_impl -impl_wand_2. apply bi.wand_intro_l.
+ rewrite -{1}(persistent_absorbingly_affinely ⌜φ1âŒ%I) absorbingly_sep_l
+ bi.wand_elim_r absorbing //.
+Qed.
+
+Global Instance into_pure_affinely P φ : IntoPure P φ → IntoPure (<affine> P) φ.
+Proof. rewrite /IntoPure=> ->. apply affinely_elim. Qed.
+Global Instance into_pure_intuitionistically P φ :
+ IntoPure P φ → IntoPure (□ P) φ.
+Proof. rewrite /IntoPure=> ->. apply intuitionistically_elim. Qed.
+Global Instance into_pure_absorbingly P φ : IntoPure P φ → IntoPure (<absorb> P) φ.
+Proof. rewrite /IntoPure=> ->. by rewrite absorbingly_pure. Qed.
+Global Instance into_pure_persistently P φ :
+ IntoPure P φ → IntoPure (<pers> P) φ.
+Proof. rewrite /IntoPure=> ->. apply: persistently_elim. Qed.
+Global Instance into_pure_embed `{BiEmbed PROP PROP'} P φ :
+ IntoPure P φ → IntoPure ⎡P⎤ φ.
+Proof. rewrite /IntoPure=> ->. by rewrite embed_pure. Qed.
+
+(** FromPure *)
+Global Instance from_pure_pure a φ : @FromPure PROP a ⌜φ⌠φ.
+Proof. rewrite /FromPure. apply affinely_if_elim. Qed.
+Global Instance from_pure_pure_and a (φ1 φ2 : Prop) P1 P2 :
+ FromPure a P1 φ1 → FromPure a P2 φ2 → FromPure a (P1 ∧ P2) (φ1 ∧ φ2).
+Proof. rewrite /FromPure pure_and=> <- <- /=. by rewrite affinely_if_and. Qed.
+Global Instance from_pure_pure_or a (φ1 φ2 : Prop) P1 P2 :
+ FromPure a P1 φ1 → FromPure a P2 φ2 → FromPure a (P1 ∨ P2) (φ1 ∨ φ2).
+Proof. by rewrite /FromPure pure_or affinely_if_or=><- <-. Qed.
+Global Instance from_pure_pure_impl a (φ1 φ2 : Prop) P1 P2 :
+ IntoPure P1 φ1 → FromPure a P2 φ2 → FromPure a (P1 → P2) (φ1 → φ2).
+Proof.
+ rewrite /FromPure /IntoPure pure_impl=> -> <-. destruct a=>//=.
+ apply bi.impl_intro_l. by rewrite affinely_and_r bi.impl_elim_r.
+Qed.
+
+Global Instance from_pure_exist {A} a (Φ : A → PROP) (φ : A → Prop) :
+ (∀ x, FromPure a (Φ x) (φ x)) → FromPure a (∃ x, Φ x) (∃ x, φ x).
+Proof.
+ rewrite /FromPure=>Hx. rewrite pure_exist affinely_if_exist.
+ by setoid_rewrite Hx.
+Qed.
+Global Instance from_pure_forall {A} a (Φ : A → PROP) (φ : A → Prop) :
+ (∀ x, FromPure a (Φ x) (φ x)) → FromPure a (∀ x, Φ x) (∀ x, φ x).
+Proof.
+ rewrite /FromPure=>Hx. rewrite pure_forall. setoid_rewrite <-Hx.
+ destruct a=>//=. apply affinely_forall.
+Qed.
+
+Global Instance from_pure_pure_sep_true (φ1 φ2 : Prop) P1 P2 :
+ FromPure true P1 φ1 → FromPure true P2 φ2 → FromPure true (P1 ∗ P2) (φ1 ∧ φ2).
+Proof.
+ rewrite /FromPure=> <- <- /=.
+ by rewrite -persistent_and_affinely_sep_l affinely_and_r pure_and.
+Qed.
+Global Instance from_pure_pure_sep_false_l (φ1 φ2 : Prop) P1 P2 :
+ FromPure false P1 φ1 → FromPure true P2 φ2 → FromPure false (P1 ∗ P2) (φ1 ∧ φ2).
+Proof.
+ rewrite /FromPure=> <- <- /=. by rewrite -persistent_and_affinely_sep_r pure_and.
+Qed.
+Global Instance from_pure_pure_sep_false_r (φ1 φ2 : Prop) P1 P2 :
+ FromPure true P1 φ1 → FromPure false P2 φ2 → FromPure false (P1 ∗ P2) (φ1 ∧ φ2).
+Proof.
+ rewrite /FromPure=> <- <- /=. by rewrite -persistent_and_affinely_sep_l pure_and.
+Qed.
+Global Instance from_pure_pure_wand (φ1 φ2 : Prop) a P1 P2 :
+ IntoPure P1 φ1 → FromPure false P2 φ2 → FromPure a (P1 -∗ P2) (φ1 → φ2).
+Proof.
+ rewrite /FromPure /IntoPure=> -> <- /=.
+ by rewrite bi.affinely_if_elim pure_wand_forall pure_impl pure_impl_forall.
+Qed.
+
+Global Instance from_pure_persistently P a φ :
+ FromPure true P φ → FromPure a (<pers> P) φ.
+Proof.
+ rewrite /FromPure=> <- /=.
+ by rewrite persistently_affinely_elim affinely_if_elim persistently_pure.
+Qed.
+Global Instance from_pure_affinely_true P φ :
+ FromPure true P φ → FromPure true (<affine> P) φ.
+Proof. rewrite /FromPure=><- /=. by rewrite affinely_idemp. Qed.
+Global Instance from_pure_affinely_false P φ `{!Affine P} :
+ FromPure false P φ → FromPure false (<affine> P) φ.
+Proof. rewrite /FromPure /= affine_affinely //. Qed.
+Global Instance from_pure_intuitionistically_true P φ :
+ FromPure true P φ → FromPure true (□ P) φ.
+Proof.
+ rewrite /FromPure=><- /=. rewrite intuitionistically_affinely_elim.
+ rewrite {1}(persistent ⌜φâŒ%I) //.
+Qed.
+
+Global Instance from_pure_absorbingly P φ p :
+ FromPure true P φ → FromPure p (<absorb> P) φ.
+Proof.
+ rewrite /FromPure=> <- /=.
+ rewrite persistent_absorbingly_affinely affinely_if_elim //.
+Qed.
+Global Instance from_pure_embed `{BiEmbed PROP PROP'} a P φ :
+ FromPure a P φ → FromPure a ⎡P⎤ φ.
+Proof. rewrite /FromPure=> <-. by rewrite -embed_pure embed_affinely_if_2. Qed.
+
+Global Instance from_pure_bupd `{BiBUpd PROP} a P φ :
+ FromPure a P φ → FromPure a (|==> P) φ.
+Proof. rewrite /FromPure=> <-. apply bupd_intro. Qed.
+
+(** IntoPersistent *)
+Global Instance into_persistent_persistently p P Q :
+ IntoPersistent true P Q → IntoPersistent p (<pers> P) Q | 0.
+Proof.
+ rewrite /IntoPersistent /= => ->.
+ destruct p; simpl; auto using persistently_idemp_1.
+Qed.
+Global Instance into_persistent_affinely p P Q :
+ IntoPersistent p P Q → IntoPersistent p (<affine> P) Q | 0.
+Proof. rewrite /IntoPersistent /= => <-. by rewrite affinely_elim. Qed.
+Global Instance into_persistent_intuitionistically p P Q :
+ IntoPersistent true P Q → IntoPersistent p (□ P) Q | 0.
+Proof.
+ rewrite /IntoPersistent /= =><-.
+ destruct p; simpl;
+ eauto using persistently_mono, intuitionistically_elim,
+ intuitionistically_into_persistently_1.
+Qed.
+Global Instance into_persistent_embed `{BiEmbed PROP PROP'} p P Q :
+ IntoPersistent p P Q → IntoPersistent p ⎡P⎤ ⎡Q⎤ | 0.
+Proof.
+ rewrite /IntoPersistent -embed_persistently -embed_persistently_if=> -> //.
+Qed.
+Global Instance into_persistent_here P : IntoPersistent true P P | 1.
+Proof. by rewrite /IntoPersistent. Qed.
+Global Instance into_persistent_persistent P :
+ Persistent P → IntoPersistent false P P | 100.
+Proof. intros. by rewrite /IntoPersistent. Qed.
+
+(** FromModal *)
+Global Instance from_modal_affinely P :
+ FromModal modality_affinely (<affine> P) (<affine> P) P | 2.
+Proof. by rewrite /FromModal. Qed.
+
+Global Instance from_modal_persistently P :
+ FromModal modality_persistently (<pers> P) (<pers> P) P | 2.
+Proof. by rewrite /FromModal. Qed.
+Global Instance from_modal_intuitionistically P :
+ FromModal modality_intuitionistically (â–¡ P) (â–¡ P) P | 1.
+Proof. by rewrite /FromModal. Qed.
+Global Instance from_modal_intuitionistically_affine_bi P :
+ BiAffine PROP → FromModal modality_persistently (□ P) (□ P) P | 0.
+Proof.
+ intros. by rewrite /FromModal /= intuitionistically_into_persistently.
+Qed.
+
+Global Instance from_modal_absorbingly P :
+ FromModal modality_id (<absorb> P) (<absorb> P) P.
+Proof. by rewrite /FromModal /= -absorbingly_intro. Qed.
+
+(* When having a modality nested in an embedding, e.g. [ ⎡|==> P⎤ ], we prefer
+the embedding over the modality. *)
+Global Instance from_modal_embed `{BiEmbed PROP PROP'} (P : PROP) :
+ FromModal (@modality_embed PROP PROP' _) ⎡P⎤ ⎡P⎤ P.
+Proof. by rewrite /FromModal. Qed.
+
+Global Instance from_modal_id_embed `{BiEmbed PROP PROP'} `(sel : A) P Q :
+ FromModal modality_id sel P Q →
+ FromModal modality_id sel ⎡P⎤ ⎡Q⎤ | 100.
+Proof. by rewrite /FromModal /= =><-. Qed.
+
+Global Instance from_modal_affinely_embed `{BiEmbed PROP PROP'} `(sel : A) P Q :
+ FromModal modality_affinely sel P Q →
+ FromModal modality_affinely sel ⎡P⎤ ⎡Q⎤ | 100.
+Proof. rewrite /FromModal /= =><-. by rewrite embed_affinely_2. Qed.
+Global Instance from_modal_persistently_embed `{BiEmbed PROP PROP'} `(sel : A) P Q :
+ FromModal modality_persistently sel P Q →
+ FromModal modality_persistently sel ⎡P⎤ ⎡Q⎤ | 100.
+Proof. rewrite /FromModal /= =><-. by rewrite embed_persistently. Qed.
+Global Instance from_modal_intuitionistically_embed `{BiEmbed PROP PROP'} `(sel : A) P Q :
+ FromModal modality_intuitionistically sel P Q →
+ FromModal modality_intuitionistically sel ⎡P⎤ ⎡Q⎤ | 100.
+Proof. rewrite /FromModal /= =><-. by rewrite embed_intuitionistically_2. Qed.
+
+Global Instance from_modal_bupd `{BiBUpd PROP} P :
+ FromModal modality_id (|==> P) (|==> P) P.
+Proof. by rewrite /FromModal /= -bupd_intro. Qed.
+
+(** IntoWand *)
+Global Instance into_wand_wand' p q (P Q P' Q' : PROP) :
+ IntoWand' p q (P -∗ Q) P' Q' → IntoWand p q (P -∗ Q) P' Q' | 100.
+Proof. done. Qed.
+Global Instance into_wand_impl' p q (P Q P' Q' : PROP) :
+ IntoWand' p q (P → Q) P' Q' → IntoWand p q (P → Q) P' Q' | 100.
+Proof. done. Qed.
+Global Instance into_wand_wandM' p q mP (Q P' Q' : PROP) :
+ IntoWand' p q (mP -∗? Q) P' Q' → IntoWand p q (mP -∗? Q) P' Q' | 100.
+Proof. done. Qed.
+
+Global Instance into_wand_wand p q P Q P' :
+ FromAssumption q P P' → IntoWand p q (P' -∗ Q) P Q.
+Proof.
+ rewrite /FromAssumption /IntoWand=> HP. by rewrite HP intuitionistically_if_elim.
+Qed.
+Global Instance into_wand_impl_false_false P Q P' :
+ Absorbing P' → Absorbing (P' → Q) →
+ FromAssumption false P P' → IntoWand false false (P' → Q) P Q.
+Proof.
+ rewrite /FromAssumption /IntoWand /= => ?? ->. apply wand_intro_r.
+ by rewrite sep_and impl_elim_l.
+Qed.
+Global Instance into_wand_impl_false_true P Q P' :
+ Absorbing P' → FromAssumption true P P' →
+ IntoWand false true (P' → Q) P Q.
+Proof.
+ rewrite /IntoWand /FromAssumption /= => ? HP. apply wand_intro_l.
+ rewrite -(intuitionistically_idemp P) HP.
+ by rewrite -persistently_and_intuitionistically_sep_l persistently_elim impl_elim_r.
+Qed.
+Global Instance into_wand_impl_true_false P Q P' :
+ Affine P' → FromAssumption false P P' →
+ IntoWand true false (P' → Q) P Q.
+Proof.
+ rewrite /FromAssumption /IntoWand /= => ? HP. apply wand_intro_r.
+ rewrite HP sep_and intuitionistically_elim impl_elim_l //.
+Qed.
+Global Instance into_wand_impl_true_true P Q P' :
+ FromAssumption true P P' → IntoWand true true (P' → Q) P Q.
+Proof.
+ rewrite /FromAssumption /IntoWand /= => <-. apply wand_intro_l.
+ rewrite sep_and [(□ (_ → _))%I]intuitionistically_elim impl_elim_r //.
+Qed.
+
+Global Instance into_wand_wandM p q mP' P Q :
+ FromAssumption q P (default emp%I mP') → IntoWand p q (mP' -∗? Q) P Q.
+Proof. rewrite /IntoWand wandM_sound. exact: into_wand_wand. Qed.
+
+Global Instance into_wand_and_l p q R1 R2 P' Q' :
+ IntoWand p q R1 P' Q' → IntoWand p q (R1 ∧ R2) P' Q'.
+Proof. rewrite /IntoWand=> ?. by rewrite /bi_wand_iff and_elim_l. Qed.
+Global Instance into_wand_and_r p q R1 R2 P' Q' :
+ IntoWand p q R2 Q' P' → IntoWand p q (R1 ∧ R2) Q' P'.
+Proof. rewrite /IntoWand=> ?. by rewrite /bi_wand_iff and_elim_r. Qed.
+
+Global Instance into_wand_forall_prop_true p (φ : Prop) P :
+ IntoWand p true (∀ _ : φ, P) ⌜ φ ⌠P.
+Proof.
+ rewrite /IntoWand (intuitionistically_if_elim p) /=
+ -impl_wand_intuitionistically -pure_impl_forall
+ bi.persistently_elim //.
+Qed.
+Global Instance into_wand_forall_prop_false p (φ : Prop) P :
+ Absorbing P → IntoWand p false (∀ _ : φ, P) ⌜ φ ⌠P.
+Proof.
+ intros ?.
+ rewrite /IntoWand (intuitionistically_if_elim p) /= pure_wand_forall //.
+Qed.
+
+Global Instance into_wand_forall {A} p q (Φ : A → PROP) P Q x :
+ IntoWand p q (Φ x) P Q → IntoWand p q (∀ x, Φ x) P Q.
+Proof. rewrite /IntoWand=> <-. by rewrite (forall_elim x). Qed.
+
+Global Instance into_wand_tforall {A} p q (Φ : tele_arg A → PROP) P Q x :
+ IntoWand p q (Φ x) P Q → IntoWand p q (∀.. x, Φ x) P Q.
+Proof. rewrite /IntoWand=> <-. by rewrite bi_tforall_forall (forall_elim x). Qed.
+
+Global Instance into_wand_affine p q R P Q :
+ IntoWand p q R P Q → IntoWand p q (<affine> R) (<affine> P) (<affine> Q).
+Proof.
+ rewrite /IntoWand /= => HR. apply wand_intro_r. destruct p; simpl in *.
+ - rewrite (affinely_elim R) -(affine_affinely (â–¡ R)%I) HR. destruct q; simpl in *.
+ + rewrite (affinely_elim P) -{2}(affine_affinely (â–¡ P)%I).
+ by rewrite affinely_sep_2 wand_elim_l.
+ + by rewrite affinely_sep_2 wand_elim_l.
+ - rewrite HR. destruct q; simpl in *.
+ + rewrite (affinely_elim P) -{2}(affine_affinely (â–¡ P)%I).
+ by rewrite affinely_sep_2 wand_elim_l.
+ + by rewrite affinely_sep_2 wand_elim_l.
+Qed.
+(* In case the argument is affine, but the wand resides in the spatial context,
+we can only eliminate the affine modality in the argument. This would lead to
+the following instance:
+
+ IntoWand false q R P Q → IntoWand' false q R (<affine> P) Q.
+
+This instance is redundant, however, since the elimination of the affine
+modality is already covered by the [IntoAssumption] instances that are used at
+the leaves of the instance search for [IntoWand]. *)
+Global Instance into_wand_affine_args q R P Q :
+ IntoWand true q R P Q → IntoWand' true q R (<affine> P) (<affine> Q).
+Proof.
+ rewrite /IntoWand' /IntoWand /= => HR. apply wand_intro_r.
+ rewrite -(affine_affinely (â–¡ R)%I) HR. destruct q; simpl.
+ - rewrite (affinely_elim P) -{2}(affine_affinely (â–¡ P)%I).
+ by rewrite affinely_sep_2 wand_elim_l.
+ - by rewrite affinely_sep_2 wand_elim_l.
+Qed.
+
+Global Instance into_wand_intuitionistically p q R P Q :
+ IntoWand true q R P Q → IntoWand p q (□ R) P Q.
+Proof. rewrite /IntoWand /= => ->. by rewrite {1}intuitionistically_if_elim. Qed.
+Global Instance into_wand_persistently_true q R P Q :
+ IntoWand true q R P Q → IntoWand true q (<pers> R) P Q.
+Proof. by rewrite /IntoWand /= intuitionistically_persistently_elim. Qed.
+Global Instance into_wand_persistently_false q R P Q :
+ Absorbing R → IntoWand false q R P Q → IntoWand false q (<pers> R) P Q.
+Proof. intros ?. by rewrite /IntoWand persistently_elim. Qed.
+
+Global Instance into_wand_embed `{BiEmbed PROP PROP'} p q R P Q :
+ IntoWand p q R P Q → IntoWand p q ⎡R⎤ ⎡P⎤ ⎡Q⎤.
+Proof. by rewrite /IntoWand !embed_intuitionistically_if_2 -embed_wand=> ->. Qed.
+
+(* There are two versions for [IntoWand ⎡RR⎤ ...] with the argument being
+[<affine> ⎡PP⎤]. When the wand [⎡RR⎤] resides in the intuitionistic context
+the result of wand elimination will have the affine modality. Otherwise, it
+won't. Note that when the wand [⎡RR⎤] is under an affine modality, the instance
+[into_wand_affine] would already have been used. *)
+Global Instance into_wand_affine_embed_true `{BiEmbed PROP PROP'} q (PP QQ RR : PROP) :
+ IntoWand true q RR PP QQ → IntoWand true q ⎡RR⎤ (<affine> ⎡PP⎤) (<affine> ⎡QQ⎤) | 100.
+Proof.
+ rewrite /IntoWand /=.
+ rewrite -(intuitionistically_idemp ⎡ _ ⎤%I) embed_intuitionistically_2=> ->.
+ apply bi.wand_intro_l. destruct q; simpl.
+ - rewrite affinely_elim -(intuitionistically_idemp ⎡ _ ⎤%I).
+ rewrite embed_intuitionistically_2 intuitionistically_sep_2 -embed_sep.
+ by rewrite wand_elim_r intuitionistically_affinely.
+ - by rewrite intuitionistically_affinely affinely_sep_2 -embed_sep wand_elim_r.
+Qed.
+Global Instance into_wand_affine_embed_false `{BiEmbed PROP PROP'} q (PP QQ RR : PROP) :
+ IntoWand false q RR (<affine> PP) QQ → IntoWand false q ⎡RR⎤ (<affine> ⎡PP⎤) ⎡QQ⎤ | 100.
+Proof.
+ rewrite /IntoWand /= => ->.
+ by rewrite embed_affinely_2 embed_intuitionistically_if_2 embed_wand.
+Qed.
+
+
+Global Instance into_wand_bupd `{BiBUpd PROP} p q R P Q :
+ IntoWand false false R P Q → IntoWand p q (|==> R) (|==> P) (|==> Q).
+Proof.
+ rewrite /IntoWand /= => HR. rewrite !intuitionistically_if_elim HR.
+ apply wand_intro_l. by rewrite bupd_sep wand_elim_r.
+Qed.
+Global Instance into_wand_bupd_persistent `{BiBUpd PROP} p q R P Q :
+ IntoWand false q R P Q → IntoWand p q (|==> R) P (|==> Q).
+Proof.
+ rewrite /IntoWand /= => HR. rewrite intuitionistically_if_elim HR.
+ apply wand_intro_l. by rewrite bupd_frame_l wand_elim_r.
+Qed.
+Global Instance into_wand_bupd_args `{BiBUpd PROP} p q R P Q :
+ IntoWand p false R P Q → IntoWand' p q R (|==> P) (|==> Q).
+Proof.
+ rewrite /IntoWand' /IntoWand /= => ->.
+ apply wand_intro_l. by rewrite intuitionistically_if_elim bupd_wand_r.
+Qed.
+
+(** FromWand *)
+Global Instance from_wand_wand P1 P2 : FromWand (P1 -∗ P2) P1 P2.
+Proof. by rewrite /FromWand. Qed.
+Global Instance from_wand_wandM mP1 P2 :
+ FromWand (mP1 -∗? P2) (default emp mP1)%I P2.
+Proof. by rewrite /FromWand wandM_sound. Qed.
+Global Instance from_wand_embed `{BiEmbed PROP PROP'} P Q1 Q2 :
+ FromWand P Q1 Q2 → FromWand ⎡P⎤ ⎡Q1⎤ ⎡Q2⎤.
+Proof. by rewrite /FromWand -embed_wand => <-. Qed.
+
+(** FromImpl *)
+Global Instance from_impl_impl P1 P2 : FromImpl (P1 → P2) P1 P2.
+Proof. by rewrite /FromImpl. Qed.
+Global Instance from_impl_embed `{BiEmbed PROP PROP'} P Q1 Q2 :
+ FromImpl P Q1 Q2 → FromImpl ⎡P⎤ ⎡Q1⎤ ⎡Q2⎤.
+Proof. by rewrite /FromImpl -embed_impl => <-. Qed.
+
+(** FromAnd *)
+Global Instance from_and_and P1 P2 : FromAnd (P1 ∧ P2) P1 P2 | 100.
+Proof. by rewrite /FromAnd. Qed.
+Global Instance from_and_sep_persistent_l P1 P1' P2 :
+ Persistent P1 → IntoAbsorbingly P1' P1 → FromAnd (P1 ∗ P2) P1' P2 | 9.
+Proof.
+ rewrite /IntoAbsorbingly /FromAnd=> ? ->.
+ rewrite persistent_and_affinely_sep_l_1 {1}(persistent_persistently_2 P1).
+ by rewrite absorbingly_elim_persistently -{2}(intuitionistically_elim P1).
+Qed.
+Global Instance from_and_sep_persistent_r P1 P2 P2' :
+ Persistent P2 → IntoAbsorbingly P2' P2 → FromAnd (P1 ∗ P2) P1 P2' | 10.
+Proof.
+ rewrite /IntoAbsorbingly /FromAnd=> ? ->.
+ rewrite persistent_and_affinely_sep_r_1 {1}(persistent_persistently_2 P2).
+ by rewrite absorbingly_elim_persistently -{2}(intuitionistically_elim P2).
+Qed.
+
+Global Instance from_and_pure φ ψ : @FromAnd PROP ⌜φ ∧ ψ⌠⌜φ⌠⌜ψâŒ.
+Proof. by rewrite /FromAnd pure_and. Qed.
+
+Global Instance from_and_persistently P Q1 Q2 :
+ FromAnd P Q1 Q2 →
+ FromAnd (<pers> P) (<pers> Q1) (<pers> Q2).
+Proof. rewrite /FromAnd=> <-. by rewrite persistently_and. Qed.
+Global Instance from_and_persistently_sep P Q1 Q2 :
+ FromSep P Q1 Q2 →
+ FromAnd (<pers> P) (<pers> Q1) (<pers> Q2) | 11.
+Proof. rewrite /FromAnd=> <-. by rewrite -persistently_and persistently_and_sep. Qed.
+
+Global Instance from_and_embed `{BiEmbed PROP PROP'} P Q1 Q2 :
+ FromAnd P Q1 Q2 → FromAnd ⎡P⎤ ⎡Q1⎤ ⎡Q2⎤.
+Proof. by rewrite /FromAnd -embed_and => <-. Qed.
+
+Global Instance from_and_big_sepL_cons_persistent {A} (Φ : nat → A → PROP) l x l' :
+ IsCons l x l' →
+ Persistent (Φ 0 x) →
+ FromAnd ([∗ list] k ↦ y ∈ l, Φ k y) (Φ 0 x) ([∗ list] k ↦ y ∈ l', Φ (S k) y).
+Proof. rewrite /IsCons=> -> ?. by rewrite /FromAnd big_sepL_cons persistent_and_sep_1. Qed.
+Global Instance from_and_big_sepL_app_persistent {A} (Φ : nat → A → PROP) l l1 l2 :
+ IsApp l l1 l2 →
+ (∀ k y, Persistent (Φ k y)) →
+ FromAnd ([∗ list] k ↦ y ∈ l, Φ k y)
+ ([∗ list] k ↦ y ∈ l1, Φ k y) ([∗ list] k ↦ y ∈ l2, Φ (length l1 + k) y).
+Proof. rewrite /IsApp=> -> ?. by rewrite /FromAnd big_sepL_app persistent_and_sep_1. Qed.
+
+Global Instance from_and_big_sepL2_cons_persistent {A B}
+ (Φ : nat → A → B → PROP) l1 x1 l1' l2 x2 l2' :
+ IsCons l1 x1 l1' → IsCons l2 x2 l2' →
+ Persistent (Φ 0 x1 x2) →
+ FromAnd ([∗ list] k ↦ y1;y2 ∈ l1;l2, Φ k y1 y2)
+ (Φ 0 x1 x2) ([∗ list] k ↦ y1;y2 ∈ l1';l2', Φ (S k) y1 y2).
+Proof.
+ rewrite /IsCons=> -> -> ?.
+ by rewrite /FromAnd big_sepL2_cons persistent_and_sep_1.
+Qed.
+Global Instance from_and_big_sepL2_app_persistent {A B}
+ (Φ : nat → A → B → PROP) l1 l1' l1'' l2 l2' l2'' :
+ IsApp l1 l1' l1'' → IsApp l2 l2' l2'' →
+ (∀ k y1 y2, Persistent (Φ k y1 y2)) →
+ FromAnd ([∗ list] k ↦ y1;y2 ∈ l1;l2, Φ k y1 y2)
+ ([∗ list] k ↦ y1;y2 ∈ l1';l2', Φ k y1 y2)
+ ([∗ list] k ↦ y1;y2 ∈ l1'';l2'', Φ (length l1' + k) y1 y2).
+Proof.
+ rewrite /IsApp=> -> -> ?. rewrite /FromAnd persistent_and_sep_1.
+ apply wand_elim_l', big_sepL2_app.
+Qed.
+
+(** 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 (Absorbing P1) (Affine P2) →
+ FromSep (P1 ∧ P2) P1 P2 | 101.
+Proof. intros. by rewrite /FromSep sep_and. Qed.
+
+Global Instance from_sep_pure φ ψ : @FromSep PROP ⌜φ ∧ ψ⌠⌜φ⌠⌜ψâŒ.
+Proof. by rewrite /FromSep pure_and sep_and. Qed.
+
+Global Instance from_sep_affinely P Q1 Q2 :
+ FromSep P Q1 Q2 → FromSep (<affine> P) (<affine> Q1) (<affine> Q2).
+Proof. rewrite /FromSep=> <-. by rewrite affinely_sep_2. Qed.
+Global Instance from_sep_intuitionistically P Q1 Q2 :
+ FromSep P Q1 Q2 → FromSep (□ P) (□ Q1) (□ Q2).
+Proof. rewrite /FromSep=> <-. by rewrite intuitionistically_sep_2. Qed.
+Global Instance from_sep_absorbingly P Q1 Q2 :
+ FromSep P Q1 Q2 → FromSep (<absorb> P) (<absorb> Q1) (<absorb> Q2).
+Proof. rewrite /FromSep=> <-. by rewrite absorbingly_sep. Qed.
+Global Instance from_sep_persistently P Q1 Q2 :
+ FromSep P Q1 Q2 →
+ FromSep (<pers> P) (<pers> Q1) (<pers> Q2).
+Proof. rewrite /FromSep=> <-. by rewrite persistently_sep_2. Qed.
+
+Global Instance from_sep_embed `{BiEmbed PROP PROP'} P Q1 Q2 :
+ FromSep P Q1 Q2 → FromSep ⎡P⎤ ⎡Q1⎤ ⎡Q2⎤.
+Proof. by rewrite /FromSep -embed_sep => <-. Qed.
+
+Global Instance from_sep_big_sepL_cons {A} (Φ : nat → A → PROP) l x l' :
+ IsCons l x l' →
+ FromSep ([∗ list] k ↦ y ∈ l, Φ k y) (Φ 0 x) ([∗ list] k ↦ y ∈ l', Φ (S k) y).
+Proof. rewrite /IsCons=> ->. by rewrite /FromSep big_sepL_cons. Qed.
+Global Instance from_sep_big_sepL_app {A} (Φ : nat → A → PROP) l l1 l2 :
+ IsApp l l1 l2 →
+ FromSep ([∗ list] k ↦ y ∈ l, Φ k y)
+ ([∗ list] k ↦ y ∈ l1, Φ k y) ([∗ list] k ↦ y ∈ l2, Φ (length l1 + k) y).
+Proof. rewrite /IsApp=> ->. by rewrite /FromSep big_opL_app. Qed.
+
+Global Instance from_sep_big_sepL2_cons {A B} (Φ : nat → A → B → PROP)
+ l1 x1 l1' l2 x2 l2' :
+ IsCons l1 x1 l1' → IsCons l2 x2 l2' →
+ FromSep ([∗ list] k ↦ y1;y2 ∈ l1;l2, Φ k y1 y2)
+ (Φ 0 x1 x2) ([∗ list] k ↦ y1;y2 ∈ l1';l2', Φ (S k) y1 y2).
+Proof. rewrite /IsCons=> -> ->. by rewrite /FromSep big_sepL2_cons. Qed.
+Global Instance from_sep_big_sepL2_app {A B} (Φ : nat → A → B → PROP)
+ l1 l1' l1'' l2 l2' l2'' :
+ IsApp l1 l1' l1'' → IsApp l2 l2' l2'' →
+ FromSep ([∗ list] k ↦ y1;y2 ∈ l1;l2, Φ k y1 y2)
+ ([∗ list] k ↦ y1;y2 ∈ l1';l2', Φ k y1 y2)
+ ([∗ list] k ↦ y1;y2 ∈ l1'';l2'', Φ (length l1' + k) y1 y2).
+Proof. rewrite /IsApp=>-> ->. apply wand_elim_l', big_sepL2_app. Qed.
+
+Global Instance from_sep_bupd `{BiBUpd PROP} P Q1 Q2 :
+ FromSep P Q1 Q2 → FromSep (|==> P) (|==> Q1) (|==> Q2).
+Proof. rewrite /FromSep=><-. apply bupd_sep. Qed.
+
+(** IntoAnd *)
+Global Instance into_and_and p P Q : IntoAnd p (P ∧ Q) P Q | 10.
+Proof. by rewrite /IntoAnd intuitionistically_if_and. Qed.
+Global Instance into_and_and_affine_l P Q Q' :
+ Affine P → FromAffinely Q' Q → IntoAnd false (P ∧ Q) P Q'.
+Proof.
+ intros. rewrite /IntoAnd /=.
+ by rewrite -(affine_affinely P) affinely_and_l affinely_and (from_affinely Q').
+Qed.
+Global Instance into_and_and_affine_r P P' Q :
+ Affine Q → FromAffinely P' P → IntoAnd false (P ∧ Q) P' Q.
+Proof.
+ intros. rewrite /IntoAnd /=.
+ by rewrite -(affine_affinely Q) affinely_and_r affinely_and (from_affinely P').
+Qed.
+
+Global Instance into_and_sep `{BiPositive PROP} P Q : IntoAnd true (P ∗ Q) P Q.
+Proof.
+ rewrite /IntoAnd /= intuitionistically_sep -and_sep_intuitionistically intuitionistically_and //.
+Qed.
+Global Instance into_and_sep_affine P Q :
+ TCOr (Affine P) (Absorbing Q) → TCOr (Absorbing P) (Affine Q) →
+ IntoAnd true (P ∗ Q) P Q.
+Proof. intros. by rewrite /IntoAnd /= sep_and. Qed.
+
+Global Instance into_and_pure p φ ψ : @IntoAnd PROP p ⌜φ ∧ ψ⌠⌜φ⌠⌜ψâŒ.
+Proof. by rewrite /IntoAnd pure_and intuitionistically_if_and. Qed.
+
+Global Instance into_and_affinely p P Q1 Q2 :
+ IntoAnd p P Q1 Q2 → IntoAnd p (<affine> P) (<affine> Q1) (<affine> Q2).
+Proof.
+ rewrite /IntoAnd. destruct p; simpl.
+ - rewrite -affinely_and !intuitionistically_affinely_elim //.
+ - intros ->. by rewrite affinely_and.
+Qed.
+Global Instance into_and_intuitionistically p P Q1 Q2 :
+ IntoAnd p P Q1 Q2 → IntoAnd p (□ P) (□ Q1) (□ Q2).
+Proof.
+ rewrite /IntoAnd. destruct p; simpl.
+ - rewrite -intuitionistically_and !intuitionistically_idemp //.
+ - intros ->. by rewrite intuitionistically_and.
+Qed.
+Global Instance into_and_persistently p P Q1 Q2 :
+ IntoAnd p P Q1 Q2 →
+ IntoAnd p (<pers> P) (<pers> Q1) (<pers> Q2).
+Proof.
+ rewrite /IntoAnd /=. destruct p; simpl.
+ - rewrite -persistently_and !intuitionistically_persistently_elim //.
+ - intros ->. by rewrite persistently_and.
+Qed.
+Global Instance into_and_embed `{BiEmbed PROP PROP'} p P Q1 Q2 :
+ IntoAnd p P Q1 Q2 → IntoAnd p ⎡P⎤ ⎡Q1⎤ ⎡Q2⎤.
+Proof.
+ rewrite /IntoAnd -embed_and=> HP. apply intuitionistically_if_intro'.
+ by rewrite embed_intuitionistically_if_2 HP intuitionistically_if_elim.
+Qed.
+
+(** IntoSep *)
+Global Instance into_sep_sep P Q : IntoSep (P ∗ Q) P Q.
+Proof. by rewrite /IntoSep. Qed.
+
+Inductive AndIntoSep : PROP → PROP → PROP → PROP → Prop :=
+ | and_into_sep_affine P Q Q' : Affine P → FromAffinely Q' Q → AndIntoSep P P Q Q'
+ | and_into_sep P Q : AndIntoSep P (<affine> P)%I Q Q.
+Existing Class AndIntoSep.
+Global Existing Instance and_into_sep_affine | 0.
+Global Existing Instance and_into_sep | 2.
+
+Global Instance into_sep_and_persistent_l P P' Q Q' :
+ Persistent P → AndIntoSep P P' Q Q' → IntoSep (P ∧ Q) P' Q'.
+Proof.
+ destruct 2 as [P Q Q'|P Q]; rewrite /IntoSep.
+ - rewrite -(from_affinely Q') -(affine_affinely P) affinely_and_lr.
+ by rewrite persistent_and_affinely_sep_l_1.
+ - by rewrite persistent_and_affinely_sep_l_1.
+Qed.
+Global Instance into_sep_and_persistent_r P P' Q Q' :
+ Persistent Q → AndIntoSep Q Q' P P' → IntoSep (P ∧ Q) P' Q'.
+Proof.
+ destruct 2 as [Q P P'|Q P]; rewrite /IntoSep.
+ - rewrite -(from_affinely P') -(affine_affinely Q) -affinely_and_lr.
+ by rewrite persistent_and_affinely_sep_r_1.
+ - by rewrite persistent_and_affinely_sep_r_1.
+Qed.
+
+Global Instance into_sep_pure φ ψ : @IntoSep PROP ⌜φ ∧ ψ⌠⌜φ⌠⌜ψâŒ.
+Proof. by rewrite /IntoSep pure_and persistent_and_sep_1. Qed.
+
+Global Instance into_sep_embed `{BiEmbed PROP PROP'} P Q1 Q2 :
+ IntoSep P Q1 Q2 → IntoSep ⎡P⎤ ⎡Q1⎤ ⎡Q2⎤.
+Proof. rewrite /IntoSep -embed_sep=> -> //. Qed.
+
+Global Instance into_sep_affinely `{BiPositive PROP} P Q1 Q2 :
+ IntoSep P Q1 Q2 → IntoSep (<affine> P) (<affine> Q1) (<affine> Q2) | 0.
+Proof. rewrite /IntoSep /= => ->. by rewrite affinely_sep. Qed.
+Global Instance into_sep_intuitionistically `{BiPositive PROP} P Q1 Q2 :
+ IntoSep P Q1 Q2 → IntoSep (□ P) (□ Q1) (□ Q2) | 0.
+Proof. rewrite /IntoSep /= => ->. by rewrite intuitionistically_sep. Qed.
+(* FIXME: This instance is kind of strange, it just gets rid of the bi_affinely.
+Also, it overlaps with `into_sep_affinely_later`, and hence has lower
+precedence. *)
+Global Instance into_sep_affinely_trim P Q1 Q2 :
+ IntoSep P Q1 Q2 → IntoSep (<affine> P) Q1 Q2 | 20.
+Proof. rewrite /IntoSep /= => ->. by rewrite affinely_elim. Qed.
+
+Global Instance into_sep_persistently `{BiPositive PROP} P Q1 Q2 :
+ IntoSep P Q1 Q2 →
+ IntoSep (<pers> P) (<pers> Q1) (<pers> Q2).
+Proof. rewrite /IntoSep /= => ->. by rewrite persistently_sep. Qed.
+Global Instance into_sep_persistently_affine P Q1 Q2 :
+ IntoSep P Q1 Q2 →
+ TCOr (Affine Q1) (Absorbing Q2) → TCOr (Absorbing Q1) (Affine Q2) →
+ IntoSep (<pers> P) (<pers> Q1) (<pers> Q2).
+Proof.
+ rewrite /IntoSep /= => -> ??.
+ by rewrite sep_and persistently_and persistently_and_sep_l_1.
+Qed.
+Global Instance into_sep_intuitionistically_affine P Q1 Q2 :
+ IntoSep P Q1 Q2 →
+ TCOr (Affine Q1) (Absorbing Q2) → TCOr (Absorbing Q1) (Affine Q2) →
+ IntoSep (â–¡ P) (â–¡ Q1) (â–¡ Q2).
+Proof.
+ rewrite /IntoSep /= => -> ??.
+ by rewrite sep_and intuitionistically_and and_sep_intuitionistically.
+Qed.
+
+Global Instance into_sep_big_sepL_cons {A} (Φ : nat → A → PROP) l x l' :
+ IsCons l x l' →
+ IntoSep ([∗ list] k ↦ y ∈ l, Φ k y)
+ (Φ 0 x) ([∗ list] k ↦ y ∈ l', Φ (S k) y).
+Proof. rewrite /IsCons=>->. by rewrite /IntoSep big_sepL_cons. Qed.
+Global Instance into_sep_big_sepL_app {A} (Φ : nat → A → PROP) l l1 l2 :
+ IsApp l l1 l2 →
+ IntoSep ([∗ list] k ↦ y ∈ l, Φ k y)
+ ([∗ list] k ↦ y ∈ l1, Φ k y) ([∗ list] k ↦ y ∈ l2, Φ (length l1 + k) y).
+Proof. rewrite /IsApp=>->. by rewrite /IntoSep big_sepL_app. Qed.
+
+(* No instance for app, since that only works when the LHSs have the same length *)
+Global Instance into_sep_big_sepL2_cons {A B}
+ (Φ : nat → A → B → PROP) l1 x1 l1' l2 x2 l2' :
+ IsCons l1 x1 l1' → IsCons l2 x2 l2' →
+ IntoSep ([∗ list] k ↦ y1;y2 ∈ l1;l2, Φ k y1 y2)
+ (Φ 0 x1 x2) ([∗ list] k ↦ y1;y2 ∈ l1';l2', Φ (S k) y1 y2).
+Proof. rewrite /IsCons=>-> ->. by rewrite /IntoSep big_sepL2_cons. Qed.
+
+(** FromOr *)
+Global Instance from_or_or P1 P2 : FromOr (P1 ∨ P2) P1 P2.
+Proof. by rewrite /FromOr. Qed.
+Global Instance from_or_pure φ ψ : @FromOr PROP ⌜φ ∨ ψ⌠⌜φ⌠⌜ψâŒ.
+Proof. by rewrite /FromOr pure_or. Qed.
+Global Instance from_or_affinely P Q1 Q2 :
+ FromOr P Q1 Q2 → FromOr (<affine> P) (<affine> Q1) (<affine> Q2).
+Proof. rewrite /FromOr=> <-. by rewrite affinely_or. Qed.
+Global Instance from_or_intuitionistically P Q1 Q2 :
+ FromOr P Q1 Q2 → FromOr (□ P) (□ Q1) (□ Q2).
+Proof. rewrite /FromOr=> <-. by rewrite intuitionistically_or. Qed.
+Global Instance from_or_absorbingly P Q1 Q2 :
+ FromOr P Q1 Q2 → FromOr (<absorb> P) (<absorb> Q1) (<absorb> Q2).
+Proof. rewrite /FromOr=> <-. by rewrite absorbingly_or. Qed.
+Global Instance from_or_persistently P Q1 Q2 :
+ FromOr P Q1 Q2 →
+ FromOr (<pers> P) (<pers> Q1) (<pers> Q2).
+Proof. rewrite /FromOr=> <-. by rewrite persistently_or. Qed.
+Global Instance from_or_embed `{BiEmbed PROP PROP'} P Q1 Q2 :
+ FromOr P Q1 Q2 → FromOr ⎡P⎤ ⎡Q1⎤ ⎡Q2⎤.
+Proof. by rewrite /FromOr -embed_or => <-. Qed.
+
+Global Instance from_or_bupd `{BiBUpd PROP} P Q1 Q2 :
+ FromOr P Q1 Q2 → FromOr (|==> P) (|==> Q1) (|==> Q2).
+Proof.
+ rewrite /FromOr=><-.
+ apply or_elim; apply bupd_mono; auto using or_intro_l, or_intro_r.
+Qed.
+
+(** IntoOr *)
+Global Instance into_or_or P Q : IntoOr (P ∨ Q) P Q.
+Proof. by rewrite /IntoOr. Qed.
+Global Instance into_or_pure φ ψ : @IntoOr PROP ⌜φ ∨ ψ⌠⌜φ⌠⌜ψâŒ.
+Proof. by rewrite /IntoOr pure_or. Qed.
+Global Instance into_or_affinely P Q1 Q2 :
+ IntoOr P Q1 Q2 → IntoOr (<affine> P) (<affine> Q1) (<affine> Q2).
+Proof. rewrite /IntoOr=>->. by rewrite affinely_or. Qed.
+Global Instance into_or_intuitionistically P Q1 Q2 :
+ IntoOr P Q1 Q2 → IntoOr (□ P) (□ Q1) (□ Q2).
+Proof. rewrite /IntoOr=>->. by rewrite intuitionistically_or. Qed.
+Global Instance into_or_absorbingly P Q1 Q2 :
+ IntoOr P Q1 Q2 → IntoOr (<absorb> P) (<absorb> Q1) (<absorb> Q2).
+Proof. rewrite /IntoOr=>->. by rewrite absorbingly_or. Qed.
+Global Instance into_or_persistently P Q1 Q2 :
+ IntoOr P Q1 Q2 →
+ IntoOr (<pers> P) (<pers> Q1) (<pers> Q2).
+Proof. rewrite /IntoOr=>->. by rewrite persistently_or. Qed.
+Global Instance into_or_embed `{BiEmbed PROP PROP'} P Q1 Q2 :
+ IntoOr P Q1 Q2 → IntoOr ⎡P⎤ ⎡Q1⎤ ⎡Q2⎤.
+Proof. by rewrite /IntoOr -embed_or => <-. Qed.
+
+(** FromExist *)
+Global Instance from_exist_exist {A} (Φ : A → PROP) : FromExist (∃ a, Φ a) Φ.
+Proof. by rewrite /FromExist. Qed.
+Global Instance from_exist_texist {A} (Φ : tele_arg A → PROP) :
+ FromExist (∃.. a, Φ a) Φ.
+Proof. by rewrite /FromExist bi_texist_exist. Qed.
+Global Instance from_exist_pure {A} (φ : A → Prop) :
+ @FromExist PROP A ⌜∃ x, φ x⌠(λ a, ⌜φ aâŒ)%I.
+Proof. by rewrite /FromExist pure_exist. Qed.
+Global Instance from_exist_affinely {A} P (Φ : A → PROP) :
+ FromExist P Φ → FromExist (<affine> P) (λ a, <affine> (Φ a))%I.
+Proof. rewrite /FromExist=> <-. by rewrite affinely_exist. Qed.
+Global Instance from_exist_intuitionistically {A} P (Φ : A → PROP) :
+ FromExist P Φ → FromExist (□ P) (λ a, □ (Φ a))%I.
+Proof. rewrite /FromExist=> <-. by rewrite intuitionistically_exist. Qed.
+Global Instance from_exist_absorbingly {A} P (Φ : A → PROP) :
+ FromExist P Φ → FromExist (<absorb> P) (λ a, <absorb> (Φ a))%I.
+Proof. rewrite /FromExist=> <-. by rewrite absorbingly_exist. Qed.
+Global Instance from_exist_persistently {A} P (Φ : A → PROP) :
+ FromExist P Φ → FromExist (<pers> P) (λ a, <pers> (Φ a))%I.
+Proof. rewrite /FromExist=> <-. by rewrite persistently_exist. Qed.
+Global Instance from_exist_embed `{BiEmbed PROP PROP'} {A} P (Φ : A → PROP) :
+ FromExist P Φ → FromExist ⎡P⎤ (λ a, ⎡Φ a⎤%I).
+Proof. by rewrite /FromExist -embed_exist => <-. Qed.
+
+Global Instance from_exist_bupd `{BiBUpd PROP} {A} P (Φ : A → PROP) :
+ FromExist P Φ → FromExist (|==> P) (λ a, |==> Φ a)%I.
+Proof.
+ rewrite /FromExist=><-. apply exist_elim=> a. by rewrite -(exist_intro a).
+Qed.
+
+(** IntoExist *)
+Global Instance into_exist_exist {A} (Φ : A → PROP) : IntoExist (∃ a, Φ a) Φ.
+Proof. by rewrite /IntoExist. Qed.
+Global Instance into_exist_texist {A} (Φ : tele_arg A → PROP) :
+ IntoExist (∃.. a, Φ a) Φ | 10.
+Proof. by rewrite /IntoExist bi_texist_exist. Qed.
+Global Instance into_exist_pure {A} (φ : A → Prop) :
+ @IntoExist PROP A ⌜∃ x, φ x⌠(λ a, ⌜φ aâŒ)%I.
+Proof. by rewrite /IntoExist pure_exist. Qed.
+Global Instance into_exist_affinely {A} P (Φ : A → PROP) :
+ IntoExist P Φ → IntoExist (<affine> P) (λ a, <affine> (Φ a))%I.
+Proof. rewrite /IntoExist=> HP. by rewrite HP affinely_exist. Qed.
+Global Instance into_exist_intuitionistically {A} P (Φ : A → PROP) :
+ IntoExist P Φ → IntoExist (□ P) (λ a, □ (Φ a))%I.
+Proof. rewrite /IntoExist=> HP. by rewrite HP intuitionistically_exist. Qed.
+Global Instance into_exist_and_pure P Q φ :
+ IntoPureT P φ → IntoExist (P ∧ Q) (λ _ : φ, Q).
+Proof.
+ intros (φ'&->&?). rewrite /IntoExist (into_pure P).
+ apply pure_elim_l=> Hφ. by rewrite -(exist_intro Hφ).
+Qed.
+Global Instance into_exist_sep_pure P Q φ :
+ IntoPureT P φ → TCOr (Affine P) (Absorbing Q) → IntoExist (P ∗ Q) (λ _ : φ, Q).
+Proof.
+ intros (φ'&->&?) ?. rewrite /IntoExist.
+ eapply (pure_elim φ'); [by rewrite (into_pure P); apply sep_elim_l, _|]=>?.
+ rewrite -exist_intro //. apply sep_elim_r, _.
+Qed.
+Global Instance into_exist_absorbingly {A} P (Φ : A → PROP) :
+ IntoExist P Φ → IntoExist (<absorb> P) (λ a, <absorb> (Φ a))%I.
+Proof. rewrite /IntoExist=> HP. by rewrite HP absorbingly_exist. Qed.
+Global Instance into_exist_persistently {A} P (Φ : A → PROP) :
+ IntoExist P Φ → IntoExist (<pers> P) (λ a, <pers> (Φ a))%I.
+Proof. rewrite /IntoExist=> HP. by rewrite HP persistently_exist. Qed.
+Global Instance into_exist_embed `{BiEmbed PROP PROP'} {A} P (Φ : A → PROP) :
+ IntoExist P Φ → IntoExist ⎡P⎤ (λ a, ⎡Φ a⎤%I).
+Proof. by rewrite /IntoExist -embed_exist => <-. Qed.
+
+(** IntoForall *)
+Global Instance into_forall_forall {A} (Φ : A → PROP) : IntoForall (∀ a, Φ a) Φ.
+Proof. by rewrite /IntoForall. Qed.
+Global Instance into_forall_tforall {A} (Φ : tele_arg A → PROP) :
+ IntoForall (∀.. a, Φ a) Φ | 10.
+Proof. by rewrite /IntoForall bi_tforall_forall. Qed.
+Global Instance into_forall_affinely {A} P (Φ : A → PROP) :
+ IntoForall P Φ → IntoForall (<affine> P) (λ a, <affine> (Φ a))%I.
+Proof. rewrite /IntoForall=> HP. by rewrite HP affinely_forall. Qed.
+Global Instance into_forall_intuitionistically {A} P (Φ : A → PROP) :
+ IntoForall P Φ → IntoForall (□ P) (λ a, □ (Φ a))%I.
+Proof. rewrite /IntoForall=> HP. by rewrite HP intuitionistically_forall. Qed.
+Global Instance into_forall_persistently {A} P (Φ : A → PROP) :
+ IntoForall P Φ → IntoForall (<pers> P) (λ a, <pers> (Φ a))%I.
+Proof. rewrite /IntoForall=> HP. by rewrite HP persistently_forall. Qed.
+Global Instance into_forall_embed `{BiEmbed PROP PROP'} {A} P (Φ : A → PROP) :
+ IntoForall P Φ → IntoForall ⎡P⎤ (λ a, ⎡Φ a⎤%I).
+Proof. by rewrite /IntoForall -embed_forall => <-. Qed.
+
+Global Instance into_forall_impl_pure φ P Q :
+ FromPureT false P φ → IntoForall (P → Q) (λ _ : φ, Q).
+Proof.
+ rewrite /FromPureT /FromPure /IntoForall=> -[φ' [-> <-]].
+ by rewrite pure_impl_forall.
+Qed.
+Global Instance into_forall_wand_pure φ P Q :
+ FromPureT true P φ → IntoForall (P -∗ Q) (λ _ : φ, Q).
+Proof.
+ rewrite /FromPureT /FromPure /IntoForall=> -[φ' [-> <-]] /=.
+ apply forall_intro=>? /=.
+ by rewrite -(pure_intro _ True%I) // /bi_affinely right_id emp_wand.
+Qed.
+
+(* These instances must be used only after [into_forall_wand_pure] and
+[into_forall_wand_pure] above. *)
+Global Instance into_forall_wand P Q :
+ IntoForall (P -∗ Q) (λ _ : bi_emp_valid P, Q) | 10.
+Proof. rewrite /IntoForall. apply forall_intro=><-. rewrite emp_wand //. Qed.
+Global Instance into_forall_impl `{!BiAffine PROP} P Q :
+ IntoForall (P → Q) (λ _ : bi_emp_valid P, Q) | 10.
+Proof. rewrite /IntoForall. apply forall_intro=><-. rewrite -True_emp True_impl //. Qed.
+
+(** FromForall *)
+Global Instance from_forall_forall {A} (Φ : A → PROP) :
+ FromForall (∀ x, Φ x)%I Φ.
+Proof. by rewrite /FromForall. Qed.
+Global Instance from_forall_tforall {A} (Φ : tele_arg A → PROP) :
+ FromForall (∀.. x, Φ x)%I Φ.
+Proof. by rewrite /FromForall bi_tforall_forall. Qed.
+Global Instance from_forall_pure {A} (φ : A → Prop) :
+ @FromForall PROP A (⌜∀ a : A, φ aâŒ)%I (λ a, ⌜ φ a âŒ)%I.
+Proof. by rewrite /FromForall pure_forall. Qed.
+Global Instance from_forall_pure_not (φ : Prop) :
+ @FromForall PROP φ (⌜¬ φâŒ)%I (λ a : φ, False)%I.
+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 φ :
+ IntoPureT P φ → TCOr (Affine P) (Absorbing Q) →
+ FromForall (P -∗ Q)%I (λ _ : φ, Q)%I.
+Proof.
+ intros (φ'&->&?) [|]; rewrite /FromForall; apply wand_intro_r.
+ - rewrite -(affine_affinely P) (into_pure P) -persistent_and_affinely_sep_r.
+ apply pure_elim_r=>?. by rewrite forall_elim.
+ - by rewrite (into_pure P) -pure_wand_forall wand_elim_l.
+Qed.
+
+Global Instance from_forall_intuitionistically `{BiAffine PROP} {A} P (Φ : A → PROP) :
+ FromForall P Φ → FromForall (□ P) (λ a, □ (Φ a))%I.
+Proof.
+ rewrite /FromForall=> <-. setoid_rewrite intuitionistically_into_persistently.
+ by rewrite persistently_forall.
+Qed.
+Global Instance from_forall_persistently {A} P (Φ : A → PROP) :
+ FromForall P Φ → FromForall (<pers> P)%I (λ a, <pers> (Φ a))%I.
+Proof. rewrite /FromForall=> <-. by rewrite persistently_forall. Qed.
+Global Instance from_forall_embed `{BiEmbed PROP PROP'} {A} P (Φ : A → PROP) :
+ FromForall P Φ → FromForall ⎡P⎤%I (λ a, ⎡Φ a⎤%I).
+Proof. by rewrite /FromForall -embed_forall => <-. Qed.
+
+(** IntoInv *)
+Global Instance into_inv_embed {PROP' : bi} `{BiEmbed PROP PROP'} P N :
+ IntoInv P N → IntoInv ⎡P⎤ N.
+
+(** ElimModal *)
+Global Instance elim_modal_wand φ p p' P P' Q Q' R :
+ ElimModal φ p p' P P' Q Q' → ElimModal φ p p' P P' (R -∗ Q) (R -∗ Q').
+Proof.
+ rewrite /ElimModal=> H Hφ. apply wand_intro_r.
+ rewrite wand_curry -assoc (comm _ (â–¡?p' _)%I) -wand_curry wand_elim_l; auto.
+Qed.
+Global Instance elim_modal_wandM φ p p' P P' Q Q' mR :
+ ElimModal φ p p' P P' Q Q' →
+ ElimModal φ p p' P P' (mR -∗? Q) (mR -∗? Q').
+Proof. rewrite /ElimModal !wandM_sound. exact: elim_modal_wand. Qed.
+Global Instance elim_modal_forall {A} φ p p' P P' (Φ Ψ : A → PROP) :
+ (∀ x, ElimModal φ p p' P P' (Φ x) (Ψ x)) → ElimModal φ p p' P P' (∀ x, Φ x) (∀ x, Ψ x).
+Proof.
+ rewrite /ElimModal=> H ?. apply forall_intro=> a. rewrite (forall_elim a); auto.
+Qed.
+Global Instance elim_modal_absorbingly_here p P Q :
+ Absorbing Q → ElimModal True p false (<absorb> P) P Q Q.
+Proof.
+ rewrite /ElimModal=> ? _. by rewrite intuitionistically_if_elim
+ absorbingly_sep_l wand_elim_r absorbing_absorbingly.
+Qed.
+
+Global Instance elim_modal_bupd `{BiBUpd PROP} p P Q :
+ ElimModal True p false (|==> P) P (|==> Q) (|==> Q).
+Proof.
+ by rewrite /ElimModal
+ intuitionistically_if_elim bupd_frame_r wand_elim_r bupd_trans.
+Qed.
+
+Global Instance elim_modal_embed_bupd_goal `{BiEmbedBUpd PROP PROP'}
+ p p' φ (P P' : PROP') (Q Q' : PROP) :
+ ElimModal φ p p' P P' (|==> ⎡Q⎤)%I (|==> ⎡Q'⎤)%I →
+ ElimModal φ p p' P P' ⎡|==> Q⎤ ⎡|==> Q'⎤.
+Proof. by rewrite /ElimModal !embed_bupd. Qed.
+Global Instance elim_modal_embed_bupd_hyp `{BiEmbedBUpd PROP PROP'}
+ p p' φ (P : PROP) (P' Q Q' : PROP') :
+ ElimModal φ p p' (|==> ⎡P⎤)%I P' Q Q' →
+ ElimModal φ p p' ⎡|==> P⎤ P' Q Q'.
+Proof. by rewrite /ElimModal !embed_bupd. Qed.
+
+(** AddModal *)
+Global Instance add_modal_wand P P' Q R :
+ AddModal P P' Q → AddModal P P' (R -∗ Q).
+Proof.
+ rewrite /AddModal=> H. apply wand_intro_r.
+ by rewrite wand_curry -assoc (comm _ P') -wand_curry wand_elim_l.
+Qed.
+Global Instance add_modal_wandM P P' Q mR :
+ AddModal P P' Q → AddModal P P' (mR -∗? Q).
+Proof. rewrite /AddModal wandM_sound. exact: add_modal_wand. Qed.
+Global Instance add_modal_forall {A} P P' (Φ : A → PROP) :
+ (∀ x, AddModal P P' (Φ x)) → AddModal P P' (∀ x, Φ x).
+Proof.
+ rewrite /AddModal=> H. apply forall_intro=> a. by rewrite (forall_elim a).
+Qed.
+Global Instance add_modal_embed_bupd_goal `{BiEmbedBUpd PROP PROP'}
+ (P P' : PROP') (Q : PROP) :
+ AddModal P P' (|==> ⎡Q⎤)%I → AddModal P P' ⎡|==> Q⎤.
+Proof. by rewrite /AddModal !embed_bupd. Qed.
+
+Global Instance add_modal_bupd `{BiBUpd PROP} P Q : AddModal (|==> P) P (|==> Q).
+Proof. by rewrite /AddModal bupd_frame_r wand_elim_r bupd_trans. Qed.
+
+(** ElimInv *)
+Global Instance elim_inv_acc_without_close {X : Type}
+ φ Pinv Pin
+ M1 M2 α β mγ Q (Q' : X → PROP) :
+ IntoAcc (X:=X) Pinv φ Pin M1 M2 α β mγ →
+ ElimAcc (X:=X) M1 M2 α β mγ Q Q' →
+ ElimInv φ Pinv Pin α None Q Q'.
+Proof.
+ rewrite /ElimAcc /IntoAcc /ElimInv.
+ iIntros (Hacc Helim Hφ) "(Hinv & Hin & Hcont)".
+ iApply (Helim with "[Hcont]").
+ - iIntros (x) "Hα". iApply "Hcont". iSplitL; simpl; done.
+ - iApply (Hacc with "Hinv Hin"). done.
+Qed.
+
+(* This uses [pm_default] because, after inference, all accessors will have
+[None] or [Some _] there, so we want to reduce the combinator before showing the
+goal to the user. *)
+Global Instance elim_inv_acc_with_close {X : Type}
+ φ1 φ2 Pinv Pin
+ M1 M2 α β mγ Q Q' :
+ IntoAcc Pinv φ1 Pin M1 M2 α β mγ →
+ (∀ R, ElimModal φ2 false false (M1 R) R Q Q') →
+ ElimInv (X:=X) (φ1 ∧ φ2) Pinv Pin
+ α
+ (Some (λ x, β x -∗ M2 (pm_default emp (mγ x))))%I
+ Q (λ _, Q').
+Proof.
+ rewrite /ElimAcc /IntoAcc /ElimInv.
+ iIntros (Hacc Helim [??]) "(Hinv & Hin & Hcont)".
+ iMod (Hacc with "Hinv Hin") as (x) "[Hα Hclose]"; first done.
+ iApply "Hcont". simpl. iSplitL "Hα"; done.
+Qed.
+
+(** IntoEmbed *)
+Global Instance into_embed_embed {PROP' : bi} `{BiEmbed PROP PROP'} P :
+ IntoEmbed ⎡P⎤ P.
+Proof. by rewrite /IntoEmbed. Qed.
+Global Instance into_embed_affinely `{BiEmbedBUpd PROP PROP'} (P : PROP') (Q : PROP) :
+ IntoEmbed P Q → IntoEmbed (<affine> P) (<affine> Q).
+Proof. rewrite /IntoEmbed=> ->. by rewrite embed_affinely_2. Qed.
+End bi_instances.
diff --git a/theories/proofmode/class_instances_sbi.v b/theories/proofmode/class_instances_sbi.v
new file mode 100644
index 0000000000000000000000000000000000000000..e622f11a80b6d540e27d28f83849600e2e755400
--- /dev/null
+++ b/theories/proofmode/class_instances_sbi.v
@@ -0,0 +1,641 @@
+From stdpp Require Import nat_cancel.
+From iris.bi Require Import bi tactics.
+From iris.proofmode Require Import base modality_instances classes class_instances_bi ltac_tactics.
+Set Default Proof Using "Type".
+Import bi.
+
+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 → KnownRFromAssumption p P (▷ Q)%I.
+Proof. rewrite /KnownRFromAssumption /FromAssumption=>->. apply later_intro. Qed.
+Global Instance from_assumption_laterN n p P Q :
+ FromAssumption p P Q → KnownRFromAssumption p P (▷^n Q)%I.
+Proof. rewrite /KnownRFromAssumption /FromAssumption=>->. apply laterN_intro. Qed.
+Global Instance from_assumption_except_0 p P Q :
+ FromAssumption p P Q → KnownRFromAssumption p P (◇ Q)%I.
+Proof. rewrite /KnownRFromAssumption /FromAssumption=>->. apply except_0_intro. Qed.
+
+Global Instance from_assumption_fupd `{BiBUpdFUpd PROP} E p P Q :
+ FromAssumption p P (|==> Q) → KnownRFromAssumption p P (|={E}=> Q)%I.
+Proof. rewrite /KnownRFromAssumption /FromAssumption=>->. apply bupd_fupd. Qed.
+
+Global Instance from_assumption_plainly_l_true `{BiPlainly PROP} P Q :
+ FromAssumption true P Q → KnownLFromAssumption true (■P) Q.
+Proof.
+ rewrite /KnownLFromAssumption /FromAssumption /= =><-.
+ rewrite intuitionistically_plainly_elim //.
+Qed.
+Global Instance from_assumption_plainly_l_false `{BiPlainly PROP, BiAffine PROP} P Q :
+ FromAssumption true P Q → KnownLFromAssumption false (■P) Q.
+Proof.
+ rewrite /KnownLFromAssumption /FromAssumption /= =><-.
+ rewrite plainly_elim_persistently intuitionistically_into_persistently //.
+Qed.
+
+(** FromPure *)
+Global Instance from_pure_internal_eq af {A : ofeT} (a b : A) :
+ @FromPure PROP af (a ≡ b) (a ≡ b).
+Proof. by rewrite /FromPure pure_internal_eq affinely_if_elim. Qed.
+Global Instance from_pure_later a P φ : FromPure a P φ → FromPure a (▷ P) φ.
+Proof. rewrite /FromPure=> ->. apply later_intro. Qed.
+Global Instance from_pure_laterN a n P φ : FromPure a P φ → FromPure a (▷^n P) φ.
+Proof. rewrite /FromPure=> ->. apply laterN_intro. Qed.
+Global Instance from_pure_except_0 a P φ : FromPure a P φ → FromPure a (◇ P) φ.
+Proof. rewrite /FromPure=> ->. apply except_0_intro. Qed.
+
+Global Instance from_pure_fupd `{BiFUpd PROP} a E P φ :
+ FromPure a P φ → FromPure a (|={E}=> P) φ.
+Proof. rewrite /FromPure. intros <-. apply fupd_intro. Qed.
+
+Global Instance from_pure_plainly `{BiPlainly PROP} P φ :
+ FromPure false P φ → FromPure false (■P) φ.
+Proof. rewrite /FromPure=> <-. by rewrite plainly_pure. Qed.
+
+(** IntoPure *)
+Global Instance into_pure_eq {A : ofeT} (a b : A) :
+ Discrete a → @IntoPure PROP (a ≡ b) (a ≡ b).
+Proof. intros. by rewrite /IntoPure discrete_eq. Qed.
+
+Global Instance into_pure_plainly `{BiPlainly PROP} P φ :
+ IntoPure P φ → IntoPure (■P) φ.
+Proof. rewrite /IntoPure=> ->. apply: plainly_elim. Qed.
+
+(** IntoWand *)
+Global Instance into_wand_later p q R P Q :
+ IntoWand p q R P Q → IntoWand p q (▷ R) (▷ P) (▷ Q).
+Proof.
+ rewrite /IntoWand /= => HR.
+ by rewrite !later_intuitionistically_if_2 -later_wand HR.
+Qed.
+Global Instance into_wand_later_args p q R P Q :
+ IntoWand p q R P Q → IntoWand' p q R (▷ P) (▷ Q).
+Proof.
+ rewrite /IntoWand' /IntoWand /= => HR.
+ by rewrite !later_intuitionistically_if_2
+ (later_intro (â–¡?p R)%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 !laterN_intuitionistically_if_2 -laterN_wand HR.
+Qed.
+Global Instance into_wand_laterN_args n p q R P Q :
+ IntoWand p q R P Q → IntoWand' p q R (▷^n P) (▷^n Q).
+Proof.
+ rewrite /IntoWand' /IntoWand /= => HR.
+ by rewrite !laterN_intuitionistically_if_2
+ (laterN_intro _ (â–¡?p R)%I) -laterN_wand HR.
+Qed.
+
+Global Instance into_wand_fupd `{BiFUpd PROP} E p q R P Q :
+ IntoWand false false R P Q →
+ IntoWand p q (|={E}=> R) (|={E}=> P) (|={E}=> Q).
+Proof.
+ rewrite /IntoWand /= => HR. rewrite !intuitionistically_if_elim HR.
+ apply wand_intro_l. by rewrite fupd_sep wand_elim_r.
+Qed.
+Global Instance into_wand_fupd_persistent `{BiFUpd PROP} E1 E2 p q R P Q :
+ IntoWand false q R P Q → IntoWand p q (|={E1,E2}=> R) P (|={E1,E2}=> Q).
+Proof.
+ rewrite /IntoWand /= => HR. rewrite intuitionistically_if_elim HR.
+ apply wand_intro_l. by rewrite fupd_frame_l wand_elim_r.
+Qed.
+Global Instance into_wand_fupd_args `{BiFUpd PROP} E1 E2 p q R P Q :
+ IntoWand p false R P Q → IntoWand' p q R (|={E1,E2}=> P) (|={E1,E2}=> Q).
+Proof.
+ rewrite /IntoWand' /IntoWand /= => ->.
+ apply wand_intro_l. by rewrite intuitionistically_if_elim fupd_wand_r.
+Qed.
+
+Global Instance into_wand_plainly_true `{BiPlainly PROP} q R P Q :
+ IntoWand true q R P Q → IntoWand true q (■R) P Q.
+Proof. rewrite /IntoWand /= intuitionistically_plainly_elim //. Qed.
+Global Instance into_wand_plainly_false `{BiPlainly PROP} q R P Q :
+ Absorbing R → IntoWand false q R P Q → IntoWand false q (■R) P Q.
+Proof. intros ?. by rewrite /IntoWand plainly_elim. Qed.
+
+(** FromAnd *)
+Global Instance from_and_later P Q1 Q2 :
+ FromAnd P Q1 Q2 → FromAnd (▷ P) (▷ Q1) (▷ Q2).
+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.
+
+Global Instance from_and_plainly `{BiPlainly PROP} P Q1 Q2 :
+ FromAnd P Q1 Q2 → FromAnd (■P) (■Q1) (■Q2).
+Proof. rewrite /FromAnd=> <-. by rewrite plainly_and. Qed.
+
+(** FromSep *)
+Global Instance from_sep_later P Q1 Q2 :
+ FromSep P Q1 Q2 → FromSep (▷ P) (▷ Q1) (▷ Q2).
+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.
+
+Global Instance from_sep_fupd `{BiFUpd PROP} E P Q1 Q2 :
+ FromSep P Q1 Q2 → FromSep (|={E}=> P) (|={E}=> Q1) (|={E}=> Q2).
+Proof. rewrite /FromSep =><-. apply fupd_sep. Qed.
+
+Global Instance from_sep_plainly `{BiPlainly PROP} P Q1 Q2 :
+ FromSep P Q1 Q2 → FromSep (■P) (■Q1) (■Q2).
+Proof. rewrite /FromSep=> <-. by rewrite plainly_sep_2. Qed.
+
+(** IntoAnd *)
+Global Instance into_and_later p P Q1 Q2 :
+ IntoAnd p P Q1 Q2 → IntoAnd p (▷ P) (▷ Q1) (▷ Q2).
+Proof.
+ rewrite /IntoAnd=> HP. apply intuitionistically_if_intro'.
+ by rewrite later_intuitionistically_if_2 HP
+ intuitionistically_if_elim later_and.
+Qed.
+Global Instance into_and_laterN n p P Q1 Q2 :
+ IntoAnd p P Q1 Q2 → IntoAnd p (▷^n P) (▷^n Q1) (▷^n Q2).
+Proof.
+ rewrite /IntoAnd=> HP. apply intuitionistically_if_intro'.
+ by rewrite laterN_intuitionistically_if_2 HP
+ intuitionistically_if_elim laterN_and.
+Qed.
+Global Instance into_and_except_0 p P Q1 Q2 :
+ IntoAnd p P Q1 Q2 → IntoAnd p (◇ P) (◇ Q1) (◇ Q2).
+Proof.
+ rewrite /IntoAnd=> HP. apply intuitionistically_if_intro'.
+ by rewrite except_0_intuitionistically_if_2 HP
+ intuitionistically_if_elim except_0_and.
+Qed.
+
+Global Instance into_and_plainly `{BiPlainly PROP} p P Q1 Q2 :
+ IntoAnd p P Q1 Q2 → IntoAnd p (■P) (■Q1) (■Q2).
+Proof.
+ rewrite /IntoAnd /=. destruct p; simpl.
+ - rewrite -plainly_and -[(â–¡ â– P)%I]intuitionistically_idemp intuitionistically_plainly =>->.
+ rewrite [(□ (_ ∧ _))%I]intuitionistically_elim //.
+ - intros ->. by rewrite plainly_and.
+Qed.
+
+(** IntoSep *)
+Global Instance into_sep_later P Q1 Q2 :
+ IntoSep P Q1 Q2 → IntoSep (▷ P) (▷ Q1) (▷ Q2).
+Proof. rewrite /IntoSep=> ->. by rewrite later_sep. Qed.
+Global Instance into_sep_laterN n P Q1 Q2 :
+ IntoSep P Q1 Q2 → IntoSep (▷^n P) (▷^n Q1) (▷^n Q2).
+Proof. rewrite /IntoSep=> ->. by rewrite laterN_sep. Qed.
+Global Instance into_sep_except_0 P Q1 Q2 :
+ IntoSep P Q1 Q2 → IntoSep (◇ P) (◇ Q1) (◇ Q2).
+Proof. rewrite /IntoSep=> ->. by rewrite except_0_sep. Qed.
+
+(* FIXME: This instance is overly specific, generalize it. *)
+Global Instance into_sep_affinely_later `{!Timeless (PROP:=PROP) emp} P Q1 Q2 :
+ IntoSep P Q1 Q2 → Affine Q1 → Affine Q2 →
+ IntoSep (<affine> â–· P) (<affine> â–· Q1) (<affine> â–· Q2).
+Proof.
+ rewrite /IntoSep /= => -> ??.
+ rewrite -{1}(affine_affinely Q1) -{1}(affine_affinely Q2) later_sep !later_affinely_1.
+ rewrite -except_0_sep /sbi_except_0 affinely_or. apply or_elim, affinely_elim.
+ rewrite -(idemp bi_and (<affine> â–· False)%I) persistent_and_sep_1.
+ by rewrite -(False_elim Q1) -(False_elim Q2).
+Qed.
+
+Global Instance into_sep_plainly `{BiPlainly PROP, BiPositive PROP} P Q1 Q2 :
+ IntoSep P Q1 Q2 → IntoSep (■P) (■Q1) (■Q2).
+Proof. rewrite /IntoSep /= => ->. by rewrite plainly_sep. Qed.
+
+Global Instance into_sep_plainly_affine `{BiPlainly PROP} P Q1 Q2 :
+ IntoSep P Q1 Q2 →
+ TCOr (Affine Q1) (Absorbing Q2) → TCOr (Absorbing Q1) (Affine Q2) →
+ IntoSep (â– P) (â– Q1) (â– Q2).
+Proof.
+ rewrite /IntoSep /= => -> ??. by rewrite sep_and plainly_and plainly_and_sep_l_1.
+Qed.
+
+(** FromOr *)
+Global Instance from_or_later P Q1 Q2 :
+ FromOr P Q1 Q2 → FromOr (▷ P) (▷ Q1) (▷ Q2).
+Proof. rewrite /FromOr=><-. by rewrite later_or. Qed.
+Global Instance from_or_laterN n P Q1 Q2 :
+ FromOr P Q1 Q2 → FromOr (▷^n P) (▷^n Q1) (▷^n Q2).
+Proof. rewrite /FromOr=><-. by rewrite laterN_or. Qed.
+Global Instance from_or_except_0 P Q1 Q2 :
+ FromOr P Q1 Q2 → FromOr (◇ P) (◇ Q1) (◇ Q2).
+Proof. rewrite /FromOr=><-. by rewrite except_0_or. Qed.
+
+Global Instance from_or_fupd `{BiFUpd PROP} E1 E2 P Q1 Q2 :
+ FromOr P Q1 Q2 → FromOr (|={E1,E2}=> P) (|={E1,E2}=> Q1) (|={E1,E2}=> Q2).
+Proof.
+ rewrite /FromOr=><-. apply or_elim; apply fupd_mono;
+ [apply bi.or_intro_l|apply bi.or_intro_r].
+Qed.
+
+Global Instance from_or_plainly `{BiPlainly PROP} P Q1 Q2 :
+ FromOr P Q1 Q2 → FromOr (■P) (■Q1) (■Q2).
+Proof. rewrite /FromOr=> <-. by rewrite -plainly_or_2. Qed.
+
+(** IntoOr *)
+Global Instance into_or_later P Q1 Q2 :
+ IntoOr P Q1 Q2 → IntoOr (▷ P) (▷ Q1) (▷ Q2).
+Proof. rewrite /IntoOr=>->. by rewrite later_or. Qed.
+Global Instance into_or_laterN n P Q1 Q2 :
+ IntoOr P Q1 Q2 → IntoOr (▷^n P) (▷^n Q1) (▷^n Q2).
+Proof. rewrite /IntoOr=>->. by rewrite laterN_or. Qed.
+Global Instance into_or_except_0 P Q1 Q2 :
+ IntoOr P Q1 Q2 → IntoOr (◇ P) (◇ Q1) (◇ Q2).
+Proof. rewrite /IntoOr=>->. by rewrite except_0_or. Qed.
+
+Global Instance into_or_plainly `{BiPlainly PROP, BiPlainlyExist PROP} P Q1 Q2 :
+ IntoOr P Q1 Q2 → IntoOr (■P) (■Q1) (■Q2).
+Proof. rewrite /IntoOr=>->. by rewrite plainly_or. Qed.
+
+(** FromExist *)
+Global Instance from_exist_later {A} P (Φ : A → PROP) :
+ FromExist P Φ → FromExist (▷ P) (λ a, ▷ (Φ a))%I.
+Proof.
+ rewrite /FromExist=> <-. apply exist_elim=>x. apply later_mono, exist_intro.
+Qed.
+Global Instance from_exist_laterN {A} n P (Φ : A → PROP) :
+ FromExist P Φ → FromExist (▷^n P) (λ a, ▷^n (Φ a))%I.
+Proof.
+ rewrite /FromExist=> <-. apply exist_elim=>x. apply laterN_mono, exist_intro.
+Qed.
+Global Instance from_exist_except_0 {A} P (Φ : A → PROP) :
+ FromExist P Φ → FromExist (◇ P) (λ a, ◇ (Φ a))%I.
+Proof. rewrite /FromExist=> <-. by rewrite except_0_exist_2. Qed.
+
+Global Instance from_exist_fupd `{BiFUpd PROP} {A} E1 E2 P (Φ : A → PROP) :
+ FromExist P Φ → FromExist (|={E1,E2}=> P) (λ a, |={E1,E2}=> Φ a)%I.
+Proof.
+ rewrite /FromExist=><-. apply exist_elim=> a. by rewrite -(exist_intro a).
+Qed.
+
+Global Instance from_exist_plainly `{BiPlainly PROP} {A} P (Φ : A → PROP) :
+ FromExist P Φ → FromExist (■P) (λ a, ■(Φ a))%I.
+Proof. rewrite /FromExist=> <-. by rewrite -plainly_exist_2. Qed.
+
+(** IntoExist *)
+Global Instance into_exist_later {A} P (Φ : A → PROP) :
+ IntoExist P Φ → Inhabited A → IntoExist (▷ P) (λ a, ▷ (Φ a))%I.
+Proof. rewrite /IntoExist=> HP ?. by rewrite HP later_exist. Qed.
+Global Instance into_exist_laterN {A} n P (Φ : A → PROP) :
+ IntoExist P Φ → Inhabited A → IntoExist (▷^n P) (λ a, ▷^n (Φ a))%I.
+Proof. rewrite /IntoExist=> HP ?. by rewrite HP laterN_exist. Qed.
+Global Instance into_exist_except_0 {A} P (Φ : A → PROP) :
+ IntoExist P Φ → Inhabited A → IntoExist (◇ P) (λ a, ◇ (Φ a))%I.
+Proof. rewrite /IntoExist=> HP ?. by rewrite HP except_0_exist. Qed.
+
+Global Instance into_exist_plainly `{BiPlainlyExist PROP} {A} P (Φ : A → PROP) :
+ IntoExist P Φ → IntoExist (■P) (λ a, ■(Φ a))%I.
+Proof. rewrite /IntoExist=> HP. by rewrite HP plainly_exist. Qed.
+
+(** IntoForall *)
+Global Instance into_forall_later {A} P (Φ : A → PROP) :
+ IntoForall P Φ → IntoForall (▷ P) (λ a, ▷ (Φ a))%I.
+Proof. rewrite /IntoForall=> HP. by rewrite HP later_forall. Qed.
+Global Instance into_forall_except_0 {A} P (Φ : A → PROP) :
+ IntoForall P Φ → IntoForall (◇ P) (λ a, ◇ (Φ a))%I.
+Proof. rewrite /IntoForall=> HP. by rewrite HP except_0_forall. Qed.
+
+Global Instance into_forall_plainly `{BiPlainly PROP} {A} P (Φ : A → PROP) :
+ IntoForall P Φ → IntoForall (■P) (λ a, ■(Φ a))%I.
+Proof. rewrite /IntoForall=> HP. by rewrite HP plainly_forall. Qed.
+
+(** FromForall *)
+Global Instance from_forall_later {A} P (Φ : A → PROP) :
+ FromForall P Φ → FromForall (▷ P)%I (λ a, ▷ (Φ a))%I.
+Proof. rewrite /FromForall=> <-. by rewrite later_forall. Qed.
+Global Instance from_forall_except_0 {A} P (Φ : A → PROP) :
+ FromForall P Φ → FromForall (◇ P)%I (λ a, ◇ (Φ a))%I.
+Proof. rewrite /FromForall=> <-. by rewrite except_0_forall. Qed.
+
+Global Instance from_forall_plainly `{BiPlainly PROP} {A} P (Φ : A → PROP) :
+ FromForall P Φ → FromForall (■P)%I (λ a, ■(Φ a))%I.
+Proof. rewrite /FromForall=> <-. by rewrite plainly_forall. Qed.
+
+(** IsExcept0 *)
+Global Instance is_except_0_except_0 P : IsExcept0 (â—‡ P).
+Proof. by rewrite /IsExcept0 except_0_idemp. Qed.
+Global Instance is_except_0_later P : IsExcept0 (â–· P).
+Proof. by rewrite /IsExcept0 except_0_later. Qed.
+Global Instance is_except_0_embed `{SbiEmbed PROP PROP'} P :
+ IsExcept0 P → IsExcept0 ⎡P⎤.
+Proof. by rewrite /IsExcept0 -embed_except_0=>->. Qed.
+Global Instance is_except_0_bupd `{BiBUpd PROP} P : IsExcept0 P → IsExcept0 (|==> P).
+Proof.
+ rewrite /IsExcept0=> HP.
+ by rewrite -{2}HP -(except_0_idemp P) -except_0_bupd -(except_0_intro P).
+Qed.
+Global Instance is_except_0_fupd `{BiFUpd PROP} E1 E2 P :
+ IsExcept0 (|={E1,E2}=> P).
+Proof. by rewrite /IsExcept0 except_0_fupd. Qed.
+
+(** FromModal *)
+Global Instance from_modal_later P :
+ FromModal (modality_laterN 1) (â–·^1 P) (â–· P) P.
+Proof. by rewrite /FromModal. Qed.
+Global Instance from_modal_laterN n P :
+ FromModal (modality_laterN n) (â–·^n P) (â–·^n P) P.
+Proof. by rewrite /FromModal. Qed.
+Global Instance from_modal_except_0 P : FromModal modality_id (â—‡ P) (â—‡ P) P.
+Proof. by rewrite /FromModal /= -except_0_intro. Qed.
+
+Global Instance from_modal_fupd E P `{BiFUpd PROP} :
+ FromModal modality_id (|={E}=> P) (|={E}=> P) P.
+Proof. by rewrite /FromModal /= -fupd_intro. Qed.
+
+Global Instance from_modal_later_embed `{SbiEmbed PROP PROP'} `(sel : A) n P Q :
+ FromModal (modality_laterN n) sel P Q →
+ FromModal (modality_laterN n) sel ⎡P⎤ ⎡Q⎤.
+Proof. rewrite /FromModal /= =><-. by rewrite embed_laterN. Qed.
+
+Global Instance from_modal_plainly `{BiPlainly PROP} P :
+ FromModal modality_plainly (â– P) (â– P) P | 2.
+Proof. by rewrite /FromModal. Qed.
+
+Global Instance from_modal_plainly_embed `{BiPlainly PROP, BiPlainly PROP',
+ BiEmbedPlainly PROP PROP', !SbiEmbed PROP PROP'} `(sel : A) P Q :
+ FromModal modality_plainly sel P Q →
+ FromModal modality_plainly sel ⎡P⎤ ⎡Q⎤ | 100.
+Proof. rewrite /FromModal /= =><-. by rewrite embed_plainly. Qed.
+
+(** IntoInternalEq *)
+Global Instance into_internal_eq_internal_eq {A : ofeT} (x y : A) :
+ @IntoInternalEq PROP A (x ≡ y) x y.
+Proof. by rewrite /IntoInternalEq. Qed.
+Global Instance into_internal_eq_affinely {A : ofeT} (x y : A) P :
+ IntoInternalEq P x y → IntoInternalEq (<affine> P) x y.
+Proof. rewrite /IntoInternalEq=> ->. by rewrite affinely_elim. Qed.
+Global Instance into_internal_eq_intuitionistically {A : ofeT} (x y : A) P :
+ IntoInternalEq P x y → IntoInternalEq (□ P) x y.
+Proof. rewrite /IntoInternalEq=> ->. by rewrite intuitionistically_elim. Qed.
+Global Instance into_internal_eq_absorbingly {A : ofeT} (x y : A) P :
+ IntoInternalEq P x y → IntoInternalEq (<absorb> P) x y.
+Proof. rewrite /IntoInternalEq=> ->. by rewrite absorbingly_internal_eq. Qed.
+Global Instance into_internal_eq_plainly `{BiPlainly PROP} {A : ofeT} (x y : A) P :
+ IntoInternalEq P x y → IntoInternalEq (■P) x y.
+Proof. rewrite /IntoInternalEq=> ->. by rewrite plainly_elim. Qed.
+Global Instance into_internal_eq_persistently {A : ofeT} (x y : A) P :
+ IntoInternalEq P x y → IntoInternalEq (<pers> P) x y.
+Proof. rewrite /IntoInternalEq=> ->. by rewrite persistently_elim. Qed.
+Global Instance into_internal_eq_embed
+ `{SbiEmbed PROP PROP'} {A : ofeT} (x y : A) P :
+ IntoInternalEq P x y → IntoInternalEq ⎡P⎤ x y.
+Proof. rewrite /IntoInternalEq=> ->. by rewrite embed_internal_eq. Qed.
+
+(** IntoExcept0 *)
+Global Instance into_except_0_except_0 P : IntoExcept0 (â—‡ P) P.
+Proof. by rewrite /IntoExcept0. Qed.
+Global Instance into_except_0_later P : Timeless P → IntoExcept0 (▷ P) P.
+Proof. by rewrite /IntoExcept0. Qed.
+Global Instance into_except_0_later_if p P : Timeless P → IntoExcept0 (▷?p P) P.
+Proof. rewrite /IntoExcept0. destruct p; auto using except_0_intro. Qed.
+
+Global Instance into_except_0_affinely P Q :
+ IntoExcept0 P Q → IntoExcept0 (<affine> P) (<affine> Q).
+Proof. rewrite /IntoExcept0=> ->. by rewrite except_0_affinely_2. Qed.
+Global Instance into_except_0_intuitionistically P Q :
+ IntoExcept0 P Q → IntoExcept0 (□ P) (□ Q).
+Proof. rewrite /IntoExcept0=> ->. by rewrite except_0_intuitionistically_2. Qed.
+Global Instance into_except_0_absorbingly P Q :
+ IntoExcept0 P Q → IntoExcept0 (<absorb> P) (<absorb> Q).
+Proof. rewrite /IntoExcept0=> ->. by rewrite except_0_absorbingly. Qed.
+Global Instance into_except_0_plainly `{BiPlainly PROP, BiPlainlyExist PROP} P Q :
+ IntoExcept0 P Q → IntoExcept0 (■P) (■Q).
+Proof. rewrite /IntoExcept0=> ->. by rewrite except_0_plainly. Qed.
+Global Instance into_except_0_persistently P Q :
+ IntoExcept0 P Q → IntoExcept0 (<pers> P) (<pers> Q).
+Proof. rewrite /IntoExcept0=> ->. by rewrite except_0_persistently. Qed.
+Global Instance into_except_0_embed `{SbiEmbed PROP PROP'} P Q :
+ IntoExcept0 P Q → IntoExcept0 ⎡P⎤ ⎡Q⎤.
+Proof. rewrite /IntoExcept0=> ->. by rewrite embed_except_0. Qed.
+
+(** ElimModal *)
+Global Instance elim_modal_timeless p P Q :
+ IntoExcept0 P P' → IsExcept0 Q → ElimModal True p p P P' Q Q.
+Proof.
+ intros. rewrite /ElimModal (except_0_intro (_ -∗ _)%I) (into_except_0 P).
+ by rewrite except_0_intuitionistically_if_2 -except_0_sep wand_elim_r.
+Qed.
+
+Global Instance elim_modal_bupd_plain_goal `{BiBUpdPlainly PROP} p P Q :
+ Plain Q → ElimModal True p false (|==> P) P Q Q.
+Proof.
+ intros. by rewrite /ElimModal intuitionistically_if_elim
+ bupd_frame_r wand_elim_r bupd_plain.
+Qed.
+Global Instance elim_modal_bupd_plain `{BiBUpdPlainly PROP} p P Q :
+ Plain P → ElimModal True p p (|==> P) P Q Q.
+Proof. intros. by rewrite /ElimModal bupd_plain wand_elim_r. Qed.
+Global Instance elim_modal_bupd_fupd `{BiBUpdFUpd PROP} p E1 E2 P Q :
+ ElimModal True p false (|==> P) P (|={E1,E2}=> Q) (|={E1,E2}=> Q) | 10.
+Proof.
+ by rewrite /ElimModal intuitionistically_if_elim
+ (bupd_fupd E1) fupd_frame_r wand_elim_r fupd_trans.
+Qed.
+
+Global Instance elim_modal_fupd_fupd `{BiFUpd PROP} p E1 E2 E3 P Q :
+ ElimModal True p false (|={E1,E2}=> P) P (|={E1,E3}=> Q) (|={E2,E3}=> Q).
+Proof.
+ by rewrite /ElimModal intuitionistically_if_elim
+ fupd_frame_r wand_elim_r fupd_trans.
+Qed.
+
+Global Instance elim_modal_embed_fupd_goal `{BiEmbedFUpd PROP PROP'}
+ p p' φ E1 E2 E3 (P P' : PROP') (Q Q' : PROP) :
+ ElimModal φ p p' P P' (|={E1,E3}=> ⎡Q⎤)%I (|={E2,E3}=> ⎡Q'⎤)%I →
+ ElimModal φ p p' P P' ⎡|={E1,E3}=> Q⎤ ⎡|={E2,E3}=> Q'⎤.
+Proof. by rewrite /ElimModal !embed_fupd. Qed.
+Global Instance elim_modal_embed_fupd_hyp `{BiEmbedFUpd PROP PROP'}
+ p p' φ E1 E2 (P : PROP) (P' Q Q' : PROP') :
+ ElimModal φ p p' (|={E1,E2}=> ⎡P⎤)%I P' Q Q' →
+ ElimModal φ p p' ⎡|={E1,E2}=> P⎤ P' Q Q'.
+Proof. by rewrite /ElimModal embed_fupd. Qed.
+
+(** AddModal *)
+(* High priority to add a â–· rather than a â—‡ when P is timeless. *)
+Global Instance add_modal_later_except_0 P Q :
+ Timeless P → AddModal (▷ P) P (◇ Q) | 0.
+Proof.
+ intros. rewrite /AddModal (except_0_intro (_ -∗ _)%I) (timeless P).
+ by rewrite -except_0_sep wand_elim_r except_0_idemp.
+Qed.
+Global Instance add_modal_later P Q :
+ Timeless P → AddModal (▷ P) P (▷ Q) | 0.
+Proof.
+ intros. rewrite /AddModal (except_0_intro (_ -∗ _)%I) (timeless P).
+ by rewrite -except_0_sep wand_elim_r except_0_later.
+Qed.
+Global Instance add_modal_except_0 P Q : AddModal (â—‡ P) P (â—‡ Q) | 1.
+Proof.
+ intros. rewrite /AddModal (except_0_intro (_ -∗ _)%I).
+ by rewrite -except_0_sep wand_elim_r except_0_idemp.
+Qed.
+Global Instance add_modal_except_0_later P Q : AddModal (â—‡ P) P (â–· Q) | 1.
+Proof.
+ intros. rewrite /AddModal (except_0_intro (_ -∗ _)%I).
+ by rewrite -except_0_sep wand_elim_r except_0_later.
+Qed.
+
+Global Instance add_modal_fupd `{BiFUpd PROP} E1 E2 P Q :
+ AddModal (|={E1}=> P) P (|={E1,E2}=> Q).
+Proof. by rewrite /AddModal fupd_frame_r wand_elim_r fupd_trans. Qed.
+
+Global Instance add_modal_embed_fupd_goal `{BiEmbedFUpd PROP PROP'}
+ E1 E2 (P P' : PROP') (Q : PROP) :
+ AddModal P P' (|={E1,E2}=> ⎡Q⎤)%I → AddModal P P' ⎡|={E1,E2}=> Q⎤.
+Proof. by rewrite /AddModal !embed_fupd. Qed.
+
+(** ElimAcc *)
+Global Instance elim_acc_fupd `{BiFUpd PROP} {X} E1 E2 E α β mγ Q :
+ (* FIXME: Why %I? ElimAcc sets the right scopes! *)
+ ElimAcc (X:=X) (fupd E1 E2) (fupd E2 E1) α β mγ
+ (|={E1,E}=> Q)
+ (λ x, |={E2}=> β x ∗ (mγ x -∗? |={E1,E}=> Q))%I.
+Proof.
+ rewrite /ElimAcc.
+ iIntros "Hinner >Hacc". iDestruct "Hacc" as (x) "[Hα Hclose]".
+ iMod ("Hinner" with "Hα") as "[Hβ Hfin]".
+ iMod ("Hclose" with "Hβ") as "Hγ". by iApply "Hfin".
+Qed.
+
+(** IntoAcc *)
+(* TODO: We could have instances from "unfolded" accessors with or without
+ the first binder. *)
+
+(** IntoLater *)
+Global Instance into_laterN_0 only_head P : IntoLaterN only_head 0 P P.
+Proof. by rewrite /IntoLaterN /MaybeIntoLaterN. Qed.
+Global Instance into_laterN_later only_head n n' m' P Q lQ :
+ NatCancel n 1 n' m' →
+ (** If canceling has failed (i.e. [1 = m']), we should make progress deeper
+ into [P], as such, we continue with the [IntoLaterN] class, which is required
+ to make progress. If canceling has succeeded, we do not need to make further
+ progress, but there may still be a left-over (i.e. [n']) to cancel more deeply
+ into [P], as such, we continue with [MaybeIntoLaterN]. *)
+ TCIf (TCEq 1 m') (IntoLaterN only_head n' P Q) (MaybeIntoLaterN only_head n' P Q) →
+ MakeLaterN m' Q lQ →
+ IntoLaterN only_head n (â–· P) lQ | 2.
+Proof.
+ rewrite /MakeLaterN /IntoLaterN /MaybeIntoLaterN /NatCancel.
+ move=> Hn [_ ->|->] <-;
+ by rewrite -later_laterN -laterN_plus -Hn Nat.add_comm.
+Qed.
+Global Instance into_laterN_laterN only_head n m n' m' P Q lQ :
+ NatCancel n m n' m' →
+ TCIf (TCEq m m') (IntoLaterN only_head n' P Q) (MaybeIntoLaterN only_head n' P Q) →
+ MakeLaterN m' Q lQ →
+ IntoLaterN only_head n (â–·^m P) lQ | 1.
+Proof.
+ rewrite /MakeLaterN /IntoLaterN /MaybeIntoLaterN /NatCancel.
+ move=> Hn [_ ->|->] <-; by rewrite -!laterN_plus -Hn Nat.add_comm.
+Qed.
+
+Global Instance into_laterN_and_l n P1 P2 Q1 Q2 :
+ IntoLaterN false n P1 Q1 → MaybeIntoLaterN false n P2 Q2 →
+ IntoLaterN false n (P1 ∧ P2) (Q1 ∧ Q2) | 10.
+Proof. rewrite /IntoLaterN /MaybeIntoLaterN=> -> ->. by rewrite laterN_and. Qed.
+Global Instance into_laterN_and_r n P P2 Q2 :
+ IntoLaterN false n P2 Q2 → IntoLaterN false n (P ∧ P2) (P ∧ Q2) | 11.
+Proof.
+ rewrite /IntoLaterN /MaybeIntoLaterN=> ->. by rewrite laterN_and -(laterN_intro _ P).
+Qed.
+
+Global Instance into_laterN_forall {A} n (Φ Ψ : A → PROP) :
+ (∀ x, IntoLaterN false n (Φ x) (Ψ x)) →
+ IntoLaterN false n (∀ x, Φ x) (∀ x, Ψ x).
+Proof. rewrite /IntoLaterN /MaybeIntoLaterN laterN_forall=> ?. by apply forall_mono. Qed.
+Global Instance into_laterN_exist {A} n (Φ Ψ : A → PROP) :
+ (∀ x, IntoLaterN false n (Φ x) (Ψ x)) →
+ IntoLaterN false n (∃ x, Φ x) (∃ x, Ψ x).
+Proof. rewrite /IntoLaterN /MaybeIntoLaterN -laterN_exist_2=> ?. by apply exist_mono. Qed.
+
+Global Instance into_laterN_or_l n P1 P2 Q1 Q2 :
+ IntoLaterN false n P1 Q1 → MaybeIntoLaterN false n P2 Q2 →
+ IntoLaterN false n (P1 ∨ P2) (Q1 ∨ Q2) | 10.
+Proof. rewrite /IntoLaterN /MaybeIntoLaterN=> -> ->. by rewrite laterN_or. Qed.
+Global Instance into_laterN_or_r n P P2 Q2 :
+ IntoLaterN false n P2 Q2 →
+ IntoLaterN false n (P ∨ P2) (P ∨ Q2) | 11.
+Proof.
+ rewrite /IntoLaterN /MaybeIntoLaterN=> ->. by rewrite laterN_or -(laterN_intro _ P).
+Qed.
+
+Global Instance into_later_affinely n P Q :
+ IntoLaterN false n P Q → IntoLaterN false n (<affine> P) (<affine> Q).
+Proof. rewrite /IntoLaterN /MaybeIntoLaterN=> ->. by rewrite laterN_affinely_2. Qed.
+Global Instance into_later_intuitionistically n P Q :
+ IntoLaterN false n P Q → IntoLaterN false n (□ P) (□ Q).
+Proof. rewrite /IntoLaterN /MaybeIntoLaterN=> ->. by rewrite laterN_intuitionistically_2. Qed.
+Global Instance into_later_absorbingly n P Q :
+ IntoLaterN false n P Q → IntoLaterN false n (<absorb> P) (<absorb> Q).
+Proof. rewrite /IntoLaterN /MaybeIntoLaterN=> ->. by rewrite laterN_absorbingly. Qed.
+Global Instance into_later_plainly `{BiPlainly PROP} n P Q :
+ IntoLaterN false n P Q → IntoLaterN false n (■P) (■Q).
+Proof. rewrite /IntoLaterN /MaybeIntoLaterN=> ->. by rewrite laterN_plainly. Qed.
+Global Instance into_later_persistently n P Q :
+ IntoLaterN false n P Q → IntoLaterN false n (<pers> P) (<pers> Q).
+Proof. rewrite /IntoLaterN /MaybeIntoLaterN=> ->. by rewrite laterN_persistently. Qed.
+Global Instance into_later_embed`{SbiEmbed PROP PROP'} n P Q :
+ IntoLaterN false n P Q → IntoLaterN false n ⎡P⎤ ⎡Q⎤.
+Proof. rewrite /IntoLaterN /MaybeIntoLaterN=> ->. by rewrite embed_laterN. Qed.
+
+Global Instance into_laterN_sep_l n P1 P2 Q1 Q2 :
+ IntoLaterN false n P1 Q1 → MaybeIntoLaterN false n P2 Q2 →
+ IntoLaterN false n (P1 ∗ P2) (Q1 ∗ Q2) | 10.
+Proof. rewrite /IntoLaterN /MaybeIntoLaterN=> -> ->. by rewrite laterN_sep. Qed.
+Global Instance into_laterN_sep_r n P P2 Q2 :
+ IntoLaterN false n P2 Q2 →
+ IntoLaterN false n (P ∗ P2) (P ∗ Q2) | 11.
+Proof.
+ rewrite /IntoLaterN /MaybeIntoLaterN=> ->. by rewrite laterN_sep -(laterN_intro _ P).
+Qed.
+
+Global Instance into_laterN_big_sepL n {A} (Φ Ψ : nat → A → PROP) (l: list A) :
+ (∀ x k, IntoLaterN false n (Φ k x) (Ψ k x)) →
+ IntoLaterN false n ([∗ list] k ↦ x ∈ l, Φ k x) ([∗ list] k ↦ x ∈ l, Ψ k x).
+Proof.
+ rewrite /IntoLaterN /MaybeIntoLaterN=> ?.
+ rewrite big_opL_commute. by apply big_sepL_mono.
+Qed.
+Global Instance into_laterN_big_sepL2 n {A B} (Φ Ψ : nat → A → B → PROP) l1 l2 :
+ (∀ x1 x2 k, IntoLaterN false n (Φ k x1 x2) (Ψ k x1 x2)) →
+ IntoLaterN false n ([∗ list] k ↦ y1;y2 ∈ l1;l2, Φ k y1 y2)
+ ([∗ list] k ↦ y1;y2 ∈ l1;l2, Ψ k y1 y2).
+Proof.
+ rewrite /IntoLaterN /MaybeIntoLaterN=> ?.
+ rewrite -big_sepL2_laterN_2. by apply big_sepL2_mono.
+Qed.
+Global Instance into_laterN_big_sepM n `{Countable K} {A}
+ (Φ Ψ : K → A → PROP) (m : gmap K A) :
+ (∀ x k, IntoLaterN false n (Φ k x) (Ψ k x)) →
+ IntoLaterN false n ([∗ map] k ↦ x ∈ m, Φ k x) ([∗ map] k ↦ x ∈ m, Ψ k x).
+Proof.
+ rewrite /IntoLaterN /MaybeIntoLaterN=> ?.
+ rewrite big_opM_commute. by apply big_sepM_mono.
+Qed.
+Global Instance into_laterN_big_sepS n `{Countable A}
+ (Φ Ψ : A → PROP) (X : gset A) :
+ (∀ x, IntoLaterN false n (Φ x) (Ψ x)) →
+ IntoLaterN false n ([∗ set] x ∈ X, Φ x) ([∗ set] x ∈ X, Ψ x).
+Proof.
+ rewrite /IntoLaterN /MaybeIntoLaterN=> ?.
+ rewrite big_opS_commute. by apply big_sepS_mono.
+Qed.
+Global Instance into_laterN_big_sepMS n `{Countable A}
+ (Φ Ψ : A → PROP) (X : gmultiset A) :
+ (∀ x, IntoLaterN false n (Φ x) (Ψ x)) →
+ IntoLaterN false n ([∗ mset] x ∈ X, Φ x) ([∗ mset] x ∈ X, Ψ x).
+Proof.
+ rewrite /IntoLaterN /MaybeIntoLaterN=> ?.
+ rewrite big_opMS_commute. by apply big_sepMS_mono.
+Qed.
+End sbi_instances.
diff --git a/theories/proofmode/classes.v b/theories/proofmode/classes.v
index e7585548f16689c4c83081f4b6d8a0e097aa0d00..b490382401fb15c37c1999a336b993ba1b2193da 100644
--- a/theories/proofmode/classes.v
+++ b/theories/proofmode/classes.v
@@ -1,26 +1,32 @@
-From iris.base_logic Require Export base_logic.
+From iris.bi Require Export bi.
+From iris.proofmode Require Import base.
+From iris.proofmode Require Export modalities.
+From stdpp Require Import namespaces.
Set Default Proof Using "Type".
-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) :=
+Import bi.
+
+Class FromAssumption {PROP : bi} (p : bool) (P Q : PROP) :=
from_assumption : □?p P ⊢ Q.
-Arguments from_assumption {_} _ _ _ {_}.
-(* No need to restrict Hint Mode, we have a default instance that will persistently
-be used in case of evars *)
+Arguments FromAssumption {_} _ _%I _%I : simpl never.
+Arguments from_assumption {_} _ _%I _%I {_}.
Hint Mode FromAssumption + + - - : typeclass_instances.
-Class IntoPure {M} (P : uPred M) (φ : Prop) := into_pure : P ⊢ ⌜φâŒ.
-Arguments into_pure {_} _ _ {_}.
+Class KnownLFromAssumption {PROP : bi} (p : bool) (P Q : PROP) :=
+ knownl_from_assumption :> FromAssumption p P Q.
+Arguments KnownLFromAssumption {_} _ _%I _%I : simpl never.
+Arguments knownl_from_assumption {_} _ _%I _%I {_}.
+Hint Mode KnownLFromAssumption + + ! - : typeclass_instances.
+
+Class KnownRFromAssumption {PROP : bi} (p : bool) (P Q : PROP) :=
+ knownr_from_assumption :> FromAssumption p P Q.
+Arguments KnownRFromAssumption {_} _ _%I _%I : simpl never.
+Arguments knownr_from_assumption {_} _ _%I _%I {_}.
+Hint Mode KnownRFromAssumption + + - ! : typeclass_instances.
+
+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,38 +49,377 @@ 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 {_} _ _ {_}.
-Hint Mode FromPure + ! - : typeclass_instances.
-
-Class FromPureT {M} (P : uPred M) (φ : Type) :=
- from_pureT : ∃ ψ : Prop, φ = ψ ∧ FromPure P ψ.
-Lemma from_pureT_hint {M} (P : uPred M) (φ : Prop) : FromPure P φ → FromPureT P φ.
+(** [FromPure] is used when introducing a pure assertion. It is used
+ by iPure, the "[%]" specialization pattern, and the [with "[%]"]
+ pattern when using [iAssert].
+
+ The [a] Boolean asserts whether we introduce the pure assertion in
+ an affine way or in an absorbing way. When [FromPure true P φ] is
+ derived, then [FromPure false P φ] can always be derived too. We
+ use [true] for specialization patterns and [false] for the
+ [iPureIntro] tactic.
+
+ This Boolean is not needed for [IntoPure], because in the case of
+ [IntoPure], we can have the same behavior by asking that [P] be
+ [Affine]. *)
+Class FromPure {PROP : bi} (a : bool) (P : PROP) (φ : Prop) :=
+ from_pure : <affine>?a ⌜φ⌠⊢ P.
+Arguments FromPure {_} _ _%I _%type_scope : simpl never.
+Arguments from_pure {_} _ _%I _%type_scope {_}.
+Hint Mode FromPure + + ! - : typeclass_instances.
+
+Class FromPureT {PROP : bi} (a : bool) (P : PROP) (φ : Type) :=
+ from_pureT : ∃ ψ : Prop, φ = ψ ∧ FromPure a P ψ.
+Lemma from_pureT_hint {PROP : bi} (a : bool) (P : PROP) (φ : Prop) :
+ FromPure a P φ → FromPureT a P φ.
Proof. by exists φ. Qed.
-Hint Extern 0 (FromPureT _ _) =>
- notypeclasses refine (from_pureT_hint _ _ _) : typeclass_instances.
+Hint Extern 0 (FromPureT _ _ _) =>
+ notypeclasses refine (from_pureT_hint _ _ _ _) : typeclass_instances.
-Class IntoInternalEq {M} {A : ofeT} (P : uPred M) (x y : A) :=
+Class IntoInternalEq {PROP : sbi} {A : ofeT} (P : PROP) (x y : A) :=
into_internal_eq : P ⊢ x ≡ y.
-Arguments into_internal_eq {_ _} _ _ _ {_}.
+Arguments IntoInternalEq {_ _} _%I _%type_scope _%type_scope : simpl never.
+Arguments into_internal_eq {_ _} _%I _%type_scope _%type_scope {_}.
Hint Mode IntoInternalEq + - ! - - : typeclass_instances.
-Class IntoPersistent {M} (p : bool) (P Q : uPred M) :=
- into_persistent : □?p P ⊢ □ Q.
-Arguments into_persistent {_} _ _ _ {_}.
+Class IntoPersistent {PROP : bi} (p : bool) (P Q : PROP) :=
+ into_persistent : <pers>?p P ⊢ <pers> Q.
+Arguments IntoPersistent {_} _ _%I _%I : simpl never.
+Arguments into_persistent {_} _ _%I _%I {_}.
Hint Mode IntoPersistent + + ! - : typeclass_instances.
-Class FromAlways {M} (p : bool) (P Q : uPred M) :=
- from_always : (if p then ■Q else □ Q) ⊢ P.
-Arguments from_always {_} _ _ _ {_}.
-Hint Mode FromAlways + - ! - : typeclass_instances.
+(** The [FromModal M P Q] class is used by the [iModIntro] tactic to transform
+a goal [P] into a modality [M] and proposition [Q].
+
+The inputs are [P] and [sel] and the outputs are [M] and [Q].
+
+The input [sel] can be used to specify which modality to introduce in case there
+are multiple choices to turn [P] into a modality. For example, given [⎡|==> R⎤],
+[sel] can be either [|==> ?e] or [⎡ ?e ⎤], which turn it into an update modality
+or embedding, respectively. In case there is no need to specify the modality to
+introduce, [sel] should be an evar.
+
+For modalities [N] that do not need to augment the proof mode environment, one
+can define an instance [FromModal modality_id (N P) P]. Defining such an
+instance only imposes the proof obligation [P ⊢ N P]. Examples of such
+modalities [N] are [bupd], [fupd], [except_0], [monPred_subjectively] and
+[bi_absorbingly]. *)
+Class FromModal {PROP1 PROP2 : bi} {A}
+ (M : modality PROP1 PROP2) (sel : A) (P : PROP2) (Q : PROP1) :=
+ from_modal : M Q ⊢ P.
+Arguments FromModal {_ _ _} _ _%I _%I _%I : simpl never.
+Arguments from_modal {_ _ _} _ _ _%I _%I {_}.
+Hint Mode FromModal - + - - - ! - : typeclass_instances.
+
+(** The [FromAffinely P Q] class is used to add an [<affine>] modality to the
+proposition [Q].
+
+The input is [Q] and the output is [P]. *)
+Class FromAffinely {PROP : bi} (P Q : PROP) :=
+ from_affinely : <affine> Q ⊢ P.
+Arguments FromAffinely {_} _%I _%I : simpl never.
+Arguments from_affinely {_} _%I _%I {_}.
+Hint Mode FromAffinely + - ! : typeclass_instances.
+
+(** The [IntoAbsorbingly P Q] class is used to add an [<absorb>] modality to
+the proposition [Q].
+
+The input is [Q] and the output is [P]. *)
+Class IntoAbsorbingly {PROP : bi} (P Q : PROP) :=
+ into_absorbingly : P ⊢ <absorb> Q.
+Arguments IntoAbsorbingly {_} _%I _%I.
+Arguments into_absorbingly {_} _%I _%I {_}.
+Hint Mode IntoAbsorbingly + - ! : typeclass_instances.
+
+(*
+Converting an assumption [R] into a wand [P -∗ Q] is done in three stages:
+
+- Strip modalities and universal quantifiers of [R] until an arrow or a wand
+ has been obtained.
+- Balance modalities in the arguments [P] and [Q] to match the goal (which used
+ for [iApply]) or the premise (when used with [iSpecialize] and a specific
+ hypothesis).
+- Instantiate the premise of the wand or implication.
+*)
+
+Class IntoWand {PROP : bi} (p q : bool) (R P Q : PROP) :=
+ into_wand : □?p R ⊢ □?q P -∗ Q.
+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.
+
+Class FromWand {PROP : bi} (P Q1 Q2 : PROP) := from_wand : (Q1 -∗ Q2) ⊢ P.
+Arguments FromWand {_} _%I _%I _%I : simpl never.
+Arguments from_wand {_} _%I _%I _%I {_}.
+Hint Mode FromWand + ! - - : typeclass_instances.
+
+Class FromImpl {PROP : bi} (P Q1 Q2 : PROP) := from_impl : (Q1 → Q2) ⊢ P.
+Arguments FromImpl {_} _%I _%I _%I : simpl never.
+Arguments from_impl {_} _%I _%I _%I {_}.
+Hint Mode FromImpl + ! - - : typeclass_instances.
+
+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.
+
+Class IntoSep {PROP : bi} (P Q1 Q2 : PROP) :=
+ into_sep : P ⊢ Q1 ∗ Q2.
+Arguments IntoSep {_} _%I _%I _%I : simpl never.
+Arguments into_sep {_} _%I _%I _%I {_}.
+Hint Mode IntoSep + ! - - : typeclass_instances.
+
+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 {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 {PROP : bi} {A} (P : PROP) (Φ : A → PROP) :=
+ from_exist : (∃ x, Φ x) ⊢ P.
+Arguments FromExist {_ _} _%I _%I : simpl never.
+Arguments from_exist {_ _} _%I _%I {_}.
+Hint Mode FromExist + - ! - : typeclass_instances.
+
+Class IntoExist {PROP : bi} {A} (P : PROP) (Φ : A → PROP) :=
+ into_exist : P ⊢ ∃ x, Φ x.
+Arguments IntoExist {_ _} _%I _%I : simpl never.
+Arguments into_exist {_ _} _%I _%I {_}.
+Hint Mode IntoExist + - ! - : typeclass_instances.
+
+Class IntoForall {PROP : bi} {A} (P : PROP) (Φ : A → PROP) :=
+ into_forall : P ⊢ ∀ x, Φ x.
+Arguments IntoForall {_ _} _%I _%I : simpl never.
+Arguments into_forall {_ _} _%I _%I {_}.
+Hint Mode IntoForall + - ! - : typeclass_instances.
+
+Class FromForall {PROP : bi} {A} (P : PROP) (Φ : A → PROP) :=
+ from_forall : (∀ x, Φ x) ⊢ P.
+Arguments FromForall {_ _} _%I _%I : simpl never.
+Arguments from_forall {_ _} _%I _%I {_}.
+Hint Mode FromForall + - ! - : typeclass_instances.
+
+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.
+
+(** The [ElimModal φ p p' P P' Q Q'] class is used by the [iMod] tactic.
+
+The inputs are [p], [P] and [Q], and the outputs are [φ], [p'], [P'] and [Q'].
+
+The class is used to transform a hypothesis [P] into a hypothesis [P'], given
+a goal [Q], which is simultaniously transformed into [Q']. The Booleans [p]
+and [p'] indicate whether the original, respectively, updated hypothesis reside
+in the persistent context (iff [true]). The proposition [φ] can be used to
+express a side-condition that [iMod] will generate (if not [True]).
+
+An example instance is:
+
+ ElimModal True p false (|={E1,E2}=> P) P (|={E1,E3}=> Q) (|={E2,E3}=> Q).
+
+This instance expresses that to eliminate [|={E1,E2}=> P] the goal is
+transformed from [|={E1,E3}=> Q] into [|={E2,E3}=> Q], and the resulting
+hypothesis is moved into the spatial context (regardless of where it was
+originally). A corresponding [ElimModal] instance for the Iris 1/2-style update
+modality, would have a side-condition [φ] on the masks. *)
+Class ElimModal {PROP : bi} (φ : Prop) (p p' : bool) (P P' : PROP) (Q Q' : PROP) :=
+ elim_modal : φ → □?p P ∗ (□?p' P' -∗ Q') ⊢ Q.
+Arguments ElimModal {_} _ _ _ _%I _%I _%I _%I : simpl never.
+Arguments elim_modal {_} _ _ _ _%I _%I _%I _%I {_}.
+Hint Mode ElimModal + - ! - ! - ! - : typeclass_instances.
+
+(* Used by the specialization pattern [ > ] in [iSpecialize] and [iAssert] to
+add a modality to the goal corresponding to a premise/asserted proposition. *)
+Class AddModal {PROP : bi} (P P' : PROP) (Q : PROP) :=
+ add_modal : P ∗ (P' -∗ Q) ⊢ Q.
+Arguments AddModal {_} _%I _%I _%I : simpl never.
+Arguments add_modal {_} _%I _%I _%I {_}.
+Hint Mode AddModal + - ! ! : typeclass_instances.
+
+Lemma add_modal_id {PROP : bi} (P Q : PROP) : AddModal P P Q.
+Proof. by rewrite /AddModal wand_elim_r. Qed.
+
+(** We use the classes [IsCons] and [IsApp] to make sure that instances such as
+[frame_big_sepL_cons] and [frame_big_sepL_app] cannot be applied repeatedly
+often when having [ [∗ list] k ↦ x ∈ ?e, Φ k x] with [?e] an evar. *)
+Class IsCons {A} (l : list A) (x : A) (k : list A) := is_cons : l = x :: k.
+Class IsApp {A} (l k1 k2 : list A) := is_app : l = k1 ++ k2.
+Global Hint Mode IsCons + ! - - : typeclass_instances.
+Global Hint Mode IsApp + ! - - : typeclass_instances.
+
+Instance is_cons_cons {A} (x : A) (l : list A) : IsCons (x :: l) x l.
+Proof. done. Qed.
+Instance is_app_app {A} (l1 l2 : list A) : IsApp (l1 ++ l2) l1 l2.
+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.
+
+(* The boolean [progress] indicates whether actual framing has been performed.
+If it is [false], then the default instance [maybe_frame_default] below has been
+used. *)
+Class MaybeFrame {PROP : bi} (p : bool) (R P Q : PROP) (progress : bool) :=
+ 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 true.
+Proof. done. Qed.
+
+Instance maybe_frame_default_persistent {PROP : bi} (R P : PROP) :
+ MaybeFrame true R P P false | 100.
+Proof. intros. rewrite /MaybeFrame /=. by rewrite sep_elim_r. Qed.
+Instance maybe_frame_default {PROP : bi} (R P : PROP) :
+ TCOr (Affine R) (Absorbing P) → MaybeFrame false R P P false | 100.
+Proof. intros. rewrite /MaybeFrame /=. apply: sep_elim_r. Qed.
+
+(* For each of the [MakeXxxx] class, there is a [KnownMakeXxxx]
+ variant, that only succeeds if the parameter(s) is not an evar. In
+ the case the parameter(s) is an evar, then [MakeXxxx] will not
+ instantiate it arbitrarily.
+
+ The reason for this is that if given an evar, these typeclasses
+ would typically try to instantiate this evar with some arbitrary
+ logical constructs such as emp or True. Therefore, we use an Hint
+ Mode to disable all the instances that would have this behavior. *)
+Class MakeEmbed {PROP PROP' : bi} `{BiEmbed PROP PROP'} (P : PROP) (Q : PROP') :=
+ make_embed : ⎡P⎤ ⊣⊢ Q.
+Arguments MakeEmbed {_ _ _} _%I _%I.
+Hint Mode MakeEmbed + + + - - : typeclass_instances.
+Class KnownMakeEmbed {PROP PROP' : bi} `{BiEmbed PROP PROP'} (P : PROP) (Q : PROP') :=
+ known_make_embed :> MakeEmbed P Q.
+Arguments KnownMakeEmbed {_ _ _} _%I _%I.
+Hint Mode KnownMakeEmbed + + + ! - : typeclass_instances.
+
+Class MakeSep {PROP : bi} (P Q PQ : PROP) := make_sep : P ∗ Q ⊣⊢ PQ .
+Arguments MakeSep {_} _%I _%I _%I.
+Hint Mode MakeSep + - - - : typeclass_instances.
+Class KnownLMakeSep {PROP : bi} (P Q PQ : PROP) :=
+ knownl_make_sep :> MakeSep P Q PQ.
+Arguments KnownLMakeSep {_} _%I _%I _%I.
+Hint Mode KnownLMakeSep + ! - - : typeclass_instances.
+Class KnownRMakeSep {PROP : bi} (P Q PQ : PROP) :=
+ knownr_make_sep :> MakeSep P Q PQ.
+Arguments KnownRMakeSep {_} _%I _%I _%I.
+Hint Mode KnownRMakeSep + - ! - : typeclass_instances.
+
+Class MakeAnd {PROP : bi} (P Q PQ : PROP) := make_and_l : P ∧ Q ⊣⊢ PQ.
+Arguments MakeAnd {_} _%I _%I _%I.
+Hint Mode MakeAnd + - - - : typeclass_instances.
+Class KnownLMakeAnd {PROP : bi} (P Q PQ : PROP) :=
+ knownl_make_and :> MakeAnd P Q PQ.
+Arguments KnownLMakeAnd {_} _%I _%I _%I.
+Hint Mode KnownLMakeAnd + ! - - : typeclass_instances.
+Class KnownRMakeAnd {PROP : bi} (P Q PQ : PROP) :=
+ knownr_make_and :> MakeAnd P Q PQ.
+Arguments KnownRMakeAnd {_} _%I _%I _%I.
+Hint Mode KnownRMakeAnd + - ! - : typeclass_instances.
+
+Class MakeOr {PROP : bi} (P Q PQ : PROP) := make_or_l : P ∨ Q ⊣⊢ PQ.
+Arguments MakeOr {_} _%I _%I _%I.
+Hint Mode MakeOr + - - - : typeclass_instances.
+Class KnownLMakeOr {PROP : bi} (P Q PQ : PROP) :=
+ knownl_make_or :> MakeOr P Q PQ.
+Arguments KnownLMakeOr {_} _%I _%I _%I.
+Hint Mode KnownLMakeOr + ! - - : typeclass_instances.
+Class KnownRMakeOr {PROP : bi} (P Q PQ : PROP) := knownr_make_or :> MakeOr P Q PQ.
+Arguments KnownRMakeOr {_} _%I _%I _%I.
+Hint Mode KnownRMakeOr + - ! - : typeclass_instances.
+
+Class MakeAffinely {PROP : bi} (P Q : PROP) :=
+ make_affinely : <affine> P ⊣⊢ Q.
+Arguments MakeAffinely {_} _%I _%I.
+Hint Mode MakeAffinely + - - : typeclass_instances.
+Class KnownMakeAffinely {PROP : bi} (P Q : PROP) :=
+ known_make_affinely :> MakeAffinely P Q.
+Arguments KnownMakeAffinely {_} _%I _%I.
+Hint Mode KnownMakeAffinely + ! - : typeclass_instances.
+
+Class MakeIntuitionistically {PROP : bi} (P Q : PROP) :=
+ make_intuitionistically : □ P ⊣⊢ Q.
+Arguments MakeIntuitionistically {_} _%I _%I.
+Hint Mode MakeIntuitionistically + - - : typeclass_instances.
+Class KnownMakeIntuitionistically {PROP : bi} (P Q : PROP) :=
+ known_make_intuitionistically :> MakeIntuitionistically P Q.
+Arguments KnownMakeIntuitionistically {_} _%I _%I.
+Hint Mode KnownMakeIntuitionistically + ! - : typeclass_instances.
+
+Class MakeAbsorbingly {PROP : bi} (P Q : PROP) :=
+ make_absorbingly : <absorb> P ⊣⊢ Q.
+Arguments MakeAbsorbingly {_} _%I _%I.
+Hint Mode MakeAbsorbingly + - - : typeclass_instances.
+Class KnownMakeAbsorbingly {PROP : bi} (P Q : PROP) :=
+ known_make_absorbingly :> MakeAbsorbingly P Q.
+Arguments KnownMakeAbsorbingly {_} _%I _%I.
+Hint Mode KnownMakeAbsorbingly + ! - : typeclass_instances.
+
+Class MakePersistently {PROP : bi} (P Q : PROP) :=
+ make_persistently : <pers> P ⊣⊢ Q.
+Arguments MakePersistently {_} _%I _%I.
+Hint Mode MakePersistently + - - : typeclass_instances.
+Class KnownMakePersistently {PROP : bi} (P Q : PROP) :=
+ known_make_persistently :> MakePersistently P Q.
+Arguments KnownMakePersistently {_} _%I _%I.
+Hint Mode KnownMakePersistently + ! - : typeclass_instances.
+
+Class MakeLaterN {PROP : sbi} (n : nat) (P lP : PROP) :=
+ make_laterN : ▷^n P ⊣⊢ lP.
+Arguments MakeLaterN {_} _%nat _%I _%I.
+Hint Mode MakeLaterN + + - - : typeclass_instances.
+Class KnownMakeLaterN {PROP : sbi} (n : nat) (P lP : PROP) :=
+ known_make_laterN :> MakeLaterN n P lP.
+Arguments KnownMakeLaterN {_} _%nat _%I _%I.
+Hint Mode KnownMakeLaterN + + ! - : typeclass_instances.
+
+Class MakeExcept0 {PROP : sbi} (P Q : PROP) :=
+ make_except_0 : sbi_except_0 P ⊣⊢ Q.
+Arguments MakeExcept0 {_} _%I _%I.
+Hint Mode MakeExcept0 + - - : typeclass_instances.
+Class KnownMakeExcept0 {PROP : sbi} (P Q : PROP) :=
+ known_make_except_0 :> MakeExcept0 P Q.
+Arguments KnownMakeExcept0 {_} _%I _%I.
+Hint Mode KnownMakeExcept0 + ! - : typeclass_instances.
+
+Class IntoExcept0 {PROP : sbi} (P Q : PROP) := into_except_0 : P ⊢ ◇ Q.
+Arguments IntoExcept0 {_} _%I _%I : simpl never.
+Arguments into_except_0 {_} _%I _%I {_}.
+Hint Mode IntoExcept0 + ! - : typeclass_instances.
+Hint Mode IntoExcept0 + - ! : typeclass_instances.
(* The class [MaybeIntoLaterN] has only two instances:
@@ -110,173 +455,137 @@ Lemma test_iFrame_later_1 P Q : P ∗ ▷ Q -∗ ▷ (P ∗ ▷ Q).
Proof. iIntros "H". iFrame "H". Qed.
>>
*)
-Class MaybeIntoLaterN {M} (only_head : bool) (n : nat) (P Q : uPred M) :=
+Class MaybeIntoLaterN {PROP : sbi} (only_head : bool) (n : nat) (P Q : PROP) :=
maybe_into_laterN : P ⊢ ▷^n Q.
-Arguments maybe_into_laterN {_} _ _ _ _ {_}.
+Arguments MaybeIntoLaterN {_} _ _%nat_scope _%I _%I.
+Arguments maybe_into_laterN {_} _ _%nat_scope _%I _%I {_}.
Hint Mode MaybeIntoLaterN + + + - - : typeclass_instances.
-Class IntoLaterN {M} (only_head : bool) (n : nat) (P Q : uPred M) :=
+Class IntoLaterN {PROP : sbi} (only_head : bool) (n : nat) (P Q : PROP) :=
into_laterN :> MaybeIntoLaterN only_head n P Q.
-Arguments into_laterN {_} _ _ _ {_}.
+Arguments IntoLaterN {_} _ _%nat_scope _%I _%I.
Hint Mode IntoLaterN + + + ! - : typeclass_instances.
-Instance maybe_into_laterN_default {M} only_head n (P : uPred M) :
+Instance maybe_into_laterN_default {PROP : sbi} only_head n (P : PROP) :
MaybeIntoLaterN only_head 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 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 {_} _ _ _ _ {_}.
-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.
+(* In the case both parameters are evars and n=0, we have to stop the
+ search and unify both evars immediately instead of looping using
+ other instances. *)
+Instance maybe_into_laterN_default_0 {PROP : sbi} only_head (P : PROP) :
+ MaybeIntoLaterN only_head 0 P P | 0.
+Proof. apply _. Qed.
+
+(** The class [IntoEmbed P Q] is used to transform hypotheses while introducing
+embeddings using [iModIntro].
+
+Input: the proposition [P], output: the proposition [Q] so that [P ⊢ ⎡Q⎤]. *)
+Class IntoEmbed {PROP PROP' : bi} `{BiEmbed PROP PROP'} (P : PROP') (Q : PROP) :=
+ into_embed : P ⊢ ⎡Q⎤.
+Arguments IntoEmbed {_ _ _} _%I _%I.
+Arguments into_embed {_ _ _} _%I _%I {_}.
+Hint Mode IntoEmbed + + + ! - : typeclass_instances.
+
+(* We use two type classes for [AsEmpValid], in order to avoid loops in
+ typeclass search. Indeed, the [as_emp_valid_embed] instance would try
+ to add an arbitrary number of embeddings. To avoid this, the
+ [AsEmpValid0] type class cannot handle embeddings, and therefore
+ [as_emp_valid_embed] only tries to add one embedding, and we never try
+ to insert nested embeddings. This has the additional advantage of
+ always trying [as_emp_valid_embed] as a second option, so that this
+ instance is never used when the BI is unknown.
+
+ No Hint Modes are declared here. The appropriate one would be
+ [Hint Mode - ! -], but the fact that Coq ignores primitive
+ projections for hints modes would make this fail.*)
+Class AsEmpValid {PROP : bi} (φ : Prop) (P : PROP) :=
+ as_emp_valid : φ ↔ bi_emp_valid P.
+Arguments AsEmpValid {_} _%type _%I.
+Class AsEmpValid0 {PROP : bi} (φ : Prop) (P : PROP) :=
+ as_emp_valid_here : AsEmpValid φ P.
+Arguments AsEmpValid0 {_} _%type _%I.
+Existing Instance as_emp_valid_here | 0.
+
+Lemma as_emp_valid_1 (φ : Prop) {PROP : bi} (P : PROP) `{!AsEmpValid φ P} :
+ φ → bi_emp_valid P.
+Proof. by apply as_emp_valid. Qed.
+Lemma as_emp_valid_2 (φ : Prop) {PROP : bi} (P : PROP) `{!AsEmpValid φ P} :
+ bi_emp_valid P → φ.
+Proof. by apply as_emp_valid. Qed.
+
+(* Input: [P]; Outputs: [N],
+ Extracts the namespace associated with an invariant assertion. Used for [iInv]. *)
+Class IntoInv {PROP : bi} (P: PROP) (N: namespace).
+Arguments IntoInv {_} _%I _.
+Hint Mode IntoInv + ! - : typeclass_instances.
+
+(** Accessors.
+ This definition only exists for the purpose of the proof mode; a truly
+ usable and general form would use telescopes and also allow binders for the
+ closing view shift. [γ] is an [option] to make it easy for ElimAcc
+ instances to recognize the [emp] case and make it look nicer. *)
+Definition accessor {PROP : bi} {X : Type} (M1 M2 : PROP → PROP)
+ (α β : X → PROP) (mγ : X → option PROP) : PROP :=
+ M1 (∃ x, α x ∗ (β x -∗ M2 (default emp (mγ x))))%I.
+
+(* Typeclass for assertions around which accessors can be elliminated.
+ Inputs: [Q], [E1], [E2], [α], [β], [γ]
+ Outputs: [Q']
+
+ Elliminates an accessor [accessor E1 E2 α β γ] in goal [Q'], turning the goal
+ into [Q'] with a new assumption [α x]. *)
+Class ElimAcc {PROP : bi} {X : Type} (M1 M2 : PROP → PROP)
+ (α β : X → PROP) (mγ : X → option PROP)
+ (Q : PROP) (Q' : X → PROP) :=
+ elim_acc : ((∀ x, α x -∗ Q' x) -∗ accessor M1 M2 α β mγ -∗ Q).
+Arguments ElimAcc {_} {_} _%I _%I _%I _%I _%I _%I : simpl never.
+Arguments elim_acc {_} {_} _%I _%I _%I _%I _%I _%I {_}.
+Hint Mode ElimAcc + ! ! ! ! ! ! ! - : typeclass_instances.
+
+(* Turn [P] into an accessor.
+ Inputs:
+ - [Pacc]: the assertion to be turned into an accessor (e.g. an invariant)
+ Outputs:
+ - [Pin]: additional logic assertion needed for starting the accessor.
+ - [φ]: additional Coq assertion needed for starting the accessor.
+ - [X] [α], [β], [γ]: the accessor parameters.
+ - [M1], [M2]: the two accessor modalities (they will typically still have
+ some evars though, e.g. for the masks)
*)
-Class 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.
-
-(* The boolean [progress] indicates whether actual framing has been performed.
-If it is [false], then the default instance [maybe_frame_default] below has been
-used. *)
-Class MaybeFrame {M} (p : bool) (R P Q : uPred M) (progress : bool) :=
- 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 true.
-Proof. done. Qed.
-Instance maybe_frame_default {M} p (R P : uPred M) :
- MaybeFrame p R P P false | 100.
-Proof. apply sep_elim_r. Qed.
-
-Class FromOr {M} (P Q1 Q2 : uPred M) := from_or : Q1 ∨ Q2 ⊢ P.
-Arguments from_or {_} _ _ _ {_}.
-Hint Mode FromOr + ! - - : typeclass_instances.
-
-Class IntoOr {M} (P Q1 Q2 : uPred M) := into_or : P ⊢ Q1 ∨ Q2.
-Arguments into_or {_} _ _ _ {_}.
-Hint Mode IntoOr + ! - - : typeclass_instances.
-
-Class FromExist {M A} (P : uPred M) (Φ : A → uPred M) :=
- from_exist : (∃ x, Φ x) ⊢ P.
-Arguments from_exist {_ _} _ _ {_}.
-Hint Mode FromExist + - ! - : typeclass_instances.
-
-Class IntoExist {M A} (P : uPred M) (Φ : A → uPred M) :=
- into_exist : P ⊢ ∃ x, Φ x.
-Arguments into_exist {_ _} _ _ {_}.
-Hint Mode IntoExist + - ! - : typeclass_instances.
-
-Class IntoForall {M A} (P : uPred M) (Φ : A → uPred M) :=
- into_forall : P ⊢ ∀ x, Φ x.
-Arguments into_forall {_ _} _ _ {_}.
-Hint Mode IntoForall + - ! - : typeclass_instances.
-
-Class FromForall {M A} (P : uPred M) (Φ : A → uPred M) :=
- 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 {_} _ _ {_}.
-Hint Mode FromModal + ! - : typeclass_instances.
-
-Class ElimModal {M} (P P' : uPred M) (Q Q' : uPred M) :=
- elim_modal : P ∗ (P' -∗ Q') ⊢ Q.
-Arguments elim_modal {_} _ _ _ _ {_}.
-Hint Mode ElimModal + ! - ! - : typeclass_instances.
-
-(* Used by the specialization pattern [ > ] in [iSpecialize] and [iAssert] to
-add a modality to the goal corresponding to a premise/asserted proposition. *)
-Class AddModal {M} (P P' : uPred M) (Q : uPred M) :=
- add_modal : P ∗ (P' -∗ Q) ⊢ Q.
-Arguments add_modal {_} _ _ _ {_}.
-Hint Mode AddModal + - ! ! : typeclass_instances.
-
-Lemma add_modal_id {M} (P Q : uPred M) : AddModal P P Q.
-Proof. by rewrite /AddModal 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.
-Global Hint Mode IsApp + ! - - : typeclass_instances.
-
-Instance is_cons_cons {A} (x : A) (l : list A) : IsCons (x :: l) x l.
-Proof. done. Qed.
-Instance is_app_app {A} (l1 l2 : list A) : IsApp (l1 ++ l2) l1 l2.
-Proof. done. Qed.
+Class IntoAcc {PROP : bi} {X : Type} (Pacc : PROP) (φ : Prop) (Pin : PROP)
+ (M1 M2 : PROP → PROP) (α β : X → PROP) (mγ : X → option PROP) :=
+ into_acc : φ → Pacc -∗ Pin -∗ accessor M1 M2 α β mγ.
+Arguments IntoAcc {_} {_} _%I _ _%I _%I _%I _%I _%I _%I : simpl never.
+Arguments into_acc {_} {_} _%I _ _%I _%I _%I _%I _%I _%I {_} : simpl never.
+Hint Mode IntoAcc + - ! - - - - - - - : typeclass_instances.
+
+(* The typeclass used for the [iInv] tactic.
+ Input: [Pinv]
+ Arguments:
+ - [Pinv] is an invariant assertion
+ - [Pin] is an additional logic assertion needed for opening an invariant
+ - [φ] is an additional Coq assertion needed for opening an invariant
+ - [Pout] is the assertion obtained by opening the invariant
+ - [Pclose] is the closing view shift. It must be (Some _) or None
+ when doing typeclass search as instances are allowed to make a
+ case distinction on whether the user wants a closing view-shift or not.
+ - [Q] is a goal on which iInv may be invoked
+ - [Q'] is the transformed goal that must be proved after opening the invariant.
+
+ Most users will never want to instantiate this; there is a general instance
+ based on [ElimAcc] and [IntoAcc]. However, logics like Iris 2 that support
+ invariants but not mask-changing fancy updates can use this class directly to
+ still benefit from [iInv].
+
+ TODO: Add support for a binder (like accessors have it).
+*)
+Class ElimInv {PROP : bi} {X : Type} (φ : Prop)
+ (Pinv Pin : PROP) (Pout : X → PROP) (mPclose : option (X → PROP))
+ (Q : PROP) (Q' : X → PROP) :=
+ elim_inv : φ → Pinv ∗ Pin ∗ (∀ x, Pout x ∗ (default (λ _, emp) mPclose) x -∗ Q' x) ⊢ Q.
+Arguments ElimInv {_} {_} _ _%I _%I _%I _%I _%I _%I : simpl never.
+Arguments elim_inv {_} {_} _ _%I _%I _%I _%I _%I _%I {_}.
+Hint Mode ElimInv + - - ! - - ! ! - : typeclass_instances.
(* 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
@@ -290,34 +599,40 @@ 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]
- [MaybeIntoLaterN] and [FromLaterN] used by [iNext]
- [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) φ :
- FromPure P φ → FromPure (tc_opaque P) φ := id.
-Instance from_laterN_tc_opaque {M} n (P Q : uPred M) :
- 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 from_pure_tc_opaque {PROP : bi} (a : bool) (P : PROP) φ :
+ FromPure a P φ → FromPure a (tc_opaque P) φ := id.
+Instance from_wand_tc_opaque {PROP : bi} (P Q1 Q2 : PROP) :
+ FromWand P Q1 Q2 → FromWand (tc_opaque P) Q1 Q2 := 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) :
- FromModal P Q → FromModal (tc_opaque P) Q := id.
-Instance elim_modal_tc_opaque {M} (P P' Q Q' : uPred M) :
- ElimModal P P' Q Q' → ElimModal (tc_opaque P) P' Q Q' := id.
+Instance from_modal_tc_opaque {PROP1 PROP2 : bi} {A}
+ M (sel : A) (P : PROP2) (Q : PROP1) :
+ FromModal M sel P Q → FromModal M sel (tc_opaque P) Q := id.
+Instance elim_modal_tc_opaque {PROP : bi} φ p p' (P P' Q Q' : PROP) :
+ ElimModal φ p p' P P' Q Q' → ElimModal φ p p' (tc_opaque P) P' Q Q' := id.
+Instance into_inv_tc_opaque {PROP : bi} (P : PROP) N :
+ IntoInv P N → IntoInv (tc_opaque P) N := id.
+Instance elim_inv_tc_opaque {PROP : sbi} {X} φ Pinv Pin Pout Pclose Q Q' :
+ ElimInv (PROP:=PROP) (X:=X) φ Pinv Pin Pout Pclose Q Q' →
+ ElimInv φ (tc_opaque Pinv) Pin Pout Pclose Q Q' := id.
diff --git a/theories/proofmode/coq_tactics.v b/theories/proofmode/coq_tactics.v
index 4cab6ec0ecc5af811e2f352047b0d492a07eb480..c6c962f52bf19ead04d742ae90afeca284d09e62 100644
--- a/theories/proofmode/coq_tactics.v
+++ b/theories/proofmode/coq_tactics.v
@@ -1,207 +1,119 @@
-From iris.base_logic Require Export base_logic.
-From iris.base_logic Require Import big_op tactics.
-From iris.proofmode Require Export base environments classes.
+From iris.bi Require Export bi.
+From iris.bi Require Import tactics.
+From iris.proofmode Require Export base environments classes modality_instances.
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) }.
-Add Printing Constructor envs.
-Arguments Envs {_} _ _.
-Arguments env_persistent {_} _.
-Arguments env_spatial {_} _.
-
-Record envs_wf {M} (Δ : envs M) := {
- 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
-}.
-
-Definition of_envs {M} (Δ : envs M) : uPred M :=
- (⌜envs_wf Δ⌠∗ □ [∗] env_persistent Δ ∗ [∗] env_spatial Δ)%I.
-Instance: Params (@of_envs) 1.
-
-Definition envs_entails {M} (Δ : envs M) (Q : uPred M) : Prop :=
- of_envs Δ ⊢ Q.
-Arguments envs_entails {_} _ _%I.
-Typeclasses Opaque envs_entails.
-Instance: Params (@envs_entails) 1.
-
-Record envs_Forall2 {M} (R : relation (uPred M)) (Δ1 Δ2 : envs M) : 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 ident :=
- env_dom (env_persistent Δ) ++ env_dom (env_spatial Δ).
-
-Definition envs_lookup {M} (i : ident) (Δ : envs M) : option (bool * uPred M) :=
- let (Γp,Γs) := Δ in
- match env_lookup i Γp with
- | Some P => Some (true, P) | None => P ↠env_lookup i Γs; Some (false, P)
- end.
-
-Definition envs_delete {M} (i : ident) (p : bool) (Δ : envs M) : envs M :=
- let (Γp,Γs) := Δ in
- match p with
- | true => Envs (env_delete i Γp) Γs | false => Envs Γp (env_delete i Γs)
- end.
-
-Definition envs_lookup_delete {M} (i : ident)
- (Δ : envs M) : option (bool * uPred M * envs M) :=
- 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 ident) (remove_persistent : bool)
- (Δ : envs M) : option (bool * list (uPred M) * envs M) :=
- match js with
- | [] => Some (true, [], Δ)
- | j :: js =>
- ''(p,P,Δ') ↠envs_lookup_delete j Δ;
- let Δ' := if p : bool then (if remove_persistent then Δ' else Δ) else Δ' in
- ''(q,Hs,Δ'') ↠envs_lookup_delete_list js remove_persistent Δ';
- Some (p && q, P :: Hs, Δ'')
- end.
-
-Definition envs_snoc {M} (Δ : envs M)
- (p : bool) (j : ident) (P : uPred M) : envs M :=
- 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) :=
- 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 : ident) (p : bool) (Γ : env (uPred M))
- (Δ : envs M) : option (envs M) :=
- 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 : ident) (p q : bool) (Γ : env (uPred M))
- (Δ : envs M) : option (envs M) :=
- if Bool.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) :=
- if env_spatial Δ is Enil then true else false.
-
-Definition envs_clear_spatial {M} (Δ : envs M) : envs M :=
- Envs (env_persistent Δ) Enil.
-
-Definition envs_clear_persistent {M} (Δ : envs M) : envs M :=
- Envs Enil (env_spatial Δ).
-
-Fixpoint envs_split_go {M}
- (js : list ident) (Δ1 Δ2 : envs M) : option (envs M * envs M) :=
- match js with
- | [] => Some (Δ1, Δ2)
- | j :: js =>
- ''(p,P,Δ1') ↠envs_lookup_delete j Δ1;
- if p : bool then envs_split_go js Δ1 Δ2 else
- envs_split_go js Δ1' (envs_snoc Δ2 false j P)
- end.
-(* if [d = Right] then [result = (remaining hyps, hyps named js)] and
- if [d = Left] then [result = (hyps named js, remaining hyps)] *)
-Definition envs_split {M} (d : direction)
- (js : list ident) (Δ : envs M) : option (envs M * envs M) :=
- ''(Δ1,Δ2) ↠envs_split_go js Δ (envs_clear_spatial Δ);
- if d is Right 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_intuitionistic Δ ∗ [∗] env_spatial Δ)%I.
Proof. done. Qed.
-
-Lemma envs_lookup_delete_Some Δ Δ' i p P :
- envs_lookup_delete i Δ = Some (p,P,Δ')
- ↔ envs_lookup i Δ = Some (p,P) ∧ Δ' = envs_delete i p Δ.
+(** An environment is a ∗ of something intuitionistic and the spatial environment.
+TODO: Can we define it as such? *)
+Lemma of_envs_eq' Δ :
+ of_envs Δ ⊣⊢ (⌜envs_wf Δ⌠∧ □ [∧] env_intuitionistic Δ) ∗ [∗] env_spatial Δ.
+Proof. rewrite of_envs_eq persistent_and_sep_assoc //. Qed.
+
+Lemma envs_delete_persistent Δ i : envs_delete false i true Δ = Δ.
+Proof. by destruct Δ. Qed.
+Lemma envs_delete_spatial Δ i :
+ envs_delete false i false Δ = envs_delete true i false Δ.
+Proof. by destruct Δ. Qed.
+
+Lemma envs_lookup_delete_Some Δ Δ' rp i p P :
+ envs_lookup_delete rp i Δ = Some (p,P,Δ')
+ ↔ envs_lookup i Δ = Some (p,P) ∧ Δ' = envs_delete rp i p Δ.
Proof.
rewrite /envs_lookup /envs_delete /envs_lookup_delete.
destruct Δ as [Γp Γs]; rewrite /= !env_lookup_delete_correct.
destruct (Γp !! i), (Γs !! i); naive_solver.
Qed.
-Lemma envs_lookup_sound Δ i p P :
+Lemma envs_lookup_sound' Δ rp i p P :
envs_lookup i Δ = Some (p,P) →
- of_envs Δ ⊢ □?p P ∗ of_envs (envs_delete i p Δ).
+ of_envs Δ ⊢ □?p P ∗ of_envs (envs_delete rp 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, rp; constructor;
+ naive_solver eauto using env_delete_wf, env_delete_fresh).
+ destruct rp.
+ + rewrite (env_lookup_perm Γp) //= intuitionistically_and.
+ by rewrite and_sep_intuitionistically -assoc.
+ + rewrite {1}intuitionistically_sep_dup {1}(env_lookup_perm Γp) //=.
+ by rewrite intuitionistically_and and_elim_l -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.
+ 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_sound' Δ i p P :
+Lemma envs_lookup_sound Δ i p P :
envs_lookup i Δ = Some (p,P) →
- of_envs Δ ⊢ P ∗ of_envs (envs_delete i p Δ).
-Proof. intros. rewrite envs_lookup_sound //. by rewrite persistently_if_elim. Qed.
+ of_envs Δ ⊢ □?p P ∗ of_envs (envs_delete true i p Δ).
+Proof. apply envs_lookup_sound'. Qed.
Lemma envs_lookup_persistent_sound Δ i P :
envs_lookup i Δ = Some (true,P) → of_envs Δ ⊢ □ P ∗ of_envs Δ.
+Proof. intros ?%(envs_lookup_sound' _ false). by destruct Δ. Qed.
+Lemma envs_lookup_sound_2 Δ i p P :
+ envs_wf Δ → envs_lookup i Δ = Some (p,P) →
+ □?p P ∗ of_envs (envs_delete true i p Δ) ⊢ of_envs Δ.
Proof.
- intros. apply (persistently_entails_l _ _). by rewrite envs_lookup_sound // sep_elim_l.
+ rewrite /envs_lookup /of_envs=>Hwf ?. rewrite [⌜envs_wf ΔâŒ%I]pure_True // left_id.
+ destruct Δ as [Γp Γs], (Γp !! i) eqn:?; simplify_eq/=.
+ - rewrite (env_lookup_perm Γp) //= intuitionistically_and
+ and_sep_intuitionistically and_elim_r.
+ cancel [â–¡ P]%I. solve_sep_entails.
+ - destruct (Γs !! i) eqn:?; simplify_eq/=.
+ rewrite (env_lookup_perm Γs) //= and_elim_r.
+ cancel [P]. solve_sep_entails.
Qed.
Lemma envs_lookup_split Δ i p P :
envs_lookup i Δ = Some (p,P) → of_envs Δ ⊢ □?p P ∗ (□?p P -∗ of_envs Δ).
Proof.
- rewrite /envs_lookup /of_envs=>?; apply pure_elim_sep_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.
- - 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.
+ intros. apply pure_elim with (envs_wf Δ).
+ { rewrite of_envs_eq. apply and_elim_l. }
+ intros. rewrite {1}envs_lookup_sound//.
+ apply sep_mono_r. apply wand_intro_l, envs_lookup_sound_2; done.
Qed.
-Lemma envs_lookup_delete_sound Δ Δ' i p P :
- envs_lookup_delete i Δ = Some (p,P,Δ') → of_envs Δ ⊢ □?p P ∗ of_envs Δ'.
-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,Δ') → of_envs Δ ⊢ P ∗ of_envs Δ'.
+Lemma envs_lookup_delete_sound Δ Δ' rp i p P :
+ envs_lookup_delete rp i Δ = Some (p,P,Δ') → of_envs Δ ⊢ □?p P ∗ of_envs Δ'.
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,Δ') →
+Lemma envs_lookup_delete_list_sound Δ Δ' rp js p Ps :
+ envs_lookup_delete_list rp js Δ = Some (p,Ps,Δ') →
of_envs Δ ⊢ □?p [∗] Ps ∗ of_envs Δ'.
Proof.
revert Δ Δ' p Ps. induction js as [|j js IH]=> Δ Δ'' p Ps ?; simplify_eq/=.
- { by rewrite persistently_pure left_id. }
- destruct (envs_lookup_delete j Δ) as [[[q1 P] Δ']|] eqn:Hj; simplify_eq/=.
+ { by rewrite intuitionistically_emp left_id. }
+ destruct (envs_lookup_delete rp 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.
- - 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.
+ destruct (envs_lookup_delete_list _ js _) as [[[q2 Ps'] ?]|] eqn:?; simplify_eq/=.
+ rewrite -intuitionistically_if_sep_2 -assoc.
+ rewrite envs_lookup_sound' //; rewrite IH //.
+ repeat apply sep_mono=>//; apply intuitionistically_if_flag_mono; by destruct q1.
Qed.
+Lemma envs_lookup_delete_list_cons Δ Δ' Δ'' rp j js p1 p2 P Ps :
+ envs_lookup_delete rp j Δ = Some (p1, P, Δ') →
+ envs_lookup_delete_list rp js Δ' = Some (p2, Ps, Δ'') →
+ envs_lookup_delete_list rp (j :: js) Δ = Some (p1 && p2, (P :: Ps), Δ'').
+Proof. rewrite //= => -> //= -> //=. Qed.
+
+Lemma envs_lookup_delete_list_nil Δ rp :
+ envs_lookup_delete_list rp [] Δ = Some (true, [], Δ).
+Proof. done. Qed.
+
Lemma envs_lookup_snoc Δ i p P :
envs_lookup i Δ = None → envs_lookup i (envs_snoc Δ p i P) = Some (p, P).
Proof.
@@ -218,83 +130,125 @@ Qed.
Lemma envs_snoc_sound Δ p i P :
envs_lookup i Δ = None → of_envs Δ ⊢ □?p P -∗ of_envs (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 (ident_beq_reflect j i); naive_solver.
- + by rewrite persistently_sep assoc.
- - apply sep_intro_True_l; [apply pure_intro|].
+ + by rewrite intuitionistically_and and_sep_intuitionistically assoc.
+ - apply and_intro; [apply pure_intro|].
+ destruct Hwf; constructor; simpl; eauto using Esnoc_wf.
intros j; destruct (ident_beq_reflect j i); naive_solver.
+ solve_sep_entails.
Qed.
Lemma envs_app_sound Δ Δ' p Γ :
- envs_app p Γ Δ = Some Δ' → of_envs Δ ⊢ □?p [∗] Γ -∗ of_envs Δ'.
+ envs_app p Γ Δ = Some Δ' →
+ of_envs Δ ⊢ (if p then □ [∧] Γ else [∗] Γ) -∗ of_envs Δ'.
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 intuitionistically_and and_sep_intuitionistically.
+ 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.
+ rewrite (env_app_perm _ _ Γs') // big_opL_app. solve_sep_entails.
Qed.
+Lemma envs_app_singleton_sound Δ Δ' p j Q :
+ envs_app p (Esnoc Enil j Q) Δ = Some Δ' → of_envs Δ ⊢ □?p Q -∗ of_envs Δ'.
+Proof. move=> /envs_app_sound. destruct p; by rewrite /= right_id. Qed.
+
Lemma envs_simple_replace_sound' Δ Δ' i p Γ :
envs_simple_replace i p Γ Δ = Some Δ' →
- of_envs (envs_delete i p Δ) ⊢ □?p [∗] Γ -∗ of_envs Δ'.
+ of_envs (envs_delete true i p Δ) ⊢ (if p then □ [∧] Γ else [∗] Γ) -∗ of_envs Δ'.
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 intuitionistically_and and_sep_intuitionistically.
+ 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.
+ rewrite (env_replace_perm _ _ Γs') // big_opL_app. solve_sep_entails.
Qed.
+Lemma envs_simple_replace_singleton_sound' Δ Δ' i p j Q :
+ envs_simple_replace i p (Esnoc Enil j Q) Δ = Some Δ' →
+ of_envs (envs_delete true i p Δ) ⊢ □?p Q -∗ of_envs Δ'.
+Proof. move=> /envs_simple_replace_sound'. destruct p; by rewrite /= right_id. Qed.
+
Lemma envs_simple_replace_sound Δ Δ' i p P Γ :
envs_lookup i Δ = Some (p,P) → envs_simple_replace i p Γ Δ = Some Δ' →
- of_envs Δ ⊢ □?p P ∗ (□?p [∗] Γ -∗ of_envs Δ').
+ of_envs Δ ⊢ □?p P ∗ ((if p then □ [∧] Γ else [∗] Γ) -∗ of_envs Δ').
Proof. intros. by rewrite envs_lookup_sound// envs_simple_replace_sound'//. Qed.
+Lemma envs_simple_replace_maybe_sound Δ Δ' i p P Γ :
+ envs_lookup i Δ = Some (p,P) → envs_simple_replace i p Γ Δ = Some Δ' →
+ of_envs Δ ⊢ □?p P ∗ (((if p then □ [∧] Γ else [∗] Γ) -∗ of_envs Δ') ∧ (□?p P -∗ of_envs Δ)).
+Proof.
+ intros. apply pure_elim with (envs_wf Δ).
+ { rewrite of_envs_eq. apply and_elim_l. }
+ intros. rewrite {1}envs_lookup_sound//. apply sep_mono_r, and_intro.
+ - rewrite envs_simple_replace_sound'//.
+ - apply wand_intro_l, envs_lookup_sound_2; done.
+Qed.
+
+Lemma envs_simple_replace_singleton_sound Δ Δ' i p P j Q :
+ envs_lookup i Δ = Some (p,P) →
+ envs_simple_replace i p (Esnoc Enil j Q) Δ = Some Δ' →
+ of_envs Δ ⊢ □?p P ∗ (□?p Q -∗ of_envs Δ').
+Proof.
+ intros. by rewrite envs_lookup_sound// envs_simple_replace_singleton_sound'//.
+Qed.
+
Lemma envs_replace_sound' Δ Δ' i p q Γ :
envs_replace i p q Γ Δ = Some Δ' →
- of_envs (envs_delete i p Δ) ⊢ □?q [∗] Γ -∗ of_envs Δ'.
+ of_envs (envs_delete true i p Δ) ⊢ (if q then □ [∧] Γ else [∗] Γ) -∗ of_envs Δ'.
Proof.
- rewrite /envs_replace; destruct (Bool.eqb _ _) eqn:Hpq.
+ rewrite /envs_replace; destruct (beq _ _) eqn:Hpq.
- apply eqb_prop in Hpq as ->. apply envs_simple_replace_sound'.
- apply envs_app_sound.
Qed.
+Lemma envs_replace_singleton_sound' Δ Δ' i p q j Q :
+ envs_replace i p q (Esnoc Enil j Q) Δ = Some Δ' →
+ of_envs (envs_delete true i p Δ) ⊢ □?q Q -∗ of_envs Δ'.
+Proof. move=> /envs_replace_sound'. destruct q; by rewrite /= ?right_id. Qed.
+
Lemma envs_replace_sound Δ Δ' i p q P Γ :
envs_lookup i Δ = Some (p,P) → envs_replace i p q Γ Δ = Some Δ' →
- of_envs Δ ⊢ □?p P ∗ (□?q [∗] Γ -∗ of_envs Δ').
+ of_envs Δ ⊢ □?p P ∗ ((if q then □ [∧] Γ else [∗] Γ) -∗ of_envs Δ').
Proof. intros. by rewrite envs_lookup_sound// envs_replace_sound'//. Qed.
+Lemma envs_replace_singleton_sound Δ Δ' i p q P j Q :
+ envs_lookup i Δ = Some (p,P) →
+ envs_replace i p q (Esnoc Enil j Q) Δ = Some Δ' →
+ of_envs Δ ⊢ □?p P ∗ (□?q Q -∗ of_envs Δ').
+Proof. intros. by rewrite envs_lookup_sound// envs_replace_singleton_sound'//. Qed.
+
Lemma envs_lookup_envs_clear_spatial Δ j :
envs_lookup j (envs_clear_spatial Δ)
= ''(p,P) ↠envs_lookup j Δ; if p : bool then Some (p,P) else None.
@@ -307,19 +261,22 @@ Qed.
Lemma envs_clear_spatial_sound Δ :
of_envs Δ ⊢ of_envs (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 (of_envs Δ).
-Proof. intros; destruct Δ as [? []]; simplify_eq/=; apply _. Qed.
-Hint Immediate env_spatial_is_nil_persistent : typeclass_instances.
+Lemma env_spatial_is_nil_intuitionistically Δ :
+ env_spatial_is_nil Δ = true → of_envs Δ ⊢ □ of_envs Δ.
+Proof.
+ intros. unfold of_envs; destruct Δ as [? []]; simplify_eq/=.
+ rewrite !right_id /bi_intuitionistically {1}affinely_and_r persistently_and.
+ by rewrite persistently_affinely_elim persistently_idemp persistently_pure.
+Qed.
Lemma envs_lookup_envs_delete Δ i p P :
envs_wf Δ →
- envs_lookup i Δ = Some (p,P) → envs_lookup i (envs_delete i p Δ) = None.
+ envs_lookup i Δ = Some (p,P) → envs_lookup i (envs_delete true i p Δ) = None.
Proof.
rewrite /envs_lookup /envs_delete=> -[?? Hdisj] Hlookup.
destruct Δ as [Γp Γs], p; simplify_eq/=.
@@ -327,11 +284,11 @@ Proof.
destruct (Hdisj i) as [->| ->]; [|done]. by destruct (Γs !! _).
- rewrite env_lookup_env_delete //. by destruct (Γp !! _).
Qed.
-Lemma envs_lookup_envs_delete_ne Δ i j p :
- i ≠j → envs_lookup i (envs_delete j p Δ) = envs_lookup i Δ.
+Lemma envs_lookup_envs_delete_ne Δ rp i j p :
+ i ≠j → envs_lookup i (envs_delete rp j p Δ) = envs_lookup i Δ.
Proof.
rewrite /envs_lookup /envs_delete=> ?. destruct Δ as [Γp Γs],p; simplify_eq/=.
- - by rewrite env_lookup_env_delete_ne.
+ - destruct rp=> //. by rewrite env_lookup_env_delete_ne.
- destruct (Γp !! i); simplify_eq/=; by rewrite ?env_lookup_env_delete_ne.
Qed.
@@ -340,76 +297,89 @@ Lemma envs_split_go_sound js Δ1 Δ2 Δ1' Δ2' :
envs_split_go js Δ1 Δ2 = Some (Δ1',Δ2') →
of_envs Δ1 ∗ of_envs Δ2 ⊢ of_envs Δ1' ∗ of_envs Δ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.
- destruct (envs_lookup_delete j Δ1)
- as [[[[] P] Δ1'']|] eqn:Hdel; simplify_eq; auto.
+ revert Δ1 Δ2.
+ induction js as [|j js IH]=> Δ1 Δ2 Hlookup HΔ; simplify_eq/=; [done|].
+ 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.
rewrite envs_lookup_sound //; rewrite /= (comm _ P) -assoc.
- rewrite -(IH _ _ _ _ _ HΔ); last first.
- { intros j' P'; destruct (decide (j = j')) as [->|].
- - by rewrite (envs_lookup_envs_delete _ _ _ P).
- - rewrite envs_lookup_envs_delete_ne // envs_lookup_snoc_ne //. eauto. }
+ rewrite -(IH _ _ _ HΔ); last first.
+ { intros j' P'; destruct (decide (j = j')) as [->|].
+ - by rewrite (envs_lookup_envs_delete _ _ _ P).
+ - rewrite envs_lookup_envs_delete_ne // envs_lookup_snoc_ne //. eauto. }
rewrite (envs_snoc_sound Δ2 false j P) /= ?wand_elim_r; eauto.
Qed.
Lemma envs_split_sound Δ d js Δ1 Δ2 :
envs_split d js Δ = Some (Δ1,Δ2) → of_envs Δ ⊢ of_envs Δ1 ∗ of_envs Δ2.
Proof.
- rewrite /envs_split=> ?. rewrite -(idemp uPred_and (of_envs Δ)).
- rewrite {2}envs_clear_spatial_sound sep_elim_l and_sep_r.
+ rewrite /envs_split=> ?. rewrite -(idemp bi_and (of_envs Δ)).
+ rewrite {2}envs_clear_spatial_sound.
+ rewrite (env_spatial_is_nil_intuitionistically (envs_clear_spatial _)) //.
+ rewrite -persistently_and_intuitionistically_sep_l.
+ rewrite (and_elim_l (<pers> _)%I)
+ persistently_and_intuitionistically_sep_r intuitionistically_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 d; simplify_eq/=; solve_sep_entails.
Qed.
-Global Instance envs_Forall2_refl (R : relation (uPred M)) :
+Lemma prop_of_env_sound Γ : prop_of_env Γ ⊣⊢ [∗] Γ.
+Proof.
+ destruct Γ as [|Γ ? P]; simpl; first done.
+ revert P. induction Γ as [|Γ IH ? Q]=>P; simpl.
+ - by rewrite right_id.
+ - rewrite /= IH (comm _ Q _) assoc. done.
+Qed.
+
+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_proper (R : relation (uPred M)) :
- Proper (env_Forall2 R ==> env_Forall2 R ==> envs_Forall2 R) (@Envs M).
+Global Instance Envs_proper (R : relation PROP) :
+ Proper (env_Forall2 R ==> env_Forall2 R ==> eq ==> envs_Forall2 R) (@Envs PROP).
Proof. by constructor. Qed.
Global Instance envs_entails_proper :
- Proper (envs_Forall2 (⊣⊢) ==> (⊣⊢) ==> iff) (@envs_entails M).
-Proof. solve_proper. Qed.
+ Proper (envs_Forall2 (⊣⊢) ==> (⊣⊢) ==> iff) (@envs_entails PROP).
+Proof. rewrite envs_entails_eq. solve_proper. Qed.
Global Instance envs_entails_flip_mono :
- Proper (envs_Forall2 (⊢) ==> flip (⊢) ==> flip impl) (@envs_entails M).
-Proof. rewrite /envs_entails=> Δ1 Δ2 ? P1 P2 <- <-. by f_equiv. Qed.
+ Proper (envs_Forall2 (⊢) ==> flip (⊢) ==> flip impl) (@envs_entails PROP).
+Proof. rewrite envs_entails_eq=> Δ1 Δ2 ? P1 P2 <- <-. by f_equiv. Qed.
(** * Adequacy *)
-Lemma tac_adequate P : envs_entails (Envs Enil Enil) P → P.
+Lemma tac_adequate P : envs_entails (Envs Enil Enil 1) P → P.
Proof.
- rewrite /envs_entails=> <-. rewrite /of_envs /= persistently_pure !right_id.
- apply pure_intro; repeat constructor.
+ rewrite envs_entails_eq /of_envs /= intuitionistically_True_emp
+ left_id=><-.
+ apply and_intro=> //. apply pure_intro; repeat constructor.
Qed.
(** * Basic rules *)
@@ -426,15 +396,41 @@ Lemma tac_eval_in Δ Δ' i p P P' Q :
envs_simple_replace i p (Esnoc Enil i P') Δ = Some Δ' →
envs_entails Δ' Q → envs_entails Δ Q.
Proof.
- rewrite /envs_entails. intros ? HP ? <-.
- rewrite envs_simple_replace_sound //; simpl.
- by rewrite HP right_id wand_elim_r.
+ rewrite envs_entails_eq /=. intros ? HP ? <-.
+ rewrite envs_simple_replace_singleton_sound //; simpl.
+ by rewrite HP wand_elim_r.
Qed.
-Lemma tac_assumption Δ i p P Q :
- envs_lookup i Δ = Some (p,P) → FromAssumption p P Q →
+Class AffineEnv (Γ : env PROP) := affine_env : Forall Affine Γ.
+Global Instance affine_env_nil : AffineEnv Enil.
+Proof. constructor. Qed.
+Global Instance affine_env_snoc Γ i P :
+ Affine P → AffineEnv Γ → AffineEnv (Esnoc Γ i P).
+Proof. by constructor. Qed.
+
+(* If the BI is affine, no need to walk on the whole environment. *)
+Global Instance affine_env_bi `(BiAffine PROP) Γ : AffineEnv Γ | 0.
+Proof. induction Γ; apply _. Qed.
+
+Instance affine_env_spatial Δ :
+ AffineEnv (env_spatial Δ) → Affine ([∗] env_spatial Δ).
+Proof. intros H. induction H; simpl; apply _. Qed.
+
+Lemma tac_emp_intro Δ : AffineEnv (env_spatial Δ) → envs_entails Δ emp.
+Proof. intros. by rewrite envs_entails_eq (affine (of_envs Δ)). Qed.
+
+Lemma tac_assumption Δ Δ' i p P Q :
+ envs_lookup_delete true i Δ = Some (p,P,Δ') →
+ FromAssumption p P Q →
+ (if env_spatial_is_nil Δ' then TCTrue
+ else TCOr (Absorbing Q) (AffineEnv (env_spatial Δ'))) →
envs_entails Δ Q.
-Proof. intros. by rewrite /envs_entails envs_lookup_sound // sep_elim_l. Qed.
+Proof.
+ intros ?? H. rewrite envs_entails_eq envs_lookup_delete_sound //.
+ destruct (env_spatial_is_nil Δ') eqn:?.
+ - by rewrite (env_spatial_is_nil_intuitionistically Δ') // sep_elim_l.
+ - rewrite from_assumption. destruct H; by rewrite sep_elim_l.
+Qed.
Lemma tac_rename Δ Δ' i j p P Q :
envs_lookup i Δ = Some (p,P) →
@@ -442,202 +438,167 @@ Lemma tac_rename Δ Δ' i j p P Q :
envs_entails Δ' Q →
envs_entails Δ Q.
Proof.
- rewrite /envs_entails=> ?? <-. rewrite envs_simple_replace_sound //.
- destruct p; simpl; by rewrite right_id wand_elim_r.
+ rewrite envs_entails_eq=> ?? <-. rewrite envs_simple_replace_singleton_sound //.
+ by rewrite wand_elim_r.
Qed.
+
Lemma tac_clear Δ Δ' i p P Q :
- envs_lookup_delete i Δ = Some (p,P,Δ') →
- envs_entails Δ' Q → envs_entails Δ Q.
+ envs_lookup_delete true i Δ = Some (p,P,Δ') →
+ (if p then TCTrue else TCOr (Affine P) (Absorbing Q)) →
+ envs_entails Δ' Q →
+ envs_entails Δ Q.
Proof.
- rewrite /envs_entails=> ? <-. by rewrite envs_lookup_delete_sound // sep_elim_r.
+ rewrite envs_entails_eq=> ?? HQ. rewrite envs_lookup_delete_sound //.
+ by destruct p; rewrite /= HQ sep_elim_r.
Qed.
(** * False *)
Lemma tac_ex_falso Δ Q : envs_entails Δ False → envs_entails Δ Q.
-Proof. by rewrite /envs_entails -(False_elim Q). Qed.
-
-(** * Pure *)
-Lemma tac_pure_intro Δ Q φ : FromPure Q φ → φ → envs_entails Δ Q.
-Proof. intros ??. rewrite /envs_entails -(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_entails Δ' Q) → envs_entails Δ Q.
-Proof.
- rewrite /envs_entails=> ?? HQ. rewrite envs_lookup_delete_sound' //; simpl.
- rewrite (into_pure P); by apply pure_elim_sep_l.
-Qed.
-
-Lemma tac_pure_revert Δ φ Q : envs_entails Δ (⌜φ⌠→ Q) → (φ → envs_entails Δ Q).
-Proof. rewrite /envs_entails. intros HΔ ?. by rewrite HΔ pure_True // left_id. Qed.
+Proof. by rewrite envs_entails_eq -(False_elim Q). Qed.
-(** * Later *)
-Class MaybeIntoLaterNEnv (n : nat) (Γ1 Γ2 : env (uPred M)) :=
- into_laterN_env : env_Forall2 (MaybeIntoLaterN false n) Γ1 Γ2.
-Class MaybeIntoLaterNEnvs (n : nat) (Δ1 Δ2 : envs M) := {
- into_later_persistent: MaybeIntoLaterNEnv n (env_persistent Δ1) (env_persistent Δ2);
- into_later_spatial: MaybeIntoLaterNEnv n (env_spatial Δ1) (env_spatial Δ2)
-}.
-
-Global Instance into_laterN_env_nil n : MaybeIntoLaterNEnv n Enil Enil.
-Proof. constructor. Qed.
-Global Instance into_laterN_env_snoc n Γ1 Γ2 i P Q :
- MaybeIntoLaterNEnv n Γ1 Γ2 → MaybeIntoLaterN false n P Q →
- MaybeIntoLaterNEnv n (Esnoc Γ1 i P) (Esnoc Γ2 i Q).
-Proof. by constructor. Qed.
-
-Global Instance into_laterN_envs n Γp1 Γp2 Γs1 Γs2 :
- MaybeIntoLaterNEnv n Γp1 Γp2 → MaybeIntoLaterNEnv n Γs1 Γs2 →
- MaybeIntoLaterNEnvs n (Envs Γp1 Γs1) (Envs Γp2 Γs2).
-Proof. by split. Qed.
-
-Lemma into_laterN_env_sound n Δ1 Δ2 :
- MaybeIntoLaterNEnvs n Δ1 Δ2 → of_envs Δ1 ⊢ ▷^n (of_envs Δ2).
-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' → MaybeIntoLaterNEnvs n Δ Δ' →
- envs_entails Δ' Q' → envs_entails Δ Q.
+Lemma tac_false_destruct Δ i p P Q :
+ envs_lookup i Δ = Some (p,P) →
+ P = False%I →
+ envs_entails Δ Q.
Proof.
- rewrite /envs_entails=> ?? HQ.
- by rewrite -(from_laterN n Q) into_laterN_env_sound HQ.
+ rewrite envs_entails_eq => ??. subst. rewrite envs_lookup_sound //; simpl.
+ by rewrite intuitionistically_if_elim sep_elim_l False_elim.
Qed.
-Lemma tac_löb Δ Δ' i Q :
- env_spatial_is_nil Δ = true →
- envs_app true (Esnoc Enil i (▷ Q)%I) Δ = Some Δ' →
- envs_entails Δ' Q → envs_entails Δ Q.
+(** * Pure *)
+(* This relies on the invariant that [FromPure false] implies
+ [FromPure true] *)
+Lemma tac_pure_intro Δ Q φ af :
+ env_spatial_is_nil Δ = af → FromPure af Q φ → φ → envs_entails Δ Q.
Proof.
- rewrite /envs_entails=> ?? 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.
+ intros ???. rewrite envs_entails_eq -(from_pure _ Q). destruct af.
+ - rewrite env_spatial_is_nil_intuitionistically //= /bi_intuitionistically.
+ f_equiv. by apply pure_intro.
+ - by apply pure_intro.
Qed.
-(** * Persistence and plainness modality *)
-Class IntoPlainEnv (Γ1 Γ2 : env (uPred M)) := {
- into_plain_env_subenv : env_subenv Γ2 Γ1;
- into_plain_env_plain : Plain ([∗] Γ2);
-}.
-Class IntoPersistentEnvs (p : bool) (Δ1 Δ2 : envs M) := {
- into_persistent_envs_persistent :
- if p then IntoPlainEnv (env_persistent Δ1) (env_persistent Δ2)
- else env_persistent Δ1 = env_persistent Δ2;
- into_persistent_envs_spatial : env_spatial Δ2 = Enil
-}.
-
-Global Instance into_plain_env_nil : IntoPlainEnv Enil Enil.
-Proof. constructor. constructor. simpl; apply _. Qed.
-Global Instance into_plain_env_snoc_plain Γ1 Γ2 i P :
- Plain P → IntoPlainEnv Γ1 Γ2 →
- IntoPlainEnv (Esnoc Γ1 i P) (Esnoc Γ2 i P) | 1.
-Proof. intros ? [??]; constructor. by constructor. simpl; apply _. Qed.
-Global Instance into_plain_env_snoc_skip Γ1 Γ2 i P :
- IntoPlainEnv Γ1 Γ2 → IntoPlainEnv (Esnoc Γ1 i P) Γ2 | 2.
-Proof. intros [??]; constructor. by constructor. done. Qed.
-
-Global Instance into_persistent_envs_false Γp Γs :
- IntoPersistentEnvs false (Envs Γp Γs) (Envs Γp Enil).
-Proof. by split. Qed.
-Global Instance into_persistent_envs_true Γp1 Γp2 Γs1 :
- IntoPlainEnv Γp1 Γp2 →
- IntoPersistentEnvs true (Envs Γp1 Γs1) (Envs Γp2 Enil).
-Proof. by split. Qed.
-
-Lemma into_persistent_envs_sound (p : bool) Δ1 Δ2 :
- IntoPersistentEnvs p Δ1 Δ2 →
- of_envs Δ1 ⊢ (if p then ■of_envs Δ2 else □ of_envs Δ2).
+Lemma tac_pure Δ Δ' i p P φ Q :
+ envs_lookup_delete true i Δ = Some (p, P, Δ') →
+ IntoPure P φ →
+ (if p then TCTrue else TCOr (Affine P) (Absorbing Q)) →
+ (φ → envs_entails Δ' Q) → envs_entails Δ Q.
Proof.
- rewrite /of_envs. destruct Δ1 as [Γp1 Γs1], Δ2 as [Γp2 Γs2]=> -[/= Hp ->].
- apply pure_elim_sep_l=> Hwf. rewrite sep_elim_l. destruct p; simplify_eq/=.
- - destruct Hp. rewrite right_id plainly_sep plainly_pure.
- apply sep_intro_True_l; [apply pure_intro|].
- + destruct Hwf; constructor; eauto using Enil_wf, env_subenv_wf.
- + rewrite persistently_elim plainly_persistently plainly_plainly.
- by apply big_sepL_submseteq, sublist_submseteq, env_to_list_subenv_proper.
- - rewrite right_id persistently_sep persistently_pure.
- apply sep_intro_True_l; [apply pure_intro|by rewrite persistent_persistently].
- destruct Hwf; constructor; simpl; eauto using Enil_wf.
+ rewrite envs_entails_eq=> ?? HPQ HQ.
+ rewrite envs_lookup_delete_sound //; simpl. destruct p; simpl.
+ - rewrite (into_pure P) -persistently_and_intuitionistically_sep_l persistently_pure.
+ by apply pure_elim_l.
+ - destruct HPQ.
+ + rewrite -(affine_affinely P) (into_pure P) -persistent_and_affinely_sep_l.
+ by apply pure_elim_l.
+ + rewrite (into_pure P) -(persistent_absorbingly_affinely ⌜ _ âŒ%I) absorbingly_sep_lr.
+ rewrite -persistent_and_affinely_sep_l. apply pure_elim_l=> ?. by rewrite HQ.
Qed.
-Lemma tac_always_intro Δ Δ' p Q Q' :
- FromAlways p Q' Q →
- IntoPersistentEnvs p Δ Δ' →
- envs_entails Δ' Q → envs_entails Δ Q'.
-Proof.
- rewrite /envs_entails=> ?? HQ.
- rewrite into_persistent_envs_sound -(from_always _ Q').
- destruct p; auto using persistently_mono, plainly_mono.
-Qed.
+Lemma tac_pure_revert Δ φ Q : envs_entails Δ (⌜φ⌠→ Q) → (φ → envs_entails Δ Q).
+Proof. rewrite envs_entails_eq. intros HΔ ?. by rewrite HΔ pure_True // left_id. Qed.
+(** * Persistence *)
Lemma tac_persistent Δ Δ' i p P P' Q :
envs_lookup i Δ = Some (p, P) →
IntoPersistent p P P' →
+ (if p then TCTrue else TCOr (Affine P) (Absorbing Q)) →
envs_replace i p true (Esnoc Enil i P') Δ = Some Δ' →
envs_entails Δ' Q → envs_entails Δ Q.
Proof.
- rewrite /envs_entails=> ? HP ? <-. rewrite envs_replace_sound //; simpl.
- by rewrite right_id (into_persistent _ P) wand_elim_r.
+ rewrite envs_entails_eq=>?? HPQ ? HQ. rewrite envs_replace_singleton_sound //=.
+ destruct p; simpl; rewrite /bi_intuitionistically.
+ - by rewrite -(into_persistent _ P) /= wand_elim_r.
+ - destruct HPQ.
+ + rewrite -(affine_affinely P) (_ : P = <pers>?false P)%I //
+ (into_persistent _ P) wand_elim_r //.
+ + rewrite (_ : P = <pers>?false P)%I // (into_persistent _ P).
+ by rewrite -{1}absorbingly_intuitionistically_into_persistently
+ absorbingly_sep_l wand_elim_r HQ.
Qed.
(** * Implication and wand *)
-Lemma tac_impl_intro Δ Δ' i P Q :
+Lemma tac_impl_intro Δ Δ' i P P' Q R :
+ FromImpl R P Q →
(if env_spatial_is_nil Δ then TCTrue else Persistent P) →
- envs_app false (Esnoc Enil i P) Δ = Some Δ' →
- envs_entails Δ' Q → envs_entails Δ (P → Q).
-Proof.
- rewrite /envs_entails=> ?? <-. destruct (env_spatial_is_nil Δ) eqn:?.
- - rewrite (persistent (of_envs Δ)) envs_app_sound //; simpl.
- by rewrite right_id -persistently_impl_wand persistently_elim.
- - apply impl_intro_l. rewrite envs_app_sound //; simpl.
- by rewrite and_sep_l right_id wand_elim_r.
-Qed.
-Lemma tac_impl_intro_persistent Δ Δ' i P P' Q :
+ envs_app false (Esnoc Enil i P') Δ = Some Δ' →
+ FromAffinely P' P →
+ envs_entails Δ' Q → envs_entails Δ R.
+Proof.
+ rewrite /FromImpl envs_entails_eq => <- ??? <-. destruct (env_spatial_is_nil Δ) eqn:?.
+ - rewrite (env_spatial_is_nil_intuitionistically Δ) //; simpl. apply impl_intro_l.
+ rewrite envs_app_singleton_sound //; simpl.
+ rewrite -(from_affinely P') -affinely_and_lr.
+ by rewrite persistently_and_intuitionistically_sep_r intuitionistically_elim wand_elim_r.
+ - apply impl_intro_l. rewrite envs_app_singleton_sound //; simpl.
+ by rewrite -(from_affinely P') persistent_and_affinely_sep_l_1 wand_elim_r.
+Qed.
+Lemma tac_impl_intro_persistent Δ Δ' i P P' Q R :
+ FromImpl R P Q →
IntoPersistent false P P' →
envs_app true (Esnoc Enil i P') Δ = Some Δ' →
- envs_entails Δ' Q → envs_entails Δ (P → Q).
+ envs_entails Δ' Q → envs_entails Δ R.
Proof.
- rewrite /envs_entails=> ?? 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.
+ rewrite /FromImpl envs_entails_eq => <- ?? <-.
+ rewrite envs_app_singleton_sound //=. apply impl_intro_l.
+ rewrite (_ : P = <pers>?false P)%I // (into_persistent false P).
+ by rewrite persistently_and_intuitionistically_sep_l wand_elim_r.
+Qed.
+Lemma tac_impl_intro_drop Δ P Q R :
+ FromImpl R P Q → envs_entails Δ Q → envs_entails Δ R.
+Proof.
+ rewrite /FromImpl envs_entails_eq => <- ?. apply impl_intro_l. by rewrite and_elim_r.
Qed.
-Lemma tac_impl_intro_drop Δ P Q : envs_entails Δ Q → envs_entails Δ (P → Q).
-Proof. rewrite /envs_entails=> ?. apply impl_intro_l. by rewrite and_elim_r. Qed.
-
-Lemma tac_wand_intro Δ Δ' i P Q :
+Lemma tac_wand_intro Δ Δ' i P Q R :
+ FromWand R P Q →
envs_app false (Esnoc Enil i P) Δ = Some Δ' →
- envs_entails Δ' Q → envs_entails Δ (P -∗ Q).
+ envs_entails Δ' Q → envs_entails Δ R.
Proof.
- rewrite /envs_entails=> ? HQ.
+ rewrite /FromWand envs_entails_eq => <- ? HQ.
rewrite envs_app_sound //; simpl. by rewrite right_id HQ.
Qed.
-Lemma tac_wand_intro_persistent Δ Δ' i P P' Q :
+Lemma tac_wand_intro_persistent Δ Δ' i P P' Q R :
+ FromWand R P Q →
IntoPersistent false P P' →
+ TCOr (Affine P) (Absorbing Q) →
envs_app true (Esnoc Enil i P') Δ = Some Δ' →
- envs_entails Δ' Q → envs_entails Δ (P -∗ Q).
+ envs_entails Δ' Q → envs_entails Δ R.
+Proof.
+ rewrite /FromWand envs_entails_eq => <- ? HPQ ? HQ.
+ rewrite envs_app_singleton_sound //=. apply wand_intro_l. destruct HPQ.
+ - rewrite -(affine_affinely P) (_ : P = <pers>?false P)%I //
+ (into_persistent _ P) wand_elim_r //.
+ - rewrite (_ : P = <pers>?false P)%I // (into_persistent _ P).
+ by rewrite -{1}absorbingly_intuitionistically_into_persistently
+ absorbingly_sep_l wand_elim_r HQ.
+Qed.
+Lemma tac_wand_intro_pure Δ P φ Q R :
+ FromWand R P Q →
+ IntoPure P φ →
+ TCOr (Affine P) (Absorbing Q) →
+ (φ → envs_entails Δ Q) → envs_entails Δ R.
Proof.
- rewrite /envs_entails => ?? <-. rewrite envs_app_sound //; simpl.
- rewrite right_id. by apply wand_mono.
+ rewrite /FromWand envs_entails_eq. intros <- ? HPQ HQ. apply wand_intro_l. destruct HPQ.
+ - rewrite -(affine_affinely P) (into_pure P) -persistent_and_affinely_sep_l.
+ by apply pure_elim_l.
+ - rewrite (into_pure P) -(persistent_absorbingly_affinely ⌜ _ âŒ%I) absorbingly_sep_lr.
+ rewrite -persistent_and_affinely_sep_l. apply pure_elim_l=> ?. by rewrite HQ.
+Qed.
+Lemma tac_wand_intro_drop Δ P Q R :
+ FromWand R P Q →
+ TCOr (Affine P) (Absorbing Q) →
+ envs_entails Δ Q →
+ envs_entails Δ R.
+Proof.
+ rewrite envs_entails_eq /FromWand => <- HPQ ->. apply wand_intro_l. by rewrite sep_elim_r.
Qed.
-Lemma tac_wand_intro_drop Δ P Q : envs_entails Δ Q → envs_entails Δ (P -∗ Q).
-Proof. rewrite /envs_entails=> <-. 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 →
+ envs_lookup_delete false i Δ = Some (p, P1, Δ') →
+ envs_lookup j Δ' = Some (q, R) →
+ 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) Δ'
@@ -645,151 +606,153 @@ Lemma tac_specialize Δ Δ' Δ'' i p j q P1 P2 R Q :
end = Some Δ'' →
envs_entails Δ'' Q → envs_entails Δ Q.
Proof.
- rewrite /envs_entails. 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 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.
+ rewrite envs_entails_eq. intros [? ->]%envs_lookup_delete_Some Hj ? Hj' <-.
+ rewrite (envs_lookup_sound' _ false) //; simpl. destruct p; simpl.
+ - move: Hj; rewrite envs_delete_persistent=> Hj.
+ rewrite envs_simple_replace_singleton_sound //; simpl.
+ rewrite -intuitionistically_if_idemp -intuitionistically_idemp into_wand /=.
+ rewrite assoc (intuitionistically_intuitionistically_if q).
+ by rewrite intuitionistically_if_sep_2 wand_elim_r wand_elim_r.
+ - move: Hj Hj'; rewrite envs_delete_spatial=> Hj Hj'.
+ rewrite envs_lookup_sound // (envs_replace_singleton_sound' _ Δ'') //; simpl.
+ by rewrite into_wand /= assoc wand_elim_r wand_elim_r.
Qed.
Lemma tac_specialize_assert Δ Δ' Δ1 Δ2' j q neg js R P1 P2 P1' Q :
- envs_lookup_delete j Δ = Some (q, R, Δ') →
- IntoWand false R P1 P2 → AddModal P1' P1 Q →
+ envs_lookup_delete true j Δ = Some (q, R, Δ') →
+ IntoWand q false R P1 P2 → AddModal P1' P1 Q →
(''(Δ1,Δ2) ↠envs_split (if neg is true then Right else Left) js Δ';
Δ2' ↠envs_app false (Esnoc Enil j P2) Δ2;
Some (Δ1,Δ2')) = Some (Δ1,Δ2') → (* does not preserve position of [j] *)
envs_entails Δ1 P1' → envs_entails Δ2' Q → envs_entails Δ Q.
Proof.
- rewrite /envs_entails. intros [? ->]%envs_lookup_delete_Some ??? HP1 HQ.
+ rewrite envs_entails_eq. intros [? ->]%envs_lookup_delete_Some ??? HP1 HQ.
destruct (envs_split _ _ _) as [[? Δ2]|] eqn:?; simplify_eq/=;
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 -(add_modal P1' P1 Q). apply sep_mono_r, wand_intro_l.
- by rewrite persistently_if_elim assoc !wand_elim_r.
+ rewrite (envs_app_singleton_sound Δ2) //; simpl.
+ rewrite HP1 into_wand /= -(add_modal P1' P1 Q). cancel [P1'].
+ apply wand_intro_l. by rewrite assoc !wand_elim_r.
Qed.
+Lemma tac_unlock_emp Δ Q : envs_entails Δ Q → envs_entails Δ (emp ∗ locked Q).
+Proof. rewrite envs_entails_eq=> ->. by rewrite -lock left_id. Qed.
+Lemma tac_unlock_True Δ Q : envs_entails Δ Q → envs_entails Δ (True ∗ locked Q).
+Proof. rewrite envs_entails_eq=> ->. by rewrite -lock -True_sep_2. Qed.
Lemma tac_unlock Δ Q : envs_entails Δ Q → envs_entails Δ (locked Q).
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 →
+ envs_lookup_delete true j Δ = Some (q, R, Δ') →
+ IntoWand q false R P1 P2 →
AddModal P1' P1 Q →
envs_entails Δ' (P1' ∗ locked Q') →
Q' = (P2 -∗ Q)%I →
envs_entails Δ Q.
Proof.
- rewrite /envs_entails. intros [? ->]%envs_lookup_delete_Some ?? HPQ ->.
+ rewrite envs_entails_eq. 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}(add_modal P1' P1 Q). apply sep_mono_r, wand_intro_l.
- by rewrite assoc !wand_elim_r.
+ rewrite into_wand -{2}(add_modal P1' P1 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 true P1 φ →
envs_simple_replace j q (Esnoc Enil j P2) Δ = Some Δ' →
φ → envs_entails Δ' Q → envs_entails Δ Q.
Proof.
- rewrite /envs_entails=> ????? <-. 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 envs_entails_eq=> ????? <-. rewrite envs_simple_replace_singleton_sound //=.
+ rewrite -intuitionistically_if_idemp into_wand /= -(from_pure _ P1) /bi_intuitionistically.
+ rewrite pure_True //= persistently_affinely_elim persistently_pure
+ affinely_True_emp affinely_emp.
+ by rewrite emp_wand 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 →
+Lemma tac_specialize_assert_persistent Δ Δ' Δ'' j q P1 P1' P2 R Q :
+ envs_lookup_delete true j Δ = Some (q, R, Δ') →
+ IntoWand q true R P1 P2 →
+ Persistent P1 →
+ IntoAbsorbingly P1' P1 →
envs_simple_replace j q (Esnoc Enil j P2) Δ = Some Δ'' →
- envs_entails Δ' P1 → envs_entails Δ'' Q → envs_entails Δ Q.
+ envs_entails Δ' P1' → envs_entails Δ'' Q → envs_entails Δ Q.
Proof.
- rewrite /envs_entails. intros [? ->]%envs_lookup_delete_Some ??? HP1 <-.
+ rewrite envs_entails_eq => /envs_lookup_delete_Some [? ->] ???? HP1 <-.
rewrite envs_lookup_sound //.
- rewrite -(idemp uPred_and (of_envs (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 (of_envs (envs_delete _ _ _ _))).
+ rewrite {2}envs_simple_replace_singleton_sound' //; simpl.
+ rewrite {1}HP1 (into_absorbingly P1') (persistent_persistently_2 P1).
+ rewrite absorbingly_elim_persistently persistently_and_intuitionistically_sep_l assoc.
+ rewrite -intuitionistically_if_idemp -intuitionistically_idemp.
+ rewrite (intuitionistically_intuitionistically_if q).
+ by rewrite intuitionistically_if_sep_2 into_wand wand_elim_l 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) →
- envs_entails Δ R → Persistent R →
- envs_replace j q true (Esnoc Enil j R) Δ = Some Δ' →
- envs_entails Δ' Q → envs_entails Δ Q.
+ envs_entails Δ (<absorb> R) →
+ IntoPersistent false R R' →
+ (if q then TCTrue else BiAffine PROP) →
+ envs_replace j q true (Esnoc Enil j R') Δ = Some Δ'' →
+ envs_entails Δ'' Q → envs_entails Δ Q.
+Proof.
+ rewrite envs_entails_eq => ? HR ? Hpos ? <-. rewrite -(idemp bi_and (of_envs Δ)) {1}HR.
+ rewrite envs_replace_singleton_sound //; destruct q; simpl.
+ - by rewrite (_ : R = <pers>?false R)%I // (into_persistent _ R)
+ absorbingly_elim_persistently sep_elim_r persistently_and_intuitionistically_sep_l wand_elim_r.
+ - by rewrite (absorbing_absorbingly R) (_ : R = <pers>?false R)%I //
+ (into_persistent _ R) sep_elim_r persistently_and_intuitionistically_sep_l wand_elim_r.
+Qed.
+
+(* A special version of [tac_assumption] that does not do any of the
+[FromAssumption] magic. *)
+Lemma tac_specialize_persistent_helper_done Δ i q P :
+ envs_lookup i Δ = Some (q,P) →
+ envs_entails Δ (<absorb> P).
Proof.
- rewrite /envs_entails. intros ? HR ?? <-.
- rewrite -(idemp uPred_and (of_envs Δ)) {1}HR and_sep_l.
- rewrite envs_replace_sound //; simpl.
- by rewrite right_id assoc (sep_elim_l R) persistent_persistently wand_elim_r.
+ rewrite envs_entails_eq /bi_absorbingly=> /envs_lookup_sound=> ->.
+ rewrite intuitionistically_if_elim comm. f_equiv; auto using pure_intro.
Qed.
Lemma tac_revert Δ Δ' i p P Q :
- envs_lookup_delete i Δ = Some (p,P,Δ') →
+ envs_lookup_delete true i Δ = Some (p,P,Δ') →
envs_entails Δ' ((if p then □ P else P)%I -∗ Q) →
envs_entails Δ Q.
Proof.
- rewrite /envs_entails=> ? HQ. rewrite envs_lookup_delete_sound //; simpl.
- by rewrite HQ /uPred_persistently_if wand_elim_r.
+ rewrite envs_entails_eq => ? HQ. rewrite envs_lookup_delete_sound //=.
+ rewrite HQ. destruct p; simpl; auto using wand_elim_r.
Qed.
-Class IntoIH (φ : Prop) (Δ : envs M) (Q : uPred M) :=
+Class IntoIH (φ : Prop) (Δ : envs PROP) (Q : PROP) :=
into_ih : φ → of_envs Δ ⊢ Q.
Global Instance into_ih_entails Δ Q : IntoIH (envs_entails Δ Q) Δ Q.
-Proof. by rewrite /IntoIH. Qed.
+Proof. by rewrite envs_entails_eq /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φ : φ) :
IntoIH φ Δ P →
env_spatial_is_nil Δ = true →
- envs_entails Δ (□ P → Q) →
+ envs_entails Δ (<pers> P → Q) →
envs_entails Δ Q.
Proof.
- rewrite /envs_entails /IntoIH=> HP ? HPQ.
- rewrite -(idemp uPred_and (of_envs Δ)) {1}(persistent (of_envs Δ)).
- by rewrite {1}HP // HPQ impl_elim_r.
-Qed.
-
-Lemma tac_assert Δ Δ1 Δ2 Δ2' neg js j P P' Q :
- AddModal P' P Q →
- envs_split (if neg is true then Right else Left) js Δ = Some (Δ1,Δ2) →
- envs_app false (Esnoc Enil j P) Δ2 = Some Δ2' →
- envs_entails Δ1 P' → envs_entails Δ2' Q → envs_entails Δ Q.
-Proof.
- rewrite /envs_entails=> ??? HP HQ. rewrite envs_split_sound //.
- rewrite (envs_app_sound Δ2) //; simpl.
- by rewrite right_id HP HQ.
-Qed.
-
-Lemma tac_assert_persistent Δ Δ1 Δ2 Δ' neg js j P Q :
- envs_split (if neg is true then Right else Left) js Δ = Some (Δ1,Δ2) →
- envs_app false (Esnoc Enil j P) Δ = Some Δ' →
- Persistent P →
- envs_entails Δ1 P → envs_entails Δ' Q → envs_entails Δ Q.
-Proof.
- rewrite /envs_entails=> ??? HP <-.
- rewrite -(idemp uPred_and (of_envs Δ)) {1}envs_split_sound //.
- rewrite HP sep_elim_l (and_sep_l P) envs_app_sound //; simpl.
- by rewrite right_id wand_elim_r.
+ rewrite /IntoIH envs_entails_eq. intros HP ? HPQ.
+ rewrite (env_spatial_is_nil_intuitionistically Δ) //.
+ rewrite -(idemp bi_and (□ (of_envs Δ))%I) {1}HP // HPQ.
+ rewrite {1}intuitionistically_into_persistently_1 intuitionistically_elim impl_elim_r //.
Qed.
-Lemma tac_assert_pure Δ Δ' j P φ Q :
- envs_app false (Esnoc Enil j P) Δ = Some Δ' →
- FromPure P φ →
- φ → envs_entails Δ' Q → envs_entails Δ Q.
+Lemma tac_assert Δ Δ' j P Q :
+ envs_app true (Esnoc Enil j (P -∗ P)%I) Δ = Some Δ' →
+ envs_entails Δ' Q → envs_entails Δ Q.
Proof.
- rewrite /envs_entails=> ??? <-. rewrite envs_app_sound //; simpl.
- by rewrite right_id -(from_pure P) pure_True // -impl_wand True_impl.
+ rewrite envs_entails_eq=> ? <-. rewrite (envs_app_singleton_sound Δ) //; simpl.
+ by rewrite -(entails_wand P) // intuitionistically_emp emp_wand.
Qed.
Lemma tac_pose_proof Δ Δ' j P Q :
@@ -797,163 +760,135 @@ Lemma tac_pose_proof Δ Δ' j P Q :
envs_app true (Esnoc Enil j P) Δ = Some Δ' →
envs_entails Δ' Q → envs_entails Δ Q.
Proof.
- rewrite /envs_entails=> HP ? <-. rewrite envs_app_sound //; simpl.
- by rewrite right_id -HP persistently_pure wand_True.
+ rewrite envs_entails_eq => HP ? <-. rewrite envs_app_singleton_sound //=.
+ by rewrite -HP /= intuitionistically_emp emp_wand.
Qed.
Lemma tac_pose_proof_hyp Δ Δ' Δ'' i p j P Q :
- envs_lookup_delete i Δ = Some (p, P, Δ') →
- envs_app p (Esnoc Enil j P) (if p then Δ else Δ') = Some Δ'' →
+ envs_lookup_delete false i Δ = Some (p, P, Δ') →
+ envs_app p (Esnoc Enil j P) Δ' = Some Δ'' →
envs_entails Δ'' Q → envs_entails Δ Q.
Proof.
- rewrite /envs_entails. intros [? ->]%envs_lookup_delete_Some ? <-. destruct p.
- - rewrite envs_lookup_persistent_sound // envs_app_sound //; simpl.
- by rewrite right_id wand_elim_r.
- - rewrite envs_lookup_sound // envs_app_sound //; simpl.
- by rewrite right_id wand_elim_r.
+ rewrite envs_entails_eq. intros [? ->]%envs_lookup_delete_Some ? <-.
+ rewrite envs_lookup_sound' // envs_app_singleton_sound //=.
+ by rewrite wand_elim_r.
Qed.
Lemma tac_apply Δ Δ' i p R P1 P2 :
- envs_lookup_delete i Δ = Some (p, R, Δ') → IntoWand false R P1 P2 →
+ envs_lookup_delete true i Δ = Some (p, R, Δ') →
+ IntoWand p false R P1 P2 →
envs_entails Δ' P1 → envs_entails Δ P2.
Proof.
- rewrite /envs_entails=> ?? HP1. rewrite envs_lookup_delete_sound' //.
- by rewrite (into_wand _ R) HP1 wand_elim_l.
-Qed.
-
-(** * Rewriting *)
-Lemma tac_rewrite Δ i p Pxy d Q :
- envs_lookup i Δ = Some (p, Pxy) →
- ∀ {A : ofeT} (x y : A) (Φ : A → uPred M),
- IntoInternalEq Pxy x y →
- (Q ⊣⊢ Φ (if d is Left then y else x)) →
- NonExpansive Φ →
- envs_entails Δ (Φ (if d is Left then x else y)) →
- envs_entails Δ Q.
-Proof.
- rewrite /envs_entails=> ? A x y Φ HPxy -> ? HΔ.
- rewrite -(idemp (∧)%I (of_envs Δ)) {1}envs_lookup_sound' //.
- rewrite sep_elim_l HPxy HΔ. apply impl_elim_l'. destruct d.
- - by apply internal_eq_rewrite.
- - rewrite internal_eq_sym. by apply internal_eq_rewrite.
-Qed.
-
-Lemma tac_rewrite_in Δ i p Pxy j q P d Q :
- envs_lookup i Δ = Some (p, Pxy) →
- envs_lookup j Δ = Some (q, P) →
- ∀ {A : ofeT} Δ' x y (Φ : A → uPred M),
- IntoInternalEq Pxy x y →
- (P ⊣⊢ Φ (if d is Left then y else x)) →
- NonExpansive Φ →
- envs_simple_replace j q (Esnoc Enil j (Φ (if d is Left then x else y))) Δ = Some Δ' →
- envs_entails Δ' Q →
- envs_entails Δ Q.
-Proof.
- rewrite /envs_entails=> ?? A Δ' x y Φ HPxy HP ?? <-.
- rewrite -(idemp uPred_and (of_envs Δ)) {2}(envs_lookup_sound' _ i) //.
- rewrite sep_elim_l HPxy and_sep_r.
- rewrite (envs_simple_replace_sound _ _ j) //; simpl.
- rewrite HP right_id -assoc (sep_and _ (_ ≡ _)).
- apply wand_elim_r', impl_elim_r'. destruct d.
- - apply (internal_eq_rewrite _ _ (λ y, □?q Φ y -∗ _)%I). solve_proper.
- - rewrite internal_eq_sym.
- apply (internal_eq_rewrite _ _ (λ y, □?q Φ y -∗ _)%I). solve_proper.
+ rewrite envs_entails_eq => ?? HP1. rewrite envs_lookup_delete_sound //.
+ by rewrite into_wand /= HP1 wand_elim_l.
Qed.
(** * Conjunction splitting *)
Lemma tac_and_split Δ P Q1 Q2 :
- FromAnd true P Q1 Q2 →
- envs_entails Δ Q1 → envs_entails Δ Q2 → envs_entails Δ P.
-Proof.
- rewrite /envs_entails=> ???. rewrite -(from_and true P). by apply and_intro.
-Qed.
+ FromAnd P Q1 Q2 → envs_entails Δ Q1 → envs_entails Δ Q2 → envs_entails Δ P.
+Proof. rewrite envs_entails_eq. intros. rewrite -(from_and P). by apply and_intro. Qed.
(** * Separating conjunction splitting *)
Lemma tac_sep_split Δ Δ1 Δ2 d js P Q1 Q2 :
- FromAnd false P Q1 Q2 →
+ FromSep P Q1 Q2 →
envs_split d js Δ = Some (Δ1,Δ2) →
envs_entails Δ1 Q1 → envs_entails Δ2 Q2 → envs_entails Δ P.
Proof.
- rewrite /envs_entails=> ????.
- rewrite envs_split_sound // -(from_and false P). by apply sep_mono.
+ rewrite envs_entails_eq=>?? 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) →
+ envs_lookup_delete_list false js Δ1 = Some (p, Ps, Δ2) →
FromSeps P Ps →
envs_app p (Esnoc Enil j P) Δ2 = Some Δ3 →
envs_entails Δ3 Q → envs_entails Δ1 Q.
Proof.
- rewrite /envs_entails=> ??? <-. rewrite envs_lookup_delete_list_sound //.
- rewrite from_seps. rewrite envs_app_sound //; simpl.
- by rewrite right_id wand_elim_r.
+ rewrite envs_entails_eq => ??? <-. rewrite envs_lookup_delete_list_sound //.
+ rewrite from_seps. rewrite envs_app_singleton_sound //=.
+ by rewrite wand_elim_r.
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) →
+ (if p then IntoAnd true P P1 P2 else IntoSep P P1 P2) →
envs_simple_replace i p (Esnoc (Esnoc Enil j1 P1) j2 P2) Δ = Some Δ' →
envs_entails Δ' Q → envs_entails Δ Q.
Proof.
- rewrite /envs_entails=> ??? <-.
- 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.
+ rewrite envs_entails_eq. intros. rewrite envs_simple_replace_sound //=. destruct p.
+ - by rewrite (into_and _ P) /= right_id -(comm _ P1) wand_elim_r.
+ - 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 d j P P1 P2 Q :
- envs_lookup i Δ = Some (p, P) → IntoAnd true P P1 P2 →
+ envs_lookup i Δ = Some (p, P) →
+ (if p then IntoAnd p P P1 P2 : Type else
+ TCOr (IntoAnd p P P1 P2) (TCAnd (IntoSep P P1 P2)
+ (if d is Left then TCOr (Affine P2) (Absorbing Q)
+ else TCOr (Affine P1) (Absorbing Q)))) →
envs_simple_replace i p (Esnoc Enil j (if d is Left then P1 else P2)) Δ = Some Δ' →
envs_entails Δ' Q → envs_entails Δ Q.
Proof.
- rewrite /envs_entails=> ??? <-. rewrite envs_simple_replace_sound //; simpl.
- rewrite right_id (into_and true P). destruct d.
- - by rewrite and_elim_l wand_elim_r.
- - by rewrite and_elim_r wand_elim_r.
+ rewrite envs_entails_eq => ? HP ? HQ.
+ rewrite envs_simple_replace_singleton_sound //=. destruct p.
+ { rewrite (into_and _ P) HQ. destruct d; simpl.
+ - by rewrite and_elim_l wand_elim_r.
+ - by rewrite and_elim_r wand_elim_r. }
+ destruct HP as [?|[??]].
+ { rewrite (into_and _ P) HQ. destruct d; simpl.
+ - by rewrite and_elim_l wand_elim_r.
+ - by rewrite and_elim_r wand_elim_r. }
+ rewrite (into_sep P) HQ. destruct d; simpl.
+ - 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 → envs_entails Δ Q → envs_entails Δ P.
Proof.
- rewrite /envs_entails=> ?? ->.
- by rewrite -(frame ⌜φ⌠P) /= persistently_pure pure_True // left_id.
+ rewrite envs_entails_eq => ?? ->. rewrite -(frame ⌜φ⌠P) /=.
+ rewrite -persistently_and_intuitionistically_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_entails (if p then Δ else Δ') Q → envs_entails Δ P.
+ envs_lookup_delete false i Δ = Some (p, R, Δ') →
+ Frame p R P Q →
+ envs_entails Δ' Q → envs_entails Δ P.
Proof.
- rewrite /envs_entails. intros [? ->]%envs_lookup_delete_Some ? HQ. destruct p.
- - by rewrite envs_lookup_persistent_sound // -(frame R P) HQ.
- - rewrite envs_lookup_sound //; simpl. by rewrite -(frame R P) HQ.
+ rewrite envs_entails_eq. intros [? ->]%envs_lookup_delete_Some ? HQ.
+ rewrite (envs_lookup_sound' _ false) //. by rewrite -(frame R P) HQ.
Qed.
(** * Disjunction *)
Lemma tac_or_l Δ P Q1 Q2 :
FromOr P Q1 Q2 → envs_entails Δ Q1 → envs_entails Δ P.
Proof.
- rewrite /envs_entails=> ? ->. rewrite -(from_or P). by apply or_intro_l'.
+ rewrite envs_entails_eq=> ? ->. rewrite -(from_or P). by apply or_intro_l'.
Qed.
Lemma tac_or_r Δ P Q1 Q2 :
FromOr P Q1 Q2 → envs_entails Δ Q2 → envs_entails Δ P.
Proof.
- rewrite /envs_entails=> ? ->. rewrite -(from_or P). by apply or_intro_r'.
+ rewrite envs_entails_eq=> ? ->. rewrite -(from_or P). by apply or_intro_r'.
Qed.
Lemma tac_or_destruct Δ Δ1 Δ2 i p j1 j2 P P1 P2 Q :
@@ -962,70 +897,422 @@ Lemma tac_or_destruct Δ Δ1 Δ2 i p j1 j2 P P1 P2 Q :
envs_simple_replace i p (Esnoc Enil j2 P2) Δ = Some Δ2 →
envs_entails Δ1 Q → envs_entails Δ2 Q → envs_entails Δ Q.
Proof.
- rewrite /envs_entails=> ???? HP1 HP2. rewrite envs_lookup_sound //.
- rewrite (into_or P) 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) //.
- by rewrite /= right_id wand_elim_r.
+ rewrite envs_entails_eq. intros ???? HP1 HP2. rewrite envs_lookup_sound //.
+ rewrite (into_or P) intuitionistically_if_or sep_or_r; apply or_elim.
+ - rewrite (envs_simple_replace_singleton_sound' _ Δ1) //.
+ by rewrite wand_elim_r.
+ - rewrite (envs_simple_replace_singleton_sound' _ Δ2) //.
+ by rewrite wand_elim_r.
Qed.
(** * Forall *)
-Lemma tac_forall_intro {A} Δ (Φ : A → uPred M) Q :
+Lemma tac_forall_intro {A} Δ (Φ : A → PROP) Q :
FromForall Q Φ →
(∀ a, envs_entails Δ (Φ a)) →
envs_entails Δ Q.
-Proof. rewrite /envs_entails /FromForall=> <-. apply forall_intro. Qed.
+Proof. rewrite envs_entails_eq /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 Δ' ∧
envs_entails Δ' Q) →
envs_entails Δ Q.
Proof.
- rewrite /envs_entails. intros ?? (x&?&?).
- rewrite envs_simple_replace_sound //; simpl.
- by rewrite right_id (into_forall P) (forall_elim x) wand_elim_r.
+ rewrite envs_entails_eq. intros ?? (x&?&?).
+ rewrite envs_simple_replace_singleton_sound //; simpl.
+ by rewrite (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) :
envs_entails Δ (∀ a, Φ a) → ∀ a, envs_entails Δ (Φ a).
-Proof. rewrite /envs_entails=> HΔ a. by rewrite HΔ (forall_elim a). Qed.
+Proof. rewrite envs_entails_eq => 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, envs_entails Δ (Φ a)) → envs_entails Δ P.
Proof.
- rewrite /envs_entails=> ? [a ?].
+ rewrite envs_entails_eq => ? [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 Δ' ∧
envs_entails Δ' Q) →
envs_entails Δ Q.
Proof.
- rewrite /envs_entails=> ?? HΦ. rewrite envs_lookup_sound //.
- rewrite (into_exist P) persistently_if_exist sep_exist_r.
+ rewrite envs_entails_eq => ?? HΦ. rewrite envs_lookup_sound //.
+ rewrite (into_exist P) intuitionistically_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.
+ rewrite envs_simple_replace_singleton_sound' //; simpl. by rewrite wand_elim_r.
Qed.
(** * Modalities *)
-Lemma tac_modal_intro Δ P Q :
- FromModal P Q → envs_entails Δ Q → envs_entails Δ P.
-Proof. by rewrite /envs_entails /FromModal=> <- ->. Qed.
-
-Lemma tac_modal_elim Δ Δ' i p P' P Q Q' :
+Lemma tac_modal_elim Δ Δ' i p p' φ P' P Q Q' :
envs_lookup i Δ = Some (p, P) →
- ElimModal P P' Q Q' →
- envs_replace i p false (Esnoc Enil i P') Δ = Some Δ' →
+ ElimModal φ p p' P P' Q Q' →
+ φ →
+ envs_replace i p p' (Esnoc Enil i P') Δ = Some Δ' →
envs_entails Δ' Q' → envs_entails Δ Q.
Proof.
- rewrite /envs_entails=> ??? HΔ. rewrite envs_replace_sound //; simpl.
- rewrite right_id HΔ persistently_if_elim. by apply elim_modal.
+ rewrite envs_entails_eq => ???? HΔ. rewrite envs_replace_singleton_sound //=.
+ rewrite HΔ. by eapply elim_modal.
+Qed.
+
+(** * Accumulate hypotheses *)
+Lemma tac_accu Δ P :
+ prop_of_env (env_spatial Δ) = P →
+ envs_entails Δ P.
+Proof.
+ rewrite envs_entails_eq=><-.
+ rewrite prop_of_env_sound /of_envs and_elim_r sep_elim_r //.
+Qed.
+
+(** * Fresh *)
+Lemma envs_incr_counter_equiv Δ: envs_Forall2 (⊣⊢) Δ (envs_incr_counter Δ).
+Proof. rewrite //=. Qed.
+
+Lemma tac_fresh Δ Δ' (Q : PROP) :
+ envs_incr_counter Δ = Δ' →
+ envs_entails Δ' Q → envs_entails Δ Q.
+Proof.
+ rewrite envs_entails_eq => <-. by setoid_rewrite <-envs_incr_counter_equiv.
+Qed.
+
+(** * Invariants *)
+Lemma tac_inv_elim {X : Type} Δ Δ' i j φ p Pinv Pin Pout (Pclose : option (X → PROP))
+ Q (Q' : X → PROP) :
+ envs_lookup_delete false i Δ = Some (p, Pinv, Δ') →
+ ElimInv φ Pinv Pin Pout Pclose Q Q' →
+ φ →
+ (∀ R, ∃ Δ'',
+ envs_app false (Esnoc Enil j
+ (Pin -∗
+ (∀ x, Pout x -∗ pm_option_fun Pclose x -∗? Q' x) -∗
+ R
+ )%I) Δ'
+ = Some Δ'' ∧
+ envs_entails Δ'' R) →
+ envs_entails Δ Q.
+Proof.
+ rewrite envs_entails_eq=> /envs_lookup_delete_Some [? ->] Hinv ? /(_ Q) [Δ'' [? <-]].
+ rewrite (envs_lookup_sound' _ false) // envs_app_singleton_sound //; simpl.
+ apply wand_elim_r', wand_mono; last done. apply wand_intro_r, wand_intro_r.
+ rewrite intuitionistically_if_elim -assoc. destruct Pclose; simpl in *.
+ - setoid_rewrite wand_curry. auto.
+ - setoid_rewrite <-(right_id emp%I _ (Pout _)). auto.
+Qed.
+
+End bi_tactics.
+
+(** The following _private_ classes are used internally by [tac_modal_intro] /
+[iModIntro] to transform the proofmode environments when introducing a modality.
+
+The class [TransformPersistentEnv M C Γin Γout] is used to transform the
+persistent environment using a type class [C].
+
+Inputs:
+- [Γin] : the original environment.
+- [M] : the modality that the environment should be transformed into.
+- [C : PROP → PROP → Prop] : a type class that is used to transform the
+ individual hypotheses. The first parameter is the input and the second
+ parameter is the output.
+
+Outputs:
+- [Γout] : the resulting environment. *)
+Class TransformPersistentEnv {PROP1 PROP2} (M : modality PROP1 PROP2)
+ (C : PROP2 → PROP1 → Prop) (Γin : env PROP2) (Γout : env PROP1) := {
+ transform_persistent_env :
+ (∀ P Q, C P Q → □ P ⊢ M (□ Q)) →
+ (∀ P Q, M P ∧ M Q ⊢ M (P ∧ Q)) →
+ □ ([∧] Γin) ⊢ M (□ ([∧] Γout));
+ transform_persistent_env_wf : env_wf Γin → env_wf Γout;
+ transform_persistent_env_dom i : Γin !! i = None → Γout !! i = None;
+}.
+
+(* The class [TransformPersistentEnv M C Γin Γout filtered] is used to transform
+the persistent environment using a type class [C].
+
+Inputs:
+- [Γin] : the original environment.
+- [M] : the modality that the environment should be transformed into.
+- [C : PROP → PROP → Prop] : a type class that is used to transform the
+ individual hypotheses. The first parameter is the input and the second
+ parameter is the output.
+
+Outputs:
+- [Γout] : the resulting environment.
+- [filtered] : a Boolean indicating if non-affine hypotheses have been cleared. *)
+Class TransformSpatialEnv {PROP1 PROP2} (M : modality PROP1 PROP2)
+ (C : PROP2 → PROP1 → Prop) (Γin : env PROP2) (Γout : env PROP1)
+ (filtered : bool) := {
+ transform_spatial_env :
+ (∀ P Q, C P Q → P ⊢ M Q) →
+ ([∗] Γin) ⊢ M ([∗] Γout) ∗ if filtered then True else emp;
+ transform_spatial_env_wf : env_wf Γin → env_wf Γout;
+ transform_spatial_env_dom i : Γin !! i = None → Γout !! i = None;
+}.
+
+(* The class [IntoModalPersistentEnv M Γin Γout s] is used to transform the
+persistent environment with respect to the behavior needed to introduce [M] as
+given by [s : modality_intro_spec PROP1 PROP2].
+
+Inputs:
+- [Γin] : the original environment.
+- [M] : the modality that the environment should be transformed into.
+- [s] : the [modality_intro_spec] a specification of the way the hypotheses
+ should be transformed.
+
+Outputs:
+- [Γout] : the resulting environment. *)
+Inductive IntoModalPersistentEnv {PROP2} : ∀ {PROP1} (M : modality PROP1 PROP2)
+ (Γin : env PROP2) (Γout : env PROP1), modality_action PROP1 PROP2 → Prop :=
+ | MIEnvIsEmpty_persistent {PROP1} (M : modality PROP1 PROP2) :
+ IntoModalPersistentEnv M Enil Enil MIEnvIsEmpty
+ | MIEnvForall_persistent (M : modality PROP2 PROP2) (C : PROP2 → Prop) Γ :
+ TCForall C (env_to_list Γ) →
+ IntoModalPersistentEnv M Γ Γ (MIEnvForall C)
+ | MIEnvTransform_persistent {PROP1}
+ (M : modality PROP1 PROP2) (C : PROP2 → PROP1 → Prop) Γin Γout :
+ TransformPersistentEnv M C Γin Γout →
+ IntoModalPersistentEnv M Γin Γout (MIEnvTransform C)
+ | MIEnvClear_persistent {PROP1 : bi} (M : modality PROP1 PROP2) Γ :
+ IntoModalPersistentEnv M Γ Enil MIEnvClear
+ | MIEnvId_persistent (M : modality PROP2 PROP2) Γ :
+ IntoModalPersistentEnv M Γ Γ MIEnvId.
+Existing Class IntoModalPersistentEnv.
+Existing Instances MIEnvIsEmpty_persistent MIEnvForall_persistent
+ MIEnvTransform_persistent MIEnvClear_persistent MIEnvId_persistent.
+
+(* The class [IntoModalSpatialEnv M Γin Γout s] is used to transform the spatial
+environment with respect to the behavior needed to introduce [M] as given by
+[s : modality_intro_spec PROP1 PROP2].
+
+Inputs:
+- [Γin] : the original environment.
+- [M] : the modality that the environment should be transformed into.
+- [s] : the [modality_intro_spec] a specification of the way the hypotheses
+ should be transformed.
+
+Outputs:
+- [Γout] : the resulting environment.
+- [filtered] : a Boolean indicating if non-affine hypotheses have been cleared. *)
+Inductive IntoModalSpatialEnv {PROP2} : ∀ {PROP1} (M : modality PROP1 PROP2)
+ (Γin : env PROP2) (Γout : env PROP1), modality_action PROP1 PROP2 → bool → Prop :=
+ | MIEnvIsEmpty_spatial {PROP1} (M : modality PROP1 PROP2) :
+ IntoModalSpatialEnv M Enil Enil MIEnvIsEmpty false
+ | MIEnvForall_spatial (M : modality PROP2 PROP2) (C : PROP2 → Prop) Γ :
+ TCForall C (env_to_list Γ) →
+ IntoModalSpatialEnv M Γ Γ (MIEnvForall C) false
+ | MIEnvTransform_spatial {PROP1}
+ (M : modality PROP1 PROP2) (C : PROP2 → PROP1 → Prop) Γin Γout fi :
+ TransformSpatialEnv M C Γin Γout fi →
+ IntoModalSpatialEnv M Γin Γout (MIEnvTransform C) fi
+ | MIEnvClear_spatial {PROP1 : bi} (M : modality PROP1 PROP2) Γ :
+ IntoModalSpatialEnv M Γ Enil MIEnvClear false
+ | MIEnvId_spatial (M : modality PROP2 PROP2) Γ :
+ IntoModalSpatialEnv M Γ Γ MIEnvId false.
+Existing Class IntoModalSpatialEnv.
+Existing Instances MIEnvIsEmpty_spatial MIEnvForall_spatial
+ MIEnvTransform_spatial MIEnvClear_spatial MIEnvId_spatial.
+
+Section tac_modal_intro.
+ Context {PROP1 PROP2 : bi} (M : modality PROP1 PROP2).
+
+ Global Instance transform_persistent_env_nil C : TransformPersistentEnv M C Enil Enil.
+ Proof.
+ split; [|eauto using Enil_wf|done]=> /= ??.
+ rewrite !intuitionistically_True_emp -modality_emp //.
+ Qed.
+ Global Instance transform_persistent_env_snoc (C : PROP2 → PROP1 → Prop) Γ Γ' i P Q :
+ C P Q →
+ TransformPersistentEnv M C Γ Γ' →
+ TransformPersistentEnv M C (Esnoc Γ i P) (Esnoc Γ' i Q).
+ Proof.
+ intros ? [HΓ Hwf Hdom]; split; simpl.
+ - intros HC Hand. rewrite intuitionistically_and HC // HΓ //.
+ by rewrite Hand -intuitionistically_and.
+ - inversion 1; constructor; auto.
+ - intros j. destruct (ident_beq _ _); naive_solver.
+ Qed.
+ Global Instance transform_persistent_env_snoc_not (C : PROP2 → PROP1 → Prop) Γ Γ' i P :
+ TransformPersistentEnv M C Γ Γ' →
+ TransformPersistentEnv M C (Esnoc Γ i P) Γ' | 100.
+ Proof.
+ intros [HΓ Hwf Hdom]; split; simpl.
+ - intros HC Hand. by rewrite and_elim_r HΓ.
+ - inversion 1; auto.
+ - intros j. destruct (ident_beq _ _); naive_solver.
+ Qed.
+
+ Global Instance transform_spatial_env_nil C :
+ TransformSpatialEnv M C Enil Enil false.
+ Proof.
+ split; [|eauto using Enil_wf|done]=> /= ?. by rewrite right_id -modality_emp.
+ Qed.
+ Global Instance transform_spatial_env_snoc (C : PROP2 → PROP1 → Prop) Γ Γ' i P Q fi :
+ C P Q →
+ TransformSpatialEnv M C Γ Γ' fi →
+ TransformSpatialEnv M C (Esnoc Γ i P) (Esnoc Γ' i Q) fi.
+ Proof.
+ intros ? [HΓ Hwf Hdom]; split; simpl.
+ - intros HC. by rewrite {1}(HC P) // HΓ // assoc modality_sep.
+ - inversion 1; constructor; auto.
+ - intros j. destruct (ident_beq _ _); naive_solver.
+ Qed.
+
+ Global Instance transform_spatial_env_snoc_not
+ (C : PROP2 → PROP1 → Prop) Γ Γ' i P fi fi' :
+ TransformSpatialEnv M C Γ Γ' fi →
+ TCIf (TCEq fi false)
+ (TCIf (Affine P) (TCEq fi' false) (TCEq fi' true))
+ (TCEq fi' true) →
+ TransformSpatialEnv M C (Esnoc Γ i P) Γ' fi' | 100.
+ Proof.
+ intros [HΓ Hwf Hdom] Hif; split; simpl.
+ - intros ?. rewrite HΓ //. destruct Hif as [-> [? ->| ->]| ->].
+ + by rewrite (affine P) left_id.
+ + by rewrite right_id comm (True_intro P).
+ + by rewrite comm -assoc (True_intro (_ ∗ P)%I).
+ - inversion 1; auto.
+ - intros j. destruct (ident_beq _ _); naive_solver.
+ Qed.
+
+ (** The actual introduction tactic *)
+ Lemma tac_modal_intro {A} (sel : A) Γp Γs n Γp' Γs' Q Q' fi :
+ FromModal M sel Q' Q →
+ IntoModalPersistentEnv M Γp Γp' (modality_intuitionistic_action M) →
+ IntoModalSpatialEnv M Γs Γs' (modality_spatial_action M) fi →
+ (if fi then Absorbing Q' else TCTrue) →
+ envs_entails (Envs Γp' Γs' n) Q → envs_entails (Envs Γp Γs n) Q'.
+ Proof.
+ rewrite envs_entails_eq /FromModal /of_envs /= => HQ' HΓp HΓs ? HQ.
+ apply pure_elim_l=> -[???]. assert (envs_wf (Envs Γp' Γs' n)) as Hwf.
+ { split; simpl in *.
+ - destruct HΓp as [| |????? []| |]; eauto using Enil_wf.
+ - destruct HΓs as [| |?????? []| |]; eauto using Enil_wf.
+ - assert (∀ i, Γp !! i = None → Γp' !! i = None).
+ { destruct HΓp as [| |????? []| |]; eauto. }
+ assert (∀ i, Γs !! i = None → Γs' !! i = None).
+ { destruct HΓs as [| |?????? []| |]; eauto. }
+ naive_solver. }
+ assert (□ [∧] Γp ⊢ M (□ [∧] Γp'))%I as HMp.
+ { remember (modality_intuitionistic_action M).
+ destruct HΓp as [?|M C Γp ?%TCForall_Forall|? M C Γp Γp' []|? M Γp|M Γp]; simpl.
+ - rewrite {1}intuitionistically_elim_emp (modality_emp M)
+ intuitionistically_True_emp //.
+ - eauto using modality_intuitionistic_forall_big_and.
+ - eauto using modality_intuitionistic_transform,
+ modality_and_transform.
+ - by rewrite {1}intuitionistically_elim_emp (modality_emp M)
+ intuitionistically_True_emp.
+ - eauto using modality_intuitionistic_id. }
+ move: HQ'; rewrite -HQ pure_True // left_id HMp=> HQ' {HQ Hwf HMp}.
+ remember (modality_spatial_action M).
+ destruct HΓs as [?|M C Γs ?%TCForall_Forall|? M C Γs Γs' fi []|? M Γs|M Γs]; simpl.
+ - by rewrite -HQ' /= !right_id.
+ - rewrite -HQ' {1}(modality_spatial_forall_big_sep _ _ Γs) //.
+ by rewrite modality_sep.
+ - destruct fi.
+ + rewrite -(absorbing Q') /bi_absorbingly -HQ' (comm _ True%I).
+ rewrite -modality_sep -assoc. apply sep_mono_r.
+ eauto using modality_spatial_transform.
+ + rewrite -HQ' -modality_sep. apply sep_mono_r.
+ rewrite -(right_id emp%I bi_sep (M _)).
+ eauto using modality_spatial_transform.
+ - rewrite -HQ' /= right_id comm -{2}(modality_spatial_clear M) //.
+ by rewrite (True_intro ([∗] Γs)%I).
+ - rewrite -HQ' {1}(modality_spatial_id M ([∗] Γs)%I) //.
+ by rewrite -modality_sep.
+ Qed.
+End tac_modal_intro.
+
+Section sbi_tactics.
+Context {PROP : sbi}.
+Implicit Types Γ : env PROP.
+Implicit Types Δ : envs PROP.
+Implicit Types P Q : PROP.
+
+(** * Rewriting *)
+Lemma tac_rewrite Δ i p Pxy d Q :
+ envs_lookup i Δ = Some (p, Pxy) →
+ ∀ {A : ofeT} (x y : A) (Φ : A → PROP),
+ IntoInternalEq Pxy x y →
+ (Q ⊣⊢ Φ (if d is Left then y else x)) →
+ NonExpansive Φ →
+ envs_entails Δ (Φ (if d is Left then x else y)) → envs_entails Δ Q.
+Proof.
+ intros ? A x y ? HPxy -> ?. rewrite envs_entails_eq.
+ apply internal_eq_rewrite'; auto. rewrite {1}envs_lookup_sound //.
+ rewrite (into_internal_eq Pxy x y) intuitionistically_if_elim sep_elim_l.
+ destruct d; auto using internal_eq_sym.
+Qed.
+
+Lemma tac_rewrite_in Δ i p Pxy j q P d Q :
+ envs_lookup i Δ = Some (p, Pxy) →
+ envs_lookup j Δ = Some (q, P) →
+ ∀ {A : ofeT} Δ' (x y : A) (Φ : A → PROP),
+ IntoInternalEq Pxy x y →
+ (P ⊣⊢ Φ (if d is Left then y else x)) →
+ NonExpansive Φ →
+ envs_simple_replace j q (Esnoc Enil j (Φ (if d is Left then x else y))) Δ = Some Δ' →
+ envs_entails Δ' Q →
+ envs_entails Δ Q.
+Proof.
+ rewrite envs_entails_eq /IntoInternalEq => ?? A Δ' x y Φ HPxy HP ?? <-.
+ rewrite -(idemp bi_and (of_envs Δ)) {2}(envs_lookup_sound _ i) //.
+ rewrite (envs_simple_replace_singleton_sound _ _ j) //=.
+ rewrite HP HPxy (intuitionistically_if_elim _ (_ ≡ _)%I) sep_elim_l.
+ rewrite persistent_and_affinely_sep_r -assoc. apply wand_elim_r'.
+ rewrite -persistent_and_affinely_sep_r. apply impl_elim_r'. destruct d.
+ - apply (internal_eq_rewrite x y (λ y, □?q Φ y -∗ of_envs Δ')%I). solve_proper.
+ - rewrite internal_eq_sym.
+ eapply (internal_eq_rewrite y x (λ y, □?q Φ y -∗ of_envs Δ')%I). solve_proper.
+Qed.
+
+(** * Later *)
+(** The class [MaybeIntoLaterNEnvs] is used by tactics that need to introduce
+laters, e.g. the symbolic execution tactics. *)
+Class MaybeIntoLaterNEnvs (n : nat) (Δ1 Δ2 : envs PROP) := {
+ into_later_persistent :
+ TransformPersistentEnv (modality_laterN n) (MaybeIntoLaterN false n)
+ (env_intuitionistic Δ1) (env_intuitionistic Δ2);
+ into_later_spatial :
+ TransformSpatialEnv (modality_laterN n)
+ (MaybeIntoLaterN false n) (env_spatial Δ1) (env_spatial Δ2) false
+}.
+
+Global Instance into_laterN_envs n Γp1 Γp2 Γs1 Γs2 m :
+ TransformPersistentEnv (modality_laterN n) (MaybeIntoLaterN false n) Γp1 Γp2 →
+ TransformSpatialEnv (modality_laterN n) (MaybeIntoLaterN false n) Γs1 Γs2 false →
+ MaybeIntoLaterNEnvs n (Envs Γp1 Γs1 m) (Envs Γp2 Γs2 m).
+Proof. by split. Qed.
+
+Lemma into_laterN_env_sound n Δ1 Δ2 :
+ MaybeIntoLaterNEnvs n Δ1 Δ2 → of_envs Δ1 ⊢ ▷^n (of_envs Δ2).
+Proof.
+ intros [[Hp ??] [Hs ??]]; rewrite /of_envs /= !laterN_and !laterN_sep.
+ rewrite -{1}laterN_intro. apply and_mono, sep_mono.
+ - apply pure_mono; destruct 1; constructor; naive_solver.
+ - apply Hp; rewrite /= /MaybeIntoLaterN.
+ + intros P Q ->. by rewrite laterN_intuitionistically_2.
+ + intros P Q. by rewrite laterN_and.
+ - by rewrite Hs //= right_id.
+Qed.
+
+Lemma tac_löb Δ Δ' i Q :
+ env_spatial_is_nil Δ = true →
+ envs_app true (Esnoc Enil i (▷ Q)%I) Δ = Some Δ' →
+ envs_entails Δ' Q → envs_entails Δ Q.
+Proof.
+ rewrite envs_entails_eq => ?? HQ.
+ rewrite (env_spatial_is_nil_intuitionistically Δ) //.
+ rewrite -(persistently_and_emp_elim Q). apply and_intro; first apply: affine.
+ rewrite -(löb (<pers> Q)%I) later_persistently. apply impl_intro_l.
+ rewrite envs_app_singleton_sound //; simpl; rewrite HQ.
+ rewrite persistently_and_intuitionistically_sep_l -{1}intuitionistically_idemp.
+ rewrite intuitionistically_sep_2 wand_elim_r intuitionistically_into_persistently_1 //.
Qed.
-End tactics.
+End sbi_tactics.
diff --git a/theories/proofmode/environments.v b/theories/proofmode/environments.v
index 4816f938a0daae36ba3b2bcd964b00bb3936b3a9..cdca5f137bbdce61648c9e5c3c486dbd75ba79f0 100644
--- a/theories/proofmode/environments.v
+++ b/theories/proofmode/environments.v
@@ -1,5 +1,6 @@
From iris.proofmode Require Import base.
From iris.algebra Require Export base.
+From iris.bi Require Export bi.
Set Default Proof Using "Type".
Inductive env (A : Type) : Type :=
@@ -17,7 +18,7 @@ Fixpoint env_lookup {A} (i : ident) (Γ : env A) : option A :=
end.
Module env_notations.
- Notation "y ≫= f" := (option_bind f y).
+ Notation "y ≫= f" := (pm_option_bind f y).
Notation "x ↠y ; z" := (y ≫= λ x, z).
Notation "' x1 .. xn ↠y ; z" := (y ≫= (λ x1, .. (λ xn, z) .. )).
Notation "Γ !! j" := (env_lookup j Γ).
@@ -93,8 +94,8 @@ Ltac simplify :=
| _ => progress simplify_eq/=
| H : context [ident_beq ?s1 ?s2] |- _ => destruct (ident_beq_reflect s1 s2)
| |- context [ident_beq ?s1 ?s2] => destruct (ident_beq_reflect s1 s2)
- | H : context [option_bind _ ?x] |- _ => destruct x eqn:?
- | |- context [option_bind _ ?x] => destruct x eqn:?
+ | H : context [pm_option_bind _ ?x] |- _ => destruct x eqn:?
+ | |- context [pm_option_bind _ ?x] => destruct x eqn:?
| _ => case_match
end.
@@ -205,3 +206,132 @@ Global Instance env_to_list_subenv_proper :
Proper (env_subenv ==> sublist) (@env_to_list A).
Proof. induction 1; simpl; constructor; auto. Qed.
End env.
+
+Record envs (PROP : bi) :=
+ Envs { env_intuitionistic : env PROP; env_spatial : env PROP; env_counter : positive }.
+Add Printing Constructor envs.
+Arguments Envs {_} _ _ _.
+Arguments env_intuitionistic {_} _.
+Arguments env_spatial {_} _.
+Arguments env_counter {_} _.
+
+Record envs_wf {PROP} (Δ : envs PROP) := {
+ env_intuitionistic_valid : env_wf (env_intuitionistic Δ);
+ env_spatial_valid : env_wf (env_spatial Δ);
+ envs_disjoint i : env_intuitionistic Δ !! i = None ∨ env_spatial Δ !! i = None
+}.
+
+Definition of_envs {PROP} (Δ : envs PROP) : PROP :=
+ (⌜envs_wf Δ⌠∧ □ [∧] env_intuitionistic Δ ∗ [∗] env_spatial Δ)%I.
+Instance: Params (@of_envs) 1.
+Arguments of_envs : simpl never.
+
+(* We seal [envs_entails], so that it does not get unfolded by the
+ proofmode's own tactics, such as [iIntros (?)]. *)
+Definition envs_entails_aux : seal (λ PROP (Δ : envs PROP) (Q : PROP), (of_envs Δ ⊢ Q)).
+Proof. by eexists. Qed.
+Definition envs_entails := envs_entails_aux.(unseal).
+Definition envs_entails_eq : envs_entails = _ := envs_entails_aux.(seal_eq).
+Arguments envs_entails {PROP} Δ Q%I : rename.
+Instance: Params (@envs_entails) 1.
+
+Record envs_Forall2 {PROP : bi} (R : relation PROP) (Δ1 Δ2 : envs PROP) := {
+ env_intuitionistic_Forall2 : env_Forall2 R (env_intuitionistic Δ1) (env_intuitionistic Δ2);
+ env_spatial_Forall2 : env_Forall2 R (env_spatial Δ1) (env_spatial Δ2)
+}.
+
+Definition envs_dom {PROP} (Δ : envs PROP) : list ident :=
+ env_dom (env_intuitionistic Δ) ++ env_dom (env_spatial Δ).
+
+Definition envs_lookup {PROP} (i : ident) (Δ : envs PROP) : option (bool * PROP) :=
+ let (Γp,Γs,n) := Δ in
+ match env_lookup i Γp with
+ | Some P => Some (true, P)
+ | None => P ↠env_lookup i Γs; Some (false, P)
+ end.
+
+Definition envs_delete {PROP} (remove_persistent : bool)
+ (i : ident) (p : bool) (Δ : envs PROP) : envs PROP :=
+ let (Γp,Γs,n) := Δ in
+ match p with
+ | true => Envs (if remove_persistent then env_delete i Γp else Γp) Γs n
+ | false => Envs Γp (env_delete i Γs) n
+ end.
+
+Definition envs_lookup_delete {PROP} (remove_persistent : bool)
+ (i : ident) (Δ : envs PROP) : option (bool * PROP * envs PROP) :=
+ let (Γp,Γs,n) := Δ in
+ match env_lookup_delete i Γp with
+ | Some (P,Γp') => Some (true, P, Envs (if remove_persistent then Γp' else Γp) Γs n)
+ | None => ''(P,Γs') ↠env_lookup_delete i Γs; Some (false, P, Envs Γp Γs' n)
+ end.
+
+Fixpoint envs_lookup_delete_list {PROP} (remove_persistent : bool)
+ (js : list ident) (Δ : envs PROP) : option (bool * list PROP * envs PROP) :=
+ match js with
+ | [] => Some (true, [], Δ)
+ | j :: js =>
+ ''(p,P,Δ') ↠envs_lookup_delete remove_persistent j Δ;
+ ''(q,Hs,Δ'') ↠envs_lookup_delete_list remove_persistent js Δ';
+ Some ((p:bool) && q, P :: Hs, Δ'')
+ end.
+
+Definition envs_snoc {PROP} (Δ : envs PROP)
+ (p : bool) (j : ident) (P : PROP) : envs PROP :=
+ let (Γp,Γs,n) := Δ in
+ if p then Envs (Esnoc Γp j P) Γs n else Envs Γp (Esnoc Γs j P) n.
+
+Definition envs_app {PROP : bi} (p : bool)
+ (Γ : env PROP) (Δ : envs PROP) : option (envs PROP) :=
+ let (Γp,Γs,n) := Δ in
+ match p with
+ | true => _ ↠env_app Γ Γs; Γp' ↠env_app Γ Γp; Some (Envs Γp' Γs n)
+ | false => _ ↠env_app Γ Γp; Γs' ↠env_app Γ Γs; Some (Envs Γp Γs' n)
+ end.
+
+Definition envs_simple_replace {PROP : bi} (i : ident) (p : bool)
+ (Γ : env PROP) (Δ : envs PROP) : option (envs PROP) :=
+ let (Γp,Γs,n) := Δ in
+ match p with
+ | true => _ ↠env_app Γ Γs; Γp' ↠env_replace i Γ Γp; Some (Envs Γp' Γs n)
+ | false => _ ↠env_app Γ Γp; Γs' ↠env_replace i Γ Γs; Some (Envs Γp Γs' n)
+ end.
+
+Definition envs_replace {PROP : bi} (i : ident) (p q : bool)
+ (Γ : env PROP) (Δ : envs PROP) : option (envs PROP) :=
+ if beq p q then envs_simple_replace i p Γ Δ
+ else envs_app q Γ (envs_delete true i p Δ).
+
+Definition env_spatial_is_nil {PROP} (Δ : envs PROP) : bool :=
+ if env_spatial Δ is Enil then true else false.
+
+Definition envs_clear_spatial {PROP} (Δ : envs PROP) : envs PROP :=
+ Envs (env_intuitionistic Δ) Enil (env_counter Δ).
+
+Definition envs_clear_persistent {PROP} (Δ : envs PROP) : envs PROP :=
+ Envs Enil (env_spatial Δ) (env_counter Δ).
+
+Definition envs_incr_counter {PROP} (Δ : envs PROP) : envs PROP :=
+ Envs (env_intuitionistic Δ) (env_spatial Δ) (Pos_succ (env_counter Δ)).
+
+Fixpoint envs_split_go {PROP}
+ (js : list ident) (Δ1 Δ2 : envs PROP) : option (envs PROP * envs PROP) :=
+ match js with
+ | [] => Some (Δ1, Δ2)
+ | j :: js =>
+ ''(p,P,Δ1') ↠envs_lookup_delete true j Δ1;
+ if p : bool then envs_split_go js Δ1 Δ2 else
+ envs_split_go js Δ1' (envs_snoc Δ2 false j P)
+ end.
+(* if [d = Right] then [result = (remaining hyps, hyps named js)] and
+ if [d = Left] then [result = (hyps named js, remaining hyps)] *)
+Definition envs_split {PROP} (d : direction)
+ (js : list ident) (Δ : envs PROP) : option (envs PROP * envs PROP) :=
+ ''(Δ1,Δ2) ↠envs_split_go js Δ (envs_clear_spatial Δ);
+ if d is Right then Some (Δ1,Δ2) else Some (Δ2,Δ1).
+
+Definition prop_of_env {PROP : bi} (Γ : env PROP) : PROP :=
+ let fix aux Γ acc :=
+ match Γ with Enil => acc | Esnoc Γ _ P => aux Γ (P ∗ acc)%I end
+ in
+ match Γ with Enil => emp%I | Esnoc Γ _ P => aux Γ P end.
diff --git a/theories/proofmode/frame_instances.v b/theories/proofmode/frame_instances.v
new file mode 100644
index 0000000000000000000000000000000000000000..3dee777bfa9cbfb8c15a6ac6587e29da4bd42b1e
--- /dev/null
+++ b/theories/proofmode/frame_instances.v
@@ -0,0 +1,326 @@
+From stdpp Require Import nat_cancel.
+From iris.bi Require Import bi tactics.
+From iris.proofmode Require Import classes.
+Set Default Proof Using "Type".
+Import bi.
+
+(** This file defines the instances that make up the framing machinery. *)
+
+Section bi.
+Context {PROP : bi}.
+Implicit Types P Q R : PROP.
+(* Frame *)
+Global Instance frame_here_absorbing p R : Absorbing R → Frame p R R True | 0.
+Proof. intros. by rewrite /Frame intuitionistically_if_elim sep_elim_l. Qed.
+Global Instance frame_here p R : Frame p R R emp | 1.
+Proof. intros. by rewrite /Frame intuitionistically_if_elim sep_elim_l. Qed.
+Global Instance frame_affinely_here_absorbing p R :
+ Absorbing R → Frame p (<affine> R) R True | 0.
+Proof.
+ intros. rewrite /Frame intuitionistically_if_elim affinely_elim.
+ apply sep_elim_l, _.
+Qed.
+Global Instance frame_affinely_here p R : Frame p (<affine> R) R emp | 1.
+Proof.
+ intros. rewrite /Frame intuitionistically_if_elim affinely_elim.
+ apply sep_elim_l, _.
+Qed.
+
+Global Instance frame_here_pure p φ Q : FromPure false Q φ → Frame p ⌜φ⌠Q True.
+Proof.
+ rewrite /FromPure /Frame=> <-.
+ by rewrite intuitionistically_if_elim sep_elim_l.
+Qed.
+
+Global Instance make_embed_pure `{BiEmbed PROP PROP'} φ :
+ KnownMakeEmbed ⌜φ⌠⌜φâŒ.
+Proof. apply embed_pure. Qed.
+Global Instance make_embed_emp `{BiEmbedEmp PROP PROP'} :
+ KnownMakeEmbed emp emp.
+Proof. apply embed_emp. Qed.
+Global Instance make_embed_default `{BiEmbed PROP PROP'} P :
+ MakeEmbed P ⎡P⎤ | 100.
+Proof. by rewrite /MakeEmbed. Qed.
+
+Global Instance frame_embed `{BiEmbed PROP PROP'} p P Q (Q' : PROP') R :
+ Frame p R P Q → MakeEmbed Q Q' → Frame p ⎡R⎤ ⎡P⎤ Q'.
+Proof.
+ rewrite /Frame /MakeEmbed => <- <-.
+ rewrite embed_sep embed_intuitionistically_if_2 => //.
+Qed.
+Global Instance frame_pure_embed `{BiEmbed PROP PROP'} p P Q (Q' : PROP') φ :
+ Frame p ⌜φ⌠P Q → MakeEmbed Q Q' → Frame p ⌜φ⌠⎡P⎤ Q'.
+Proof. rewrite /Frame /MakeEmbed -embed_pure. apply (frame_embed p P Q). Qed.
+
+Global Instance make_sep_emp_l P : KnownLMakeSep emp P P.
+Proof. apply left_id, _. Qed.
+Global Instance make_sep_emp_r P : KnownRMakeSep P emp P.
+Proof. apply right_id, _. Qed.
+Global Instance make_sep_true_l P : Absorbing P → KnownLMakeSep True P P.
+Proof. intros. apply True_sep, _. Qed.
+Global Instance make_sep_true_r P : Absorbing P → KnownRMakeSep P True P.
+Proof. intros. by rewrite /KnownRMakeSep /MakeSep sep_True. Qed.
+Global Instance make_sep_default P Q : MakeSep P Q (P ∗ Q) | 100.
+Proof. by rewrite /MakeSep. Qed.
+
+Global Instance frame_sep_persistent_l progress R P1 P2 Q1 Q2 Q' :
+ Frame true R P1 Q1 → MaybeFrame true R P2 Q2 progress → MakeSep Q1 Q2 Q' →
+ Frame true R (P1 ∗ P2) Q' | 9.
+Proof.
+ rewrite /Frame /MaybeFrame /MakeSep /= => <- <- <-.
+ rewrite {1}(intuitionistically_sep_dup R). 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.
+Proof. rewrite /Frame /MakeSep => <- <-. by rewrite assoc. Qed.
+Global Instance frame_sep_r p R P1 P2 Q Q' :
+ Frame p R P2 Q → MakeSep P1 Q Q' → Frame p R (P1 ∗ P2) Q' | 10.
+Proof.
+ rewrite /Frame /MakeSep => <- <-. by rewrite assoc -(comm _ P1) assoc.
+Qed.
+
+Global Instance frame_big_sepL_cons {A} p (Φ : nat → A → PROP) R Q l x l' :
+ IsCons l x l' →
+ Frame p R (Φ 0 x ∗ [∗ list] k ↦ y ∈ l', Φ (S k) y) Q →
+ Frame p R ([∗ list] k ↦ y ∈ l, Φ k y) Q.
+Proof. rewrite /IsCons=>->. by rewrite /Frame big_sepL_cons. Qed.
+Global Instance frame_big_sepL_app {A} p (Φ : nat → A → PROP) R Q l l1 l2 :
+ IsApp l l1 l2 →
+ Frame p R (([∗ list] k ↦ y ∈ l1, Φ k y) ∗
+ [∗ list] k ↦ y ∈ l2, Φ (length l1 + k) y) Q →
+ Frame p R ([∗ list] k ↦ y ∈ l, Φ k y) Q.
+Proof. rewrite /IsApp=>->. by rewrite /Frame big_sepL_app. Qed.
+
+Global Instance frame_big_sepL2_cons {A B} p (Φ : nat → A → B → PROP)
+ R Q l1 x1 l1' l2 x2 l2' :
+ IsCons l1 x1 l1' → IsCons l2 x2 l2' →
+ Frame p R (Φ 0 x1 x2 ∗ [∗ list] k ↦ y1;y2 ∈ l1';l2', Φ (S k) y1 y2) Q →
+ Frame p R ([∗ list] k ↦ y1;y2 ∈ l1;l2, Φ k y1 y2) Q.
+Proof. rewrite /IsCons=>-> ->. by rewrite /Frame big_sepL2_cons. Qed.
+Global Instance frame_big_sepL2_app {A B} p (Φ : nat → A → B → PROP)
+ R Q l1 l1' l1'' l2 l2' l2'' :
+ IsApp l1 l1' l1'' → IsApp l2 l2' l2'' →
+ Frame p R (([∗ list] k ↦ y1;y2 ∈ l1';l2', Φ k y1 y2) ∗
+ [∗ list] k ↦ y1;y2 ∈ l1'';l2'', Φ (length l1' + k) y1 y2) Q →
+ Frame p R ([∗ list] k ↦ y1;y2 ∈ l1;l2, Φ k y1 y2) Q.
+Proof. rewrite /IsApp /Frame=>-> -> ->. apply wand_elim_l', big_sepL2_app. Qed.
+
+Global Instance make_and_true_l P : KnownLMakeAnd True P P.
+Proof. apply left_id, _. Qed.
+Global Instance make_and_true_r P : KnownRMakeAnd P True P.
+Proof. by rewrite /KnownRMakeAnd /MakeAnd right_id. Qed.
+Global Instance make_and_emp_l P : Affine P → KnownLMakeAnd emp P P.
+Proof. intros. by rewrite /KnownLMakeAnd /MakeAnd emp_and. Qed.
+Global Instance make_and_emp_r P : Affine P → KnownRMakeAnd P emp P.
+Proof. intros. by rewrite /KnownRMakeAnd /MakeAnd and_emp. Qed.
+Global Instance make_and_default P Q : MakeAnd P Q (P ∧ Q) | 100.
+Proof. by rewrite /MakeAnd. Qed.
+
+Global Instance frame_and p progress1 progress2 R P1 P2 Q1 Q2 Q' :
+ MaybeFrame p R P1 Q1 progress1 →
+ MaybeFrame p R P2 Q2 progress2 →
+ TCEq (progress1 || progress2) true →
+ MakeAnd Q1 Q2 Q' →
+ Frame p R (P1 ∧ P2) Q' | 9.
+Proof.
+ rewrite /MaybeFrame /Frame /MakeAnd => <- <- _ <-. apply and_intro;
+ [rewrite and_elim_l|rewrite and_elim_r]; done.
+Qed.
+
+Global Instance make_or_true_l P : KnownLMakeOr True P True.
+Proof. apply left_absorb, _. Qed.
+Global Instance make_or_true_r P : KnownRMakeOr P True True.
+Proof. by rewrite /KnownRMakeOr /MakeOr right_absorb. Qed.
+Global Instance make_or_emp_l P : Affine P → KnownLMakeOr emp P emp.
+Proof. intros. by rewrite /KnownLMakeOr /MakeOr emp_or. Qed.
+Global Instance make_or_emp_r P : Affine P → KnownRMakeOr P emp emp.
+Proof. intros. by rewrite /KnownRMakeOr /MakeOr or_emp. Qed.
+Global Instance make_or_default P Q : MakeOr P Q (P ∨ Q) | 100.
+Proof. by rewrite /MakeOr. Qed.
+
+(* We could in principle write the instance [frame_or_spatial] by a bunch of
+instances, i.e. (omitting the parameter [p = false]):
+
+ Frame R P1 Q1 → Frame R P2 Q2 → Frame R (P1 ∨ P2) (Q1 ∨ Q2)
+ Frame R P1 True → Frame R (P1 ∨ P2) P2
+ Frame R P2 True → Frame R (P1 ∨ P2) P1
+
+The problem here is that Coq will try to infer [Frame R P1 ?] and [Frame R P2 ?]
+multiple times, whereas the current solution makes sure that said inference
+appears at most once.
+
+If Coq would memorize the results of type class resolution, the solution with
+multiple instances would be preferred (and more Prolog-like). *)
+Global Instance frame_or_spatial progress1 progress2 R P1 P2 Q1 Q2 Q :
+ MaybeFrame false R P1 Q1 progress1 → MaybeFrame false R P2 Q2 progress2 →
+ TCOr (TCEq (progress1 && progress2) true) (TCOr
+ (TCAnd (TCEq progress1 true) (TCEq Q1 True%I))
+ (TCAnd (TCEq progress2 true) (TCEq Q2 True%I))) →
+ MakeOr Q1 Q2 Q →
+ Frame false R (P1 ∨ P2) Q | 9.
+Proof. rewrite /Frame /MakeOr => <- <- _ <-. by rewrite -sep_or_l. Qed.
+
+Global Instance frame_or_persistent progress1 progress2 R P1 P2 Q1 Q2 Q :
+ MaybeFrame true R P1 Q1 progress1 → MaybeFrame true R P2 Q2 progress2 →
+ TCEq (progress1 || progress2) true →
+ MakeOr Q1 Q2 Q → Frame true R (P1 ∨ P2) Q | 9.
+Proof. rewrite /Frame /MakeOr => <- <- _ <-. by rewrite -sep_or_l. Qed.
+
+Global Instance frame_wand p R P1 P2 Q2 :
+ Frame p R P2 Q2 → Frame p R (P1 -∗ P2) (P1 -∗ Q2).
+Proof.
+ rewrite /Frame=> ?. apply wand_intro_l.
+ by rewrite assoc (comm _ P1) -assoc wand_elim_r.
+Qed.
+
+Global Instance make_affinely_True : @KnownMakeAffinely PROP True emp | 0.
+Proof. by rewrite /KnownMakeAffinely /MakeAffinely affinely_True_emp affinely_emp. Qed.
+Global Instance make_affinely_affine P : Affine P → KnownMakeAffinely P P | 1.
+Proof. intros. by rewrite /KnownMakeAffinely /MakeAffinely affine_affinely. Qed.
+Global Instance make_affinely_default P : MakeAffinely P (<affine> P) | 100.
+Proof. by rewrite /MakeAffinely. Qed.
+
+Global Instance frame_affinely R P Q Q' :
+ Frame true R P Q → MakeAffinely Q Q' → Frame true R (<affine> P) Q'.
+Proof.
+ rewrite /Frame /MakeAffinely=> <- <- /=.
+ rewrite -{1}(affine_affinely (â–¡ R)%I) affinely_sep_2 //.
+Qed.
+
+Global Instance make_intuitionistically_True :
+ @KnownMakeIntuitionistically PROP True emp | 0.
+Proof.
+ by rewrite /KnownMakeIntuitionistically /MakeIntuitionistically
+ intuitionistically_True_emp.
+Qed.
+Global Instance make_intuitionistically_intuitionistic P :
+ Affine P → Persistent P → KnownMakeIntuitionistically P P | 1.
+Proof.
+ intros. rewrite /KnownMakeIntuitionistically /MakeIntuitionistically.
+ rewrite intuitionistic_intuitionistically //.
+Qed.
+Global Instance make_intuitionistically_default P :
+ MakeIntuitionistically P (â–¡ P) | 100.
+Proof. by rewrite /MakeIntuitionistically. Qed.
+
+Global Instance frame_intuitionistically R P Q Q' :
+ Frame true R P Q → MakeIntuitionistically Q Q' → Frame true R (□ P) Q'.
+Proof.
+ rewrite /Frame /MakeIntuitionistically=> <- <- /=.
+ rewrite -intuitionistically_sep_2 intuitionistically_idemp //.
+Qed.
+
+Global Instance make_absorbingly_emp : @KnownMakeAbsorbingly PROP emp True | 0.
+Proof.
+ by rewrite /KnownMakeAbsorbingly /MakeAbsorbingly
+ -absorbingly_True_emp absorbingly_pure.
+Qed.
+(* Note: there is no point in having an instance `Absorbing P → MakeAbsorbingly P P`
+because framing will never turn a proposition that is not absorbing into
+something that is absorbing. *)
+Global Instance make_absorbingly_default P : MakeAbsorbingly P (<absorb> P) | 100.
+Proof. by rewrite /MakeAbsorbingly. Qed.
+
+Global Instance frame_absorbingly p R P Q Q' :
+ Frame p R P Q → MakeAbsorbingly Q Q' → Frame p R (<absorb> P) Q'.
+Proof.
+ rewrite /Frame /MakeAbsorbingly=> <- <- /=. by rewrite absorbingly_sep_r.
+Qed.
+
+Global Instance make_persistently_true : @KnownMakePersistently PROP True True.
+Proof. by rewrite /KnownMakePersistently /MakePersistently persistently_pure. Qed.
+Global Instance make_persistently_emp : @KnownMakePersistently PROP emp True.
+Proof.
+ by rewrite /KnownMakePersistently /MakePersistently
+ -persistently_True_emp persistently_pure.
+Qed.
+Global Instance make_persistently_default P :
+ MakePersistently P (<pers> P) | 100.
+Proof. by rewrite /MakePersistently. Qed.
+
+Global Instance frame_persistently R P Q Q' :
+ Frame true R P Q → MakePersistently Q Q' → Frame true R (<pers> P) Q'.
+Proof.
+ rewrite /Frame /MakePersistently=> <- <- /=.
+ rewrite -persistently_and_intuitionistically_sep_l.
+ by rewrite -persistently_sep_2 -persistently_and_sep_l_1
+ persistently_affinely_elim persistently_idemp.
+Qed.
+
+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 → 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.
+
+Global Instance frame_impl_persistent R P1 P2 Q2 :
+ Frame true R P2 Q2 → Frame true R (P1 → P2) (P1 → Q2).
+Proof.
+ rewrite /Frame /= => ?. apply impl_intro_l.
+ by rewrite -persistently_and_intuitionistically_sep_l assoc (comm _ P1) -assoc impl_elim_r
+ persistently_and_intuitionistically_sep_l.
+Qed.
+Global Instance frame_impl R P1 P2 Q2 :
+ Persistent P1 → Absorbing P1 →
+ Frame false R P2 Q2 → Frame false R (P1 → P2) (P1 → Q2).
+Proof.
+ rewrite /Frame /==> ???. apply impl_intro_l.
+ rewrite {1}(persistent P1) persistently_and_intuitionistically_sep_l assoc.
+ rewrite (comm _ (â–¡ P1)%I) -assoc -persistently_and_intuitionistically_sep_l.
+ rewrite persistently_elim impl_elim_r //.
+Qed.
+End bi.
+
+(** SBI Framing *)
+Section sbi.
+Context {PROP : sbi}.
+Implicit Types P Q R : PROP.
+
+Global Instance frame_eq_embed `{SbiEmbed PROP PROP'} p P Q (Q' : PROP')
+ {A : ofeT} (a b : A) :
+ Frame p (a ≡ b) P Q → MakeEmbed Q Q' → Frame p (a ≡ b) ⎡P⎤ Q'.
+Proof. rewrite /Frame /MakeEmbed -embed_internal_eq. apply (frame_embed p P Q). Qed.
+
+Global Instance make_laterN_true n : @KnownMakeLaterN PROP n True True | 0.
+Proof. by rewrite /KnownMakeLaterN /MakeLaterN laterN_True. Qed.
+Global Instance make_laterN_emp `{!BiAffine PROP} n :
+ @KnownMakeLaterN PROP n emp emp | 0.
+Proof. by rewrite /KnownMakeLaterN /MakeLaterN laterN_emp. Qed.
+Global Instance make_laterN_default P : MakeLaterN n P (â–·^n P) | 100.
+Proof. by rewrite /MakeLaterN. Qed.
+
+Global Instance frame_later p R R' P Q Q' :
+ NoBackTrack (MaybeIntoLaterN true 1 R' R) →
+ Frame p R P Q → MakeLaterN 1 Q Q' → Frame p R' (▷ P) Q'.
+Proof.
+ rewrite /Frame /MakeLaterN /MaybeIntoLaterN=>-[->] <- <-.
+ by rewrite later_intuitionistically_if_2 later_sep.
+Qed.
+Global Instance frame_laterN p n R R' P Q Q' :
+ NoBackTrack (MaybeIntoLaterN true n R' R) →
+ Frame p R P Q → MakeLaterN n Q Q' → Frame p R' (▷^n P) Q'.
+Proof.
+ rewrite /Frame /MakeLaterN /MaybeIntoLaterN=>-[->] <- <-.
+ by rewrite laterN_intuitionistically_if_2 laterN_sep.
+Qed.
+
+Global Instance frame_bupd `{BiBUpd PROP} p R P Q :
+ Frame p R P Q → Frame p R (|==> P) (|==> Q).
+Proof. rewrite /Frame=><-. by rewrite bupd_frame_l. Qed.
+Global Instance frame_fupd `{BiFUpd PROP} p E1 E2 R P Q :
+ Frame p R P Q → Frame p R (|={E1,E2}=> P) (|={E1,E2}=> Q).
+Proof. rewrite /Frame=><-. by rewrite fupd_frame_l. Qed.
+
+Global Instance make_except_0_True : @KnownMakeExcept0 PROP True True.
+Proof. by rewrite /KnownMakeExcept0 /MakeExcept0 except_0_True. Qed.
+Global Instance make_except_0_default P : MakeExcept0 P (â—‡ P) | 100.
+Proof. by rewrite /MakeExcept0. Qed.
+
+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)%I).
+Qed.
+End sbi.
diff --git a/theories/proofmode/intro_patterns.v b/theories/proofmode/intro_patterns.v
index cc8feb04a746f5b61ad54dca1d413536c283167c..e24ab1e675ecc8b65a1901c5c5dc5283fdb2a5b5 100644
--- a/theories/proofmode/intro_patterns.v
+++ b/theories/proofmode/intro_patterns.v
@@ -128,11 +128,11 @@ Ltac parse s :=
| intro_pat => constr:([s])
| list string =>
lazymatch eval vm_compute in (mjoin <$> mapM parse s) with
- | Some ?pats => pats | _ => fail "invalid list intro_pat" s
+ | Some ?pats => pats | _ => fail "intro_pat.parse: cannot parse" s
end
| string =>
lazymatch eval vm_compute in (parse s) with
- | Some ?pats => pats | _ => fail "invalid list intro_pat" s
+ | Some ?pats => pats | _ => fail "intro_pat.parse: cannot parse" s
end
| ident => constr:([IIdent s])
| ?X => fail "intro_pat.parse:" s "has unexpected type" X
@@ -142,7 +142,7 @@ Ltac parse_one s :=
| intro_pat => s
| string =>
lazymatch eval vm_compute in (parse s) with
- | Some [?pat] => pat | _ => fail "invalid intro_pat" s
+ | Some [?pat] => pat | _ => fail "intro_pat.parse_one: cannot parse" s
end
| ?X => fail "intro_pat.parse_one:" s "has unexpected type" X
end.
diff --git a/theories/proofmode/ltac_tactics.v b/theories/proofmode/ltac_tactics.v
new file mode 100644
index 0000000000000000000000000000000000000000..b54edbd4d91808d4974bb42693c1f3042320d6cb
--- /dev/null
+++ b/theories/proofmode/ltac_tactics.v
@@ -0,0 +1,2217 @@
+From iris.proofmode Require Import coq_tactics reduction.
+From iris.proofmode Require Import base intro_patterns spec_patterns sel_patterns.
+From iris.bi Require Export bi telescopes.
+From stdpp Require Import namespaces.
+From iris.proofmode Require Export classes notation.
+From stdpp Require Import hlist pretty.
+Set Default Proof Using "Type".
+Export ident.
+
+(** For most of the tactics, we want to have tight control over the order and
+way in which type class inference is performed. To that end, many tactics make
+use of [notypeclasses refine] and the [iSolveTC] tactic to manually invoke type
+class inference.
+
+The tactic [iSolveTC] does not use [apply _], as that often leads to issues
+because it will try to solve all evars whose type is a typeclass, in
+dependency order (according to Matthieu). If one fails, it aborts. However, we
+generally rely on progress on the main goal to be solved to make progress
+elsewhere. With [typeclasses eauto], that seems to work better.
+
+A drawback of [typeclasses eauto] is that it is multi-success, i.e. whenever
+subsequent tactics fail, it will backtrack to [typeclasses eauto] to try the
+next type class instance. This is almost always undesired and leads to poor
+performance and horrible error messages, so we wrap it in a [once]. *)
+Ltac iSolveTC :=
+ solve [once (typeclasses eauto)].
+
+(** Tactic used for solving side-conditions arising from TC resolution in iMod
+and iInv. *)
+Ltac iSolveSideCondition :=
+ split_and?; try solve [ fast_done | solve_ndisj ].
+
+(** Used for printing [string]s and [ident]s. *)
+Ltac pretty_ident H :=
+ lazymatch H with
+ | INamed ?H => H
+ | ?H => H
+ end.
+
+(** * Misc *)
+
+Ltac iMissingHyps Hs :=
+ let Δ :=
+ lazymatch goal with
+ | |- envs_entails ?Δ _ => Δ
+ | |- context[ envs_split _ _ ?Δ ] => Δ
+ end in
+ let Hhyps := pm_eval (envs_dom Δ) in
+ eval vm_compute in (list_difference Hs Hhyps).
+
+Ltac iTypeOf H :=
+ let Δ := match goal with |- envs_entails ?Δ _ => Δ end in
+ pm_eval (envs_lookup H Δ).
+
+Tactic Notation "iMatchHyp" tactic1(tac) :=
+ match goal with
+ | |- context[ environments.Esnoc _ ?x ?P ] => tac x P
+ end.
+
+(** * Start a proof *)
+Tactic Notation "iStartProof" :=
+ lazymatch goal with
+ | |- envs_entails _ _ => idtac
+ | |- ?φ => notypeclasses refine (as_emp_valid_2 φ _ _);
+ [iSolveTC || fail "iStartProof: not a BI assertion"
+ |apply tac_adequate]
+ end.
+
+(* Same as above, with 2 differences :
+ - We can specify a BI in which we want the proof to be done
+ - If the goal starts with a let or a ∀, they are automatically
+ introduced. *)
+Tactic Notation "iStartProof" uconstr(PROP) :=
+ lazymatch goal with
+ | |- @envs_entails ?PROP' _ _ =>
+ (* This cannot be shared with the other [iStartProof], because
+ type_term has a non-negligeable performance impact. *)
+ let x := type_term (eq_refl : @eq Type PROP PROP') in idtac
+
+ (* We eta-expand [as_emp_valid_2], in order to make sure that
+ [iStartProof PROP] works even if [PROP] is the carrier type. In
+ this case, typing this expression will end up unifying PROP with
+ [bi_car _], and hence trigger the canonical structures mechanism
+ to find the corresponding bi. *)
+ | |- ?φ => notypeclasses refine ((λ P : PROP, @as_emp_valid_2 φ _ P) _ _ _);
+ [iSolveTC || fail "iStartProof: not a BI assertion"
+ |apply tac_adequate]
+ end.
+
+(** * Generate a fresh identifier *)
+(* Tactic Notation tactics cannot return terms *)
+Ltac iFresh :=
+ (* We need to increment the environment counter using [tac_fresh].
+ But because [iFresh] returns a value, we have to let bind
+ [tac_fresh] wrapped under a match to force evaluation of this
+ side-effect. See https://stackoverflow.com/a/46178884 *)
+ let do_incr :=
+ lazymatch goal with
+ | _ => iStartProof; eapply tac_fresh; first by (pm_reflexivity)
+ end in
+ lazymatch goal with
+ |- envs_entails ?Δ _ =>
+ let n := pm_eval (env_counter Δ) in
+ constr:(IAnon n)
+ end.
+
+(** * Simplification *)
+Tactic Notation "iEval" tactic(t) :=
+ iStartProof;
+ eapply tac_eval;
+ [let x := fresh in intros x; t; unfold x; reflexivity
+ |].
+
+Tactic Notation "iEval" tactic(t) "in" constr(H) :=
+ iStartProof;
+ eapply tac_eval_in with _ H _ _ _;
+ [pm_reflexivity || fail "iEval:" H "not found"
+ |let x := fresh in intros x; t; unfold x; reflexivity
+ |pm_reflexivity
+ |].
+
+Tactic Notation "iSimpl" := iEval simpl.
+Tactic Notation "iSimpl" "in" constr(H) := iEval simpl in H.
+
+(* It would be nice to also have an `iSsrRewrite`, however, for this we need to
+pass arguments to Ssreflect's `rewrite` like `/= foo /bar` in Ltac, see:
+
+ https://sympa.inria.fr/sympa/arc/coq-club/2018-01/msg00000.html
+
+PMP told me (= Robbert) in person that this is not possible today, but may be
+possible in Ltac2. *)
+
+(** * Context manipulation *)
+Tactic Notation "iRename" constr(H1) "into" constr(H2) :=
+ eapply tac_rename with _ H1 H2 _ _; (* (i:=H1) (j:=H2) *)
+ [pm_reflexivity ||
+ let H1 := pretty_ident H1 in
+ fail "iRename:" H1 "not found"
+ |pm_reflexivity ||
+ let H2 := pretty_ident H2 in
+ fail "iRename:" H2 "not fresh"|].
+
+Local Inductive esel_pat :=
+ | ESelPure
+ | ESelIdent : bool → ident → esel_pat.
+
+Local Ltac iElaborateSelPat_go pat Δ Hs :=
+ lazymatch pat with
+ | [] => eval cbv in Hs
+ | SelPure :: ?pat => iElaborateSelPat_go pat Δ (ESelPure :: Hs)
+ | SelPersistent :: ?pat =>
+ let Hs' := pm_eval (env_dom (env_intuitionistic Δ)) in
+ let Δ' := pm_eval (envs_clear_persistent Δ) in
+ iElaborateSelPat_go pat Δ' ((ESelIdent true <$> Hs') ++ Hs)
+ | SelSpatial :: ?pat =>
+ let Hs' := pm_eval (env_dom (env_spatial Δ)) in
+ let Δ' := pm_eval (envs_clear_spatial Δ) in
+ iElaborateSelPat_go pat Δ' ((ESelIdent false <$> Hs') ++ Hs)
+ | SelIdent ?H :: ?pat =>
+ lazymatch pm_eval (envs_lookup_delete false H Δ) with
+ | Some (?p,_,?Δ') => iElaborateSelPat_go pat Δ' (ESelIdent p H :: Hs)
+ | None =>
+ let H := pretty_ident H in
+ fail "iElaborateSelPat:" H "not found"
+ end
+ end.
+Ltac iElaborateSelPat pat :=
+ lazymatch goal with
+ | |- envs_entails ?Δ _ =>
+ let pat := sel_pat.parse pat in iElaborateSelPat_go pat Δ (@nil esel_pat)
+ end.
+
+Local Ltac iClearHyp H :=
+ eapply tac_clear with _ H _ _; (* (i:=H) *)
+ [pm_reflexivity ||
+ let H := pretty_ident H in
+ fail "iClear:" H "not found"
+ |pm_reduce; iSolveTC ||
+ let H := pretty_ident H in
+ let P := match goal with |- TCOr (Affine ?P) _ => P end in
+ fail "iClear:" H ":" P "not affine and the goal not absorbing"
+ |].
+
+Local Ltac iClear_go Hs :=
+ lazymatch Hs with
+ | [] => idtac
+ | ESelPure :: ?Hs => clear; iClear_go Hs
+ | ESelIdent _ ?H :: ?Hs => iClearHyp H; iClear_go Hs
+ end.
+Tactic Notation "iClear" constr(Hs) :=
+ iStartProof; let Hs := iElaborateSelPat Hs in iClear_go Hs.
+
+Tactic Notation "iClear" "(" ident_list(xs) ")" constr(Hs) :=
+ iClear Hs; clear xs.
+
+(** * Assumptions *)
+Tactic Notation "iExact" constr(H) :=
+ eapply tac_assumption with _ H _ _; (* (i:=H) *)
+ [pm_reflexivity ||
+ let H := pretty_ident H in
+ fail "iExact:" H "not found"
+ |iSolveTC ||
+ let H := pretty_ident H in
+ let P := match goal with |- FromAssumption _ ?P _ => P end in
+ fail "iExact:" H ":" P "does not match goal"
+ |pm_reduce; iSolveTC ||
+ let H := pretty_ident H in
+ fail "iExact:" H "not absorbing and the remaining hypotheses not affine"].
+
+Tactic Notation "iAssumptionCore" :=
+ let rec find Γ i P :=
+ lazymatch Γ with
+ | 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) =>
+ first [is_evar i; fail 1 | pm_reflexivity]
+ | |- envs_lookup ?i (Envs ?Γp ?Γs _) = Some (_, ?P) =>
+ is_evar i; first [find Γp i P | find Γs i P]; pm_reflexivity
+ | |- envs_lookup_delete _ ?i (Envs ?Γp ?Γs _) = Some (_, ?P, _) =>
+ first [is_evar i; fail 1 | pm_reflexivity]
+ | |- envs_lookup_delete _ ?i (Envs ?Γp ?Γs _) = Some (_, ?P, _) =>
+ is_evar i; first [find Γp i P | find Γs i P]; pm_reflexivity
+ end.
+
+Tactic Notation "iAssumption" :=
+ let Hass := fresh in
+ let rec find p Γ Q :=
+ lazymatch Γ with
+ | Esnoc ?Γ ?j ?P => first
+ [pose proof (_ : FromAssumption p P Q) as Hass;
+ eapply (tac_assumption _ _ j p P);
+ [pm_reflexivity
+ |apply Hass
+ |pm_reduce; iSolveTC ||
+ 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);
+ [pm_reflexivity
+ |exact Hass]
+ |find p Γ Q]
+ end in
+ lazymatch goal with
+ | |- envs_entails (Envs ?Γp ?Γs _) ?Q =>
+ first [find true Γp Q | find false Γs Q
+ |fail "iAssumption:" Q "not found"]
+ end.
+
+(** * False *)
+Tactic Notation "iExFalso" := apply tac_ex_falso.
+
+(** * Making hypotheses persistent or pure *)
+Local Tactic Notation "iPersistent" constr(H) :=
+ eapply tac_persistent with _ H _ _ _; (* (i:=H) *)
+ [pm_reflexivity ||
+ let H := pretty_ident H in
+ fail "iPersistent:" H "not found"
+ |iSolveTC ||
+ let P := match goal with |- IntoPersistent _ ?P _ => P end in
+ fail "iPersistent:" P "not persistent"
+ |pm_reduce; iSolveTC ||
+ let P := match goal with |- TCOr (Affine ?P) _ => P end in
+ fail "iPersistent:" P "not affine and the goal not absorbing"
+ |pm_reflexivity|].
+
+Local Tactic Notation "iPure" constr(H) "as" simple_intropattern(pat) :=
+ eapply tac_pure with _ H _ _ _; (* (i:=H1) *)
+ [pm_reflexivity ||
+ let H := pretty_ident H in
+ fail "iPure:" H "not found"
+ |iSolveTC ||
+ let P := match goal with |- IntoPure ?P _ => P end in
+ fail "iPure:" P "not pure"
+ |pm_reduce; iSolveTC ||
+ let P := match goal with |- TCOr (Affine ?P) _ => P end in
+ fail "iPure:" P "not affine and the goal not absorbing"
+ |intros pat].
+
+Tactic Notation "iEmpIntro" :=
+ iStartProof;
+ eapply tac_emp_intro;
+ [pm_reduce; iSolveTC ||
+ fail "iEmpIntro: spatial context contains non-affine hypotheses"].
+
+Tactic Notation "iPureIntro" :=
+ iStartProof;
+ eapply tac_pure_intro;
+ [pm_reflexivity
+ |iSolveTC ||
+ let P := match goal with |- FromPure _ ?P _ => P end in
+ fail "iPureIntro:" P "not pure"
+ |].
+
+(** Framing *)
+Local Ltac iFrameFinish :=
+ pm_prettify;
+ try match goal with
+ | |- envs_entails _ True => by iPureIntro
+ | |- envs_entails _ emp => iEmpIntro
+ end.
+
+Local Ltac iFramePure t :=
+ iStartProof;
+ let φ := type of t in
+ eapply (tac_frame_pure _ _ _ _ t);
+ [iSolveTC || fail "iFrame: cannot frame" φ
+ |iFrameFinish].
+
+Local Ltac iFrameHyp H :=
+ iStartProof;
+ eapply tac_frame with _ H _ _ _;
+ [pm_reflexivity ||
+ let H := pretty_ident H in
+ fail "iFrame:" H "not found"
+ |iSolveTC ||
+ let R := match goal with |- Frame _ ?R _ _ => R end in
+ fail "iFrame: cannot frame" R
+ |iFrameFinish].
+
+Local Ltac iFrameAnyPure :=
+ repeat match goal with H : _ |- _ => iFramePure H end.
+
+Local Ltac iFrameAnyPersistent :=
+ iStartProof;
+ let rec go Hs :=
+ match Hs with [] => idtac | ?H :: ?Hs => repeat iFrameHyp H; go Hs end in
+ match goal with
+ | |- envs_entails ?Δ _ =>
+ let Hs := eval cbv in (env_dom (env_intuitionistic Δ)) in go Hs
+ end.
+
+Local Ltac iFrameAnySpatial :=
+ iStartProof;
+ let rec go Hs :=
+ match Hs with [] => idtac | ?H :: ?Hs => try iFrameHyp H; go Hs end in
+ match goal with
+ | |- envs_entails ?Δ _ =>
+ let Hs := eval cbv in (env_dom (env_spatial Δ)) in go Hs
+ end.
+
+Tactic Notation "iFrame" := iFrameAnySpatial.
+
+Tactic Notation "iFrame" "(" constr(t1) ")" :=
+ iFramePure t1.
+Tactic Notation "iFrame" "(" constr(t1) constr(t2) ")" :=
+ iFramePure t1; iFrame ( t2 ).
+Tactic Notation "iFrame" "(" constr(t1) constr(t2) constr(t3) ")" :=
+ iFramePure t1; iFrame ( t2 t3 ).
+Tactic Notation "iFrame" "(" constr(t1) constr(t2) constr(t3) constr(t4) ")" :=
+ iFramePure t1; iFrame ( t2 t3 t4 ).
+Tactic Notation "iFrame" "(" constr(t1) constr(t2) constr(t3) constr(t4)
+ constr(t5) ")" :=
+ iFramePure t1; iFrame ( t2 t3 t4 t5 ).
+Tactic Notation "iFrame" "(" constr(t1) constr(t2) constr(t3) constr(t4)
+ constr(t5) constr(t6) ")" :=
+ iFramePure t1; iFrame ( t2 t3 t4 t5 t6 ).
+Tactic Notation "iFrame" "(" constr(t1) constr(t2) constr(t3) constr(t4)
+ constr(t5) constr(t6) constr(t7) ")" :=
+ iFramePure t1; iFrame ( t2 t3 t4 t5 t6 t7 ).
+Tactic Notation "iFrame" "(" constr(t1) constr(t2) constr(t3) constr(t4)
+ constr(t5) constr(t6) constr(t7) constr(t8)")" :=
+ iFramePure t1; iFrame ( t2 t3 t4 t5 t6 t7 t8 ).
+
+Local Ltac iFrame_go Hs :=
+ lazymatch Hs with
+ | [] => idtac
+ | SelPure :: ?Hs => iFrameAnyPure; iFrame_go Hs
+ | SelPersistent :: ?Hs => iFrameAnyPersistent; iFrame_go Hs
+ | SelSpatial :: ?Hs => iFrameAnySpatial; iFrame_go Hs
+ | SelIdent ?H :: ?Hs => iFrameHyp H; iFrame_go Hs
+ end.
+
+Tactic Notation "iFrame" constr(Hs) :=
+ let Hs := sel_pat.parse Hs in iFrame_go Hs.
+Tactic Notation "iFrame" "(" constr(t1) ")" constr(Hs) :=
+ iFramePure t1; iFrame Hs.
+Tactic Notation "iFrame" "(" constr(t1) constr(t2) ")" constr(Hs) :=
+ iFramePure t1; iFrame ( t2 ) Hs.
+Tactic Notation "iFrame" "(" constr(t1) constr(t2) constr(t3) ")" constr(Hs) :=
+ iFramePure t1; iFrame ( t2 t3 ) Hs.
+Tactic Notation "iFrame" "(" constr(t1) constr(t2) constr(t3) constr(t4) ")"
+ constr(Hs) :=
+ iFramePure t1; iFrame ( t2 t3 t4 ) Hs.
+Tactic Notation "iFrame" "(" constr(t1) constr(t2) constr(t3) constr(t4)
+ constr(t5) ")" constr(Hs) :=
+ iFramePure t1; iFrame ( t2 t3 t4 t5 ) Hs.
+Tactic Notation "iFrame" "(" constr(t1) constr(t2) constr(t3) constr(t4)
+ constr(t5) constr(t6) ")" constr(Hs) :=
+ iFramePure t1; iFrame ( t2 t3 t4 t5 t6 ) Hs.
+Tactic Notation "iFrame" "(" constr(t1) constr(t2) constr(t3) constr(t4)
+ constr(t5) constr(t6) constr(t7) ")" constr(Hs) :=
+ iFramePure t1; iFrame ( t2 t3 t4 t5 t6 t7 ) Hs.
+Tactic Notation "iFrame" "(" constr(t1) constr(t2) constr(t3) constr(t4)
+ constr(t5) constr(t6) constr(t7) constr(t8)")" constr(Hs) :=
+ iFramePure t1; iFrame ( t2 t3 t4 t5 t6 t7 t8 ) Hs.
+
+(** * Basic introduction tactics *)
+Local Tactic Notation "iIntro" "(" simple_intropattern(x) ")" :=
+ (* In the case the goal starts with an [let x := _ in _], we do not
+ want to unfold x and start the proof mode. Instead, we want to
+ use intros. So [iStartProof] has to be called only if [intros]
+ fails *)
+ intros x ||
+ (iStartProof;
+ lazymatch goal with
+ | |- envs_entails _ _ =>
+ eapply tac_forall_intro;
+ [iSolveTC ||
+ let P := match goal with |- FromForall ?P _ => P end in
+ fail "iIntro: cannot turn" P "into a universal quantifier"
+ |pm_prettify; intros x]
+ end).
+
+Local Tactic Notation "iIntro" constr(H) :=
+ iStartProof;
+ first
+ [ (* (?Q → _) *)
+ eapply tac_impl_intro with _ H _ _ _; (* (i:=H) *)
+ [iSolveTC
+ |pm_reduce; iSolveTC ||
+ let P := lazymatch goal with |- Persistent ?P => P end in
+ fail 1 "iIntro: introducing non-persistent" H ":" P
+ "into non-empty spatial context"
+ |pm_reflexivity ||
+ let H := pretty_ident H in
+ fail 1 "iIntro:" H "not fresh"
+ |iSolveTC
+ |]
+ | (* (_ -∗ _) *)
+ eapply tac_wand_intro with _ H _ _; (* (i:=H) *)
+ [iSolveTC
+ | pm_reflexivity ||
+ let H := pretty_ident H in
+ fail 1 "iIntro:" H "not fresh"
+ |]
+ | fail "iIntro: nothing to introduce" ].
+
+Local Tactic Notation "iIntro" "#" constr(H) :=
+ iStartProof;
+ first
+ [ (* (?P → _) *)
+ eapply tac_impl_intro_persistent with _ H _ _ _; (* (i:=H) *)
+ [iSolveTC
+ |iSolveTC ||
+ let P := match goal with |- IntoPersistent _ ?P _ => P end in
+ fail 1 "iIntro:" P "not persistent"
+ |pm_reflexivity ||
+ let H := pretty_ident H in
+ fail 1 "iIntro:" H "not fresh"
+ |]
+ | (* (?P -∗ _) *)
+ eapply tac_wand_intro_persistent with _ H _ _ _; (* (i:=H) *)
+ [ iSolveTC
+ | iSolveTC ||
+ let P := match goal with |- IntoPersistent _ ?P _ => P end in
+ fail 1 "iIntro:" P "not persistent"
+ |iSolveTC ||
+ let P := match goal with |- TCOr (Affine ?P) _ => P end in
+ fail 1 "iIntro:" P "not affine and the goal not absorbing"
+ |pm_reflexivity ||
+ let H := pretty_ident H in
+ fail 1 "iIntro:" H "not fresh"
+ |]
+ | fail "iIntro: nothing to introduce" ].
+
+Local Tactic Notation "iIntro" "_" :=
+ first
+ [ (* (?Q → _) *)
+ iStartProof; eapply tac_impl_intro_drop;
+ [ iSolveTC | ]
+ | (* (_ -∗ _) *)
+ iStartProof; eapply tac_wand_intro_drop;
+ [ iSolveTC
+ | iSolveTC ||
+ 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" :=
+ lazymatch goal with
+ | |- ∀ _, ?P => fail (* actually an →, this is handled by iIntro below *)
+ | |- ∀ _, _ => intro
+ | |- let _ := _ in _ => intro
+ | |- _ =>
+ iStartProof;
+ lazymatch goal with
+ | |- envs_entails _ (∀ x : _, _) => let x' := fresh x in iIntro (x')
+ end
+ end.
+Local Tactic Notation "iIntro" :=
+ lazymatch goal with
+ | |- _ → ?P => intro
+ | |- _ =>
+ iStartProof;
+ lazymatch goal with
+ | |- envs_entails _ (_ -∗ _) => iIntro (?) || let H := iFresh in iIntro #H || iIntro H
+ | |- envs_entails _ (_ → _) => iIntro (?) || let H := iFresh in iIntro #H || iIntro H
+ end
+ end.
+
+(** * Specialize *)
+Record iTrm {X As S} :=
+ ITrm { itrm : X ; itrm_vars : hlist As ; itrm_hyps : S }.
+Arguments ITrm {_ _ _} _ _ _.
+
+Notation "( H $! x1 .. xn )" :=
+ (ITrm H (hcons x1 .. (hcons xn hnil) ..) "") (at level 0, x1, xn at level 9).
+Notation "( H $! x1 .. xn 'with' pat )" :=
+ (ITrm H (hcons x1 .. (hcons xn hnil) ..) pat) (at level 0, x1, xn at level 9).
+Notation "( H 'with' pat )" := (ITrm H hnil pat) (at level 0).
+
+(** There is some hacky stuff going on here: because of Coq bug #6583, unresolved
+type classes in the arguments `xs` are resolved at arbitrary moments. Tactics
+like `apply`, `split` and `eexists` wrongly trigger type class search to resolve
+these holes. To avoid TC being triggered too eagerly, this tactic uses `refine`
+at most places instead of `apply`. *)
+Local Ltac iSpecializeArgs_go H xs :=
+ lazymatch xs with
+ | hnil => idtac
+ | hcons ?x ?xs =>
+ notypeclasses refine (tac_forall_specialize _ _ H _ _ _ _ _ _ _);
+ [pm_reflexivity ||
+ let H := pretty_ident H in
+ fail "iSpecialize:" H "not found"
+ |iSolveTC ||
+ let P := match goal with |- IntoForall ?P _ => P end in
+ fail "iSpecialize: cannot instantiate" P "with" x
+ |lazymatch goal with (* Force [A] in [ex_intro] to deal with coercions. *)
+ | |- ∃ _ : ?A, _ =>
+ notypeclasses refine (@ex_intro A _ x (conj _ _))
+ end; [shelve..|pm_reflexivity|iSpecializeArgs_go H xs]]
+ end.
+Local Tactic Notation "iSpecializeArgs" constr(H) open_constr(xs) :=
+ iSpecializeArgs_go H xs.
+
+Ltac iSpecializePat_go H1 pats :=
+ let solve_to_wand H1 :=
+ iSolveTC ||
+ let P := match goal with |- IntoWand _ _ ?P _ _ => P end in
+ fail "iSpecialize:" P "not an implication/wand" in
+ let solve_done d :=
+ lazymatch d with
+ | true =>
+ done ||
+ let Q := match goal with |- envs_entails _ ?Q => Q end in
+ fail "iSpecialize: cannot solve" Q "using done"
+ | false => idtac
+ end in
+ lazymatch pats with
+ | [] => idtac
+ | SForall :: ?pats =>
+ idtac "[IPM] The * specialization pattern is deprecated because it is applied implicitly.";
+ iSpecializePat_go H1 pats
+ | SIdent ?H2 :: ?pats =>
+ notypeclasses refine (tac_specialize _ _ _ H2 _ H1 _ _ _ _ _ _ _ _ _ _);
+ [pm_reflexivity ||
+ let H2 := pretty_ident H2 in
+ fail "iSpecialize:" H2 "not found"
+ |pm_reflexivity ||
+ let H1 := pretty_ident H1 in
+ fail "iSpecialize:" H1 "not found"
+ |iSolveTC ||
+ 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
+ |pm_reflexivity|iSpecializePat_go H1 pats]
+ | SPureGoal ?d :: ?pats =>
+ notypeclasses refine (tac_specialize_assert_pure _ _ H1 _ _ _ _ _ _ _ _ _ _ _ _);
+ [pm_reflexivity ||
+ let H1 := pretty_ident H1 in
+ fail "iSpecialize:" H1 "not found"
+ |solve_to_wand H1
+ |iSolveTC ||
+ let Q := match goal with |- FromPure _ ?Q _ => Q end in
+ fail "iSpecialize:" Q "not pure"
+ |pm_reflexivity
+ |solve_done d (*goal*)
+ |iSpecializePat_go H1 pats]
+ | SGoal (SpecGoal GPersistent false ?Hs_frame [] ?d) :: ?pats =>
+ notypeclasses refine (tac_specialize_assert_persistent _ _ _ H1 _ _ _ _ _ _ _ _ _ _ _ _ _);
+ [pm_reflexivity ||
+ let H1 := pretty_ident H1 in
+ fail "iSpecialize:" H1 "not found"
+ |solve_to_wand H1
+ |iSolveTC ||
+ let Q := match goal with |- Persistent ?Q => Q end in
+ fail "iSpecialize:" Q "not persistent"
+ |iSolveTC
+ |pm_reflexivity
+ |iFrame Hs_frame; solve_done d (*goal*)
+ |iSpecializePat_go H1 pats]
+ | SGoal (SpecGoal GPersistent _ _ _ _) :: ?pats =>
+ fail "iSpecialize: cannot select hypotheses for persistent premise"
+ | SGoal (SpecGoal ?m ?lr ?Hs_frame ?Hs ?d) :: ?pats =>
+ let Hs' := eval cbv in (if lr then Hs else Hs_frame ++ Hs) in
+ notypeclasses refine (tac_specialize_assert _ _ _ _ H1 _ lr Hs' _ _ _ _ _ _ _ _ _ _ _);
+ [pm_reflexivity ||
+ let H1 := pretty_ident H1 in
+ fail "iSpecialize:" H1 "not found"
+ |solve_to_wand H1
+ |lazymatch m with
+ | GSpatial => notypeclasses refine (add_modal_id _ _)
+ | GModal => iSolveTC || fail "iSpecialize: goal not a modality"
+ end
+ |pm_reflexivity ||
+ let Hs' := iMissingHyps Hs' in
+ fail "iSpecialize: hypotheses" Hs' "not found"
+ |iFrame Hs_frame; solve_done d (*goal*)
+ |iSpecializePat_go H1 pats]
+ | SAutoFrame GPersistent :: ?pats =>
+ notypeclasses refine (tac_specialize_assert_persistent _ _ _ H1 _ _ _ _ _ _ _ _ _ _ _ _ _);
+ [pm_reflexivity ||
+ let H1 := pretty_ident H1 in
+ fail "iSpecialize:" H1 "not found"
+ |solve_to_wand H1
+ |iSolveTC ||
+ let Q := match goal with |- Persistent ?Q => Q end in
+ fail "iSpecialize:" Q "not persistent"
+ |pm_reflexivity
+ |solve [iFrame "∗ #"]
+ |iSpecializePat_go H1 pats]
+ | SAutoFrame ?m :: ?pats =>
+ notypeclasses refine (tac_specialize_frame _ _ H1 _ _ _ _ _ _ _ _ _ _ _ _);
+ [pm_reflexivity ||
+ let H1 := pretty_ident H1 in
+ fail "iSpecialize:" H1 "not found"
+ |solve_to_wand H1
+ |lazymatch m with
+ | GSpatial => notypeclasses refine (add_modal_id _ _)
+ | GModal => iSolveTC || fail "iSpecialize: goal not a modality"
+ end
+ |first
+ [notypeclasses refine (tac_unlock_emp _ _ _)
+ |notypeclasses refine (tac_unlock_True _ _ _)
+ |iFrame "∗ #"; notypeclasses refine (tac_unlock _ _ _)
+ |fail "iSpecialize: premise cannot be solved by framing"]
+ |exact eq_refl]; iIntro H1; iSpecializePat_go H1 pats
+ end.
+
+Local Tactic Notation "iSpecializePat" open_constr(H) constr(pat) :=
+ let pats := spec_pat.parse pat in iSpecializePat_go H pats.
+
+(* The argument [p] denotes whether the conclusion of the specialized term is
+persistent. If so, one can use all spatial hypotheses for both proving the
+premises and the remaning goal. The argument [p] can either be a Boolean or an
+introduction pattern, which will be coerced into [true] when it solely contains
+`#` or `%` patterns at the top-level.
+
+In case the specialization pattern in [t] states that the modality of the goal
+should be kept for one of the premises (i.e. [>[H1 .. Hn]] is used) then [p]
+defaults to [false] (i.e. spatial hypotheses are not preserved). *)
+Tactic Notation "iSpecializeCore" open_constr(H)
+ "with" open_constr(xs) open_constr(pat) "as" constr(p) :=
+ let p := intro_pat_persistent p in
+ let pat := spec_pat.parse pat in
+ let H :=
+ lazymatch type of H with
+ | string => constr:(INamed H)
+ | _ => H
+ end in
+ iSpecializeArgs H xs; [..|
+ lazymatch type of H with
+ | ident =>
+ (* The lemma [tac_specialize_persistent_helper] allows one to use all
+ spatial hypotheses for both proving the premises of the lemma we
+ specialize as well as those of the remaining goal. We can only use it when
+ 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
+ (p && bool_decide (pat ≠[]) && negb (existsb spec_pat_modal pat)) with
+ | true =>
+ (* FIXME: do something reasonable when the BI is not affine *)
+ notypeclasses refine (tac_specialize_persistent_helper _ _ H _ _ _ _ _ _ _ _ _ _ _);
+ [pm_reflexivity ||
+ let H := pretty_ident H in
+ fail "iSpecialize:" H "not found"
+ |iSpecializePat H pat;
+ [..
+ |notypeclasses refine (tac_specialize_persistent_helper_done _ H _ _ _);
+ pm_reflexivity]
+ |iSolveTC ||
+ let Q := match goal with |- IntoPersistent _ ?Q _ => Q end in
+ fail "iSpecialize:" Q "not persistent"
+ |pm_reduce; iSolveTC ||
+ let Q := match goal with |- TCAnd _ (Affine ?Q) => Q end in
+ fail "iSpecialize:" Q "not affine"
+ |pm_reflexivity
+ |(* goal *)]
+ | false => iSpecializePat H pat
+ end
+ | _ => fail "iSpecialize:" H "should be a hypothesis, use iPoseProof instead"
+ end].
+
+Tactic Notation "iSpecializeCore" open_constr(t) "as" constr(p) :=
+ lazymatch type of t with
+ | string => iSpecializeCore t with hnil "" as p
+ | ident => iSpecializeCore t with hnil "" as p
+ | _ =>
+ lazymatch t with
+ | ITrm ?H ?xs ?pat => iSpecializeCore H with xs pat as p
+ | _ => fail "iSpecialize:" t "should be a proof mode term"
+ end
+ end.
+
+Tactic Notation "iSpecialize" open_constr(t) :=
+ iSpecializeCore t as false.
+Tactic Notation "iSpecialize" open_constr(t) "as" "#" :=
+ iSpecializeCore t as true.
+
+(** * Pose proof *)
+(* The tactic [iIntoEmpValid] tactic solves a goal [bi_emp_valid Q]. The
+argument [t] must be a Coq term whose type is of the following shape:
+
+[∀ (x_1 : A_1) .. (x_n : A_n), φ]
+
+and so that we have an instance `AsValid φ Q`.
+
+Examples of such [φ]s are
+
+- [bi_emp_valid P], in which case [Q] should be [P]
+- [P1 ⊢ P2], in which case [Q] should be [P1 -∗ P2]
+- [P1 ⊣⊢ P2], in which case [Q] should be [P1 ↔ P2]
+
+The tactic instantiates each dependent argument [x_i] with an evar and generates
+a goal [R] for each non-dependent argument [x_i : R]. For example, if the
+original goal was [Q] and [t] has type [∀ x, P x → Q], then it generates an evar
+[?x] for [x] and a subgoal [P ?x]. *)
+Tactic Notation "iIntoEmpValid" open_constr(t) :=
+ let rec go t :=
+ (* We try two reduction tactics for the type of t before trying to
+ specialize it. We first try the head normal form in order to
+ unfold all the definition that could hide an entailment. Then,
+ we try the much weaker [eval cbv zeta], because entailment is
+ not necessarilly opaque, and could be unfolded by [hnf].
+
+ However, for calling type class search, we only use [cbv zeta]
+ in order to make sure we do not unfold [bi_emp_valid]. *)
+ let tT := type of t in
+ first
+ [ let tT' := eval hnf in tT in go_specialize t tT'
+ | let tT' := eval cbv zeta in tT in go_specialize t tT'
+ | let tT' := eval cbv zeta in tT in
+ notypeclasses refine (as_emp_valid_1 tT _ _);
+ [iSolveTC || fail 1 "iPoseProof: not a BI assertion"
+ |exact t]]
+ with go_specialize t tT :=
+ lazymatch tT with (* We do not use hnf of tT, because, if
+ entailment is not opaque, then it would
+ unfold it. *)
+ | ?P → ?Q => let H := fresh in assert P as H; [|go uconstr:(t H); clear H]
+ | ∀ _ : ?T, _ =>
+ (* Put [T] inside an [id] to avoid TC inference from being invoked. *)
+ (* This is a workarround for Coq bug #6583. *)
+ let e := fresh in evar (e:id T);
+ let e' := eval unfold e in e in clear e; go (t e')
+ end
+ in
+ go t.
+
+(* The tactic [tac] is called with a temporary fresh name [H]. The argument
+[lazy_tc] denotes whether type class inference on the premises of [lem] should
+be performed before (if false) or after (if true) [tac H] is called.
+
+The tactic [iApply] uses laxy type class inference, so that evars can first be
+instantiated by matching with the goal, whereas [iDestruct] does not, because
+eliminations may not be performed when type classes have not been resolved.
+*)
+Local Ltac iPoseProofCore_go Htmp t goal_tac :=
+ lazymatch type of t with
+ | ident =>
+ eapply tac_pose_proof_hyp with _ _ t _ Htmp _;
+ [pm_reflexivity ||
+ let t := pretty_ident t in
+ fail "iPoseProof:" t "not found"
+ |pm_reflexivity ||
+ let Htmp := pretty_ident Htmp in
+ fail "iPoseProof:" Htmp "not fresh"
+ |goal_tac ()]
+ | _ =>
+ eapply tac_pose_proof with _ Htmp _; (* (j:=H) *)
+ [iIntoEmpValid t
+ |pm_reflexivity ||
+ let Htmp := pretty_ident Htmp in
+ fail "iPoseProof:" Htmp "not fresh"
+ |goal_tac ()]
+ end;
+ try iSolveTC.
+Tactic Notation "iPoseProofCore" open_constr(lem)
+ "as" constr(p) constr(lazy_tc) tactic(tac) :=
+ iStartProof;
+ let Htmp := iFresh in
+ let t := lazymatch lem with ITrm ?t ?xs ?pat => t | _ => lem end in
+ let t := lazymatch type of t with string => constr:(INamed t) | _ => t end in
+ let spec_tac _ :=
+ lazymatch lem with
+ | ITrm ?t ?xs ?pat => iSpecializeCore (ITrm Htmp xs pat) as p
+ | _ => idtac
+ end in
+ lazymatch eval compute in lazy_tc with
+ | true => iPoseProofCore_go Htmp t ltac:(fun _ => spec_tac (); last (tac Htmp))
+ | false => iPoseProofCore_go Htmp t spec_tac; last (tac Htmp)
+ end.
+
+(** * Apply *)
+Tactic Notation "iApplyHyp" constr(H) :=
+ let rec go H := first
+ [eapply tac_apply with _ H _ _ _;
+ [pm_reflexivity
+ |iSolveTC
+ |pm_prettify (* reduce redexes created by instantiation *)
+ ]
+ |iSpecializePat H "[]"; last go H] in
+ iExact H ||
+ go H ||
+ lazymatch iTypeOf H with
+ | Some (_,?Q) => fail "iApply: cannot apply" Q
+ end.
+
+Tactic Notation "iApply" open_constr(lem) :=
+ iPoseProofCore lem as false true (fun H => iApplyHyp H).
+
+(** * Revert *)
+Local Tactic Notation "iForallRevert" ident(x) :=
+ let err x :=
+ intros x;
+ iMatchHyp (fun H P =>
+ lazymatch P with
+ | context [x] => fail 2 "iRevert:" x "is used in hypothesis" H
+ end) in
+ iStartProof;
+ let A := type of x in
+ lazymatch type of A with
+ | Prop => revert x; first [apply tac_pure_revert|err x]
+ | _ => revert x; first [apply tac_forall_revert|err x]
+ end.
+
+Tactic Notation "iRevert" constr(Hs) :=
+ let rec go Hs :=
+ lazymatch Hs with
+ | [] => idtac
+ | ESelPure :: ?Hs =>
+ repeat match goal with x : _ |- _ => revert x end;
+ go Hs
+ | ESelIdent _ ?H :: ?Hs =>
+ eapply tac_revert with _ H _ _; (* (i:=H2) *)
+ [pm_reflexivity ||
+ let H := pretty_ident H in
+ fail "iRevert:" H "not found"
+ |pm_reduce; go Hs]
+ end in
+ iStartProof; let Hs := iElaborateSelPat Hs in go Hs.
+
+Tactic Notation "iRevert" "(" ident(x1) ")" :=
+ iForallRevert x1.
+Tactic Notation "iRevert" "(" ident(x1) ident(x2) ")" :=
+ iForallRevert x2; iRevert ( x1 ).
+Tactic Notation "iRevert" "(" ident(x1) ident(x2) ident(x3) ")" :=
+ iForallRevert x3; iRevert ( x1 x2 ).
+Tactic Notation "iRevert" "(" ident(x1) ident(x2) ident(x3) ident(x4) ")" :=
+ iForallRevert x4; iRevert ( x1 x2 x3 ).
+Tactic Notation "iRevert" "(" ident(x1) ident(x2) ident(x3) ident(x4)
+ ident(x5) ")" :=
+ iForallRevert x5; iRevert ( x1 x2 x3 x4 ).
+Tactic Notation "iRevert" "(" ident(x1) ident(x2) ident(x3) ident(x4)
+ ident(x5) ident(x6) ")" :=
+ iForallRevert x6; iRevert ( x1 x2 x3 x4 x5 ).
+Tactic Notation "iRevert" "(" ident(x1) ident(x2) ident(x3) ident(x4)
+ ident(x5) ident(x6) ident(x7) ")" :=
+ iForallRevert x7; iRevert ( x1 x2 x3 x4 x5 x6 ).
+Tactic Notation "iRevert" "(" ident(x1) ident(x2) ident(x3) ident(x4)
+ ident(x5) ident(x6) ident(x7) ident(x8) ")" :=
+ iForallRevert x8; iRevert ( x1 x2 x3 x4 x5 x6 x7 ).
+
+Tactic Notation "iRevert" "(" ident(x1) ")" constr(Hs) :=
+ iRevert Hs; iRevert ( x1 ).
+Tactic Notation "iRevert" "(" ident(x1) ident(x2) ")" constr(Hs) :=
+ iRevert Hs; iRevert ( x1 x2 ).
+Tactic Notation "iRevert" "(" ident(x1) ident(x2) ident(x3) ")" constr(Hs) :=
+ iRevert Hs; iRevert ( x1 x2 x3 ).
+Tactic Notation "iRevert" "(" ident(x1) ident(x2) ident(x3) ident(x4) ")"
+ constr(Hs) :=
+ iRevert Hs; iRevert ( x1 x2 x3 x4 ).
+Tactic Notation "iRevert" "(" ident(x1) ident(x2) ident(x3) ident(x4)
+ ident(x5) ")" constr(Hs) :=
+ iRevert Hs; iRevert ( x1 x2 x3 x4 x5 ).
+Tactic Notation "iRevert" "(" ident(x1) ident(x2) ident(x3) ident(x4)
+ ident(x5) ident(x6) ")" constr(Hs) :=
+ iRevert Hs; iRevert ( x1 x2 x3 x4 x5 x6 ).
+Tactic Notation "iRevert" "(" ident(x1) ident(x2) ident(x3) ident(x4)
+ ident(x5) ident(x6) ident(x7) ")" constr(Hs) :=
+ iRevert Hs; iRevert ( x1 x2 x3 x4 x5 x6 x7 ).
+Tactic Notation "iRevert" "(" ident(x1) ident(x2) ident(x3) ident(x4)
+ ident(x5) ident(x6) ident(x7) ident(x8) ")" constr(Hs) :=
+ iRevert Hs; iRevert ( x1 x2 x3 x4 x5 x6 x7 x8 ).
+
+(** * Disjunction *)
+Tactic Notation "iLeft" :=
+ iStartProof;
+ eapply tac_or_l;
+ [iSolveTC ||
+ let P := match goal with |- FromOr ?P _ _ => P end in
+ fail "iLeft:" P "not a disjunction"
+ |].
+Tactic Notation "iRight" :=
+ iStartProof;
+ eapply tac_or_r;
+ [iSolveTC ||
+ let P := match goal with |- FromOr ?P _ _ => P end in
+ fail "iRight:" P "not a disjunction"
+ |].
+
+Local Tactic Notation "iOrDestruct" constr(H) "as" constr(H1) constr(H2) :=
+ eapply tac_or_destruct with _ _ H _ H1 H2 _ _ _; (* (i:=H) (j1:=H1) (j2:=H2) *)
+ [pm_reflexivity ||
+ let H := pretty_ident H in
+ fail "iOrDestruct:" H "not found"
+ |iSolveTC ||
+ let P := match goal with |- IntoOr ?P _ _ => P end in
+ fail "iOrDestruct: cannot destruct" P
+ |pm_reflexivity ||
+ let H1 := pretty_ident H1 in
+ fail "iOrDestruct:" H1 "not fresh"
+ |pm_reflexivity ||
+ let H2 := pretty_ident H2 in
+ fail "iOrDestruct:" H2 "not fresh"
+ | |].
+
+(** * Conjunction and separating conjunction *)
+Tactic Notation "iSplit" :=
+ iStartProof;
+ eapply tac_and_split;
+ [iSolveTC ||
+ let P := match goal with |- FromAnd ?P _ _ => P end in
+ fail "iSplit:" P "not a conjunction"| |].
+
+Tactic Notation "iSplitL" constr(Hs) :=
+ iStartProof;
+ let Hs := words Hs in
+ let Hs := eval vm_compute in (INamed <$> Hs) in
+ eapply tac_sep_split with _ _ Left Hs _ _; (* (js:=Hs) *)
+ [iSolveTC ||
+ let P := match goal with |- FromSep _ ?P _ _ => P end in
+ fail "iSplitL:" P "not a separating conjunction"
+ |pm_reflexivity ||
+ let Hs := iMissingHyps Hs in
+ fail "iSplitL: hypotheses" Hs "not found"
+ | |].
+
+Tactic Notation "iSplitR" constr(Hs) :=
+ iStartProof;
+ let Hs := words Hs in
+ let Hs := eval vm_compute in (INamed <$> Hs) in
+ eapply tac_sep_split with _ _ Right Hs _ _; (* (js:=Hs) *)
+ [iSolveTC ||
+ let P := match goal with |- FromSep _ ?P _ _ => P end in
+ fail "iSplitR:" P "not a separating conjunction"
+ |pm_reflexivity ||
+ let Hs := iMissingHyps Hs in
+ fail "iSplitR: hypotheses" Hs "not found"
+ | |].
+
+Tactic Notation "iSplitL" := iSplitR "".
+Tactic Notation "iSplitR" := iSplitL "".
+
+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) *)
+ [pm_reflexivity ||
+ let H := pretty_ident H in
+ fail "iAndDestruct:" H "not found"
+ |pm_reduce; iSolveTC ||
+ let P :=
+ lazymatch goal with
+ | |- IntoSep ?P _ _ => P
+ | |- IntoAnd _ ?P _ _ => P
+ end in
+ fail "iAndDestruct: cannot destruct" P
+ |pm_reflexivity ||
+ let H1 := pretty_ident H1 in
+ let H2 := pretty_ident H2 in
+ fail "iAndDestruct:" H1 "or" H2 " not fresh"|].
+
+Local Tactic Notation "iAndDestructChoice" constr(H) "as" constr(d) constr(H') :=
+ eapply tac_and_destruct_choice with _ H _ d H' _ _ _;
+ [pm_reflexivity || fail "iAndDestructChoice:" H "not found"
+ |pm_reduce; iSolveTC ||
+ let P := match goal with |- TCOr (IntoAnd _ ?P _ _) _ => P end in
+ fail "iAndDestructChoice: cannot destruct" P
+ |pm_reflexivity ||
+ let H' := pretty_ident H' in
+ fail "iAndDestructChoice:" H' " not fresh"|].
+
+(** * Existential *)
+Tactic Notation "iExists" uconstr(x1) :=
+ iStartProof;
+ eapply tac_exist;
+ [iSolveTC ||
+ let P := match goal with |- FromExist ?P _ => P end in
+ fail "iExists:" P "not an existential"
+ |pm_prettify; eexists x1].
+
+Tactic Notation "iExists" uconstr(x1) "," uconstr(x2) :=
+ iExists x1; iExists x2.
+Tactic Notation "iExists" uconstr(x1) "," uconstr(x2) "," uconstr(x3) :=
+ iExists x1; iExists x2, x3.
+Tactic Notation "iExists" uconstr(x1) "," uconstr(x2) "," uconstr(x3) ","
+ uconstr(x4) :=
+ iExists x1; iExists x2, x3, x4.
+Tactic Notation "iExists" uconstr(x1) "," uconstr(x2) "," uconstr(x3) ","
+ uconstr(x4) "," uconstr(x5) :=
+ iExists x1; iExists x2, x3, x4, x5.
+Tactic Notation "iExists" uconstr(x1) "," uconstr(x2) "," uconstr(x3) ","
+ uconstr(x4) "," uconstr(x5) "," uconstr(x6) :=
+ iExists x1; iExists x2, x3, x4, x5, x6.
+Tactic Notation "iExists" uconstr(x1) "," uconstr(x2) "," uconstr(x3) ","
+ uconstr(x4) "," uconstr(x5) "," uconstr(x6) "," uconstr(x7) :=
+ iExists x1; iExists x2, x3, x4, x5, x6, x7.
+Tactic Notation "iExists" uconstr(x1) "," uconstr(x2) "," uconstr(x3) ","
+ uconstr(x4) "," uconstr(x5) "," uconstr(x6) "," uconstr(x7) ","
+ uconstr(x8) :=
+ iExists x1; iExists x2, x3, x4, x5, x6, x7, x8.
+
+Local Tactic Notation "iExistDestruct" constr(H)
+ "as" simple_intropattern(x) constr(Hx) :=
+ eapply tac_exist_destruct with H _ Hx _ _; (* (i:=H) (j:=Hx) *)
+ [pm_reflexivity ||
+ let H := pretty_ident H in
+ fail "iExistDestruct:" H "not found"
+ |iSolveTC ||
+ let P := match goal with |- IntoExist ?P _ => P end in
+ fail "iExistDestruct: cannot destruct" P|];
+ let y := fresh in
+ intros y; eexists; split;
+ [pm_reflexivity ||
+ let Hx := pretty_ident Hx in
+ fail "iExistDestruct:" Hx "not fresh"
+ |revert y; intros x].
+
+(** * Modality introduction *)
+Tactic Notation "iModIntro" uconstr(sel) :=
+ iStartProof;
+ notypeclasses refine (tac_modal_intro _ sel _ _ _ _ _ _ _ _ _ _ _ _ _);
+ [iSolveTC ||
+ fail "iModIntro: the goal is not a modality"
+ |iSolveTC ||
+ let s := lazymatch goal with |- IntoModalPersistentEnv _ _ _ ?s => s end in
+ lazymatch eval hnf in s with
+ | MIEnvForall ?C => fail "iModIntro: persistent context does not satisfy" C
+ | MIEnvIsEmpty => fail "iModIntro: persistent context is non-empty"
+ end
+ |iSolveTC ||
+ let s := lazymatch goal with |- IntoModalSpatialEnv _ _ _ ?s _ => s end in
+ lazymatch eval hnf in s with
+ | MIEnvForall ?C => fail "iModIntro: spatial context does not satisfy" C
+ | MIEnvIsEmpty => fail "iModIntro: spatial context is non-empty"
+ end
+ |pm_reduce; iSolveTC ||
+ fail "iModIntro: cannot filter spatial context when goal is not absorbing"
+ |pm_prettify (* reduce redexes created by instantiation *)
+ ].
+Tactic Notation "iModIntro" := iModIntro _.
+Tactic Notation "iAlways" := iModIntro.
+
+(** * Later *)
+Tactic Notation "iNext" open_constr(n) := iModIntro (â–·^n _)%I.
+Tactic Notation "iNext" := iModIntro (â–·^_ _)%I.
+
+(** * Update modality *)
+Tactic Notation "iModCore" constr(H) :=
+ eapply tac_modal_elim with _ H _ _ _ _ _ _;
+ [pm_reflexivity || fail "iMod:" H "not found"
+ |iSolveTC ||
+ let P := match goal with |- ElimModal _ _ _ ?P _ _ _ => P end in
+ let Q := match goal with |- ElimModal _ _ _ _ _ ?Q _ => Q end in
+ fail "iMod: cannot eliminate modality " P "in" Q
+ |iSolveSideCondition
+ |pm_reflexivity|].
+
+(** * Basic destruct tactic *)
+Tactic Notation "iDestructHyp" constr(H) "as" constr(pat) :=
+ let rec go Hz pat :=
+ lazymatch pat with
+ | IAnom =>
+ lazymatch Hz with
+ | IAnon _ => idtac
+ | INamed ?Hz => let Hz' := iFresh in iRename Hz into Hz'
+ end
+ | IDrop => iClearHyp Hz
+ | IFrame => iFrameHyp Hz
+ | IIdent ?y => iRename Hz into y
+ | IList [[]] => iExFalso; iExact Hz
+ | IList [[?pat1; IDrop]] => iAndDestructChoice Hz as Left Hz; go Hz pat1
+ | IList [[IDrop; ?pat2]] => iAndDestructChoice Hz as Right Hz; go Hz pat2
+ | IList [[?pat1; ?pat2]] =>
+ let Hy := iFresh in iAndDestruct Hz as Hz Hy; go Hz pat1; go Hy pat2
+ | IList [[?pat1];[?pat2]] => iOrDestruct Hz as Hz Hz; [go Hz pat1|go Hz pat2]
+ | IPureElim => iPure Hz as ?
+ | IRewrite Right => iPure Hz as ->
+ | IRewrite Left => iPure Hz as <-
+ | IAlwaysElim ?pat => iPersistent Hz; go Hz pat
+ | IModalElim ?pat => iModCore Hz; go Hz pat
+ | _ => fail "iDestruct:" pat "invalid"
+ end in
+ let rec find_pat found pats :=
+ lazymatch pats with
+ | [] =>
+ lazymatch found with
+ | true => pm_prettify (* post-tactic prettification *)
+ | false => fail "iDestruct:" pat "should contain exactly one proper introduction pattern"
+ end
+ | ISimpl :: ?pats => simpl; find_pat found pats
+ | IClear ?H :: ?pats => iClear H; find_pat found pats
+ | IClearFrame ?H :: ?pats => iFrame H; find_pat found pats
+ | ?pat :: ?pats =>
+ lazymatch found with
+ | false => go H pat; find_pat true pats
+ | true => fail "iDestruct:" pat "should contain exactly one proper introduction pattern"
+ end
+ end in
+ let pats := intro_pat.parse pat in
+ find_pat false pats.
+
+Tactic Notation "iDestructHyp" constr(H) "as" "(" simple_intropattern(x1) ")"
+ constr(pat) :=
+ iExistDestruct H as x1 H; iDestructHyp H as @ pat.
+Tactic Notation "iDestructHyp" constr(H) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) ")" constr(pat) :=
+ iExistDestruct H as x1 H; iDestructHyp H as ( x2 ) pat.
+Tactic Notation "iDestructHyp" constr(H) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) ")" constr(pat) :=
+ iExistDestruct H as x1 H; iDestructHyp H as ( x2 x3 ) pat.
+Tactic Notation "iDestructHyp" constr(H) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4) ")"
+ constr(pat) :=
+ iExistDestruct H as x1 H; iDestructHyp H as ( x2 x3 x4 ) pat.
+Tactic Notation "iDestructHyp" constr(H) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
+ simple_intropattern(x5) ")" constr(pat) :=
+ iExistDestruct H as x1 H; iDestructHyp H as ( x2 x3 x4 x5 ) pat.
+Tactic Notation "iDestructHyp" constr(H) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
+ simple_intropattern(x5) simple_intropattern(x6) ")" constr(pat) :=
+ iExistDestruct H as x1 H; iDestructHyp H as ( x2 x3 x4 x5 x6 ) pat.
+Tactic Notation "iDestructHyp" constr(H) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
+ simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7) ")"
+ constr(pat) :=
+ iExistDestruct H as x1 H; iDestructHyp H as ( x2 x3 x4 x5 x6 x7 ) pat.
+Tactic Notation "iDestructHyp" constr(H) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
+ simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7)
+ simple_intropattern(x8) ")" constr(pat) :=
+ iExistDestruct H as x1 H; iDestructHyp H as ( x2 x3 x4 x5 x6 x7 x8 ) pat.
+
+(** * Combinining hypotheses *)
+Tactic Notation "iCombine" constr(Hs) "as" constr(pat) :=
+ let Hs := words Hs in
+ let Hs := eval vm_compute in (INamed <$> Hs) in
+ let H := iFresh in
+ eapply tac_combine with _ _ Hs _ _ H _;
+ [pm_reflexivity ||
+ let Hs := iMissingHyps Hs in
+ fail "iCombine: hypotheses" Hs "not found"
+ |iSolveTC
+ |pm_reflexivity ||
+ let H := pretty_ident H in
+ fail "iCombine:" H "not fresh"
+ |iDestructHyp H as pat].
+
+Tactic Notation "iCombine" constr(H1) constr(H2) "as" constr(pat) :=
+ iCombine [H1;H2] as pat.
+
+(** * Introduction tactic *)
+Ltac iIntros_go pats startproof :=
+ lazymatch pats with
+ | [] =>
+ lazymatch startproof with
+ | true => iStartProof
+ | false => idtac
+ end
+ (* Optimizations to avoid generating fresh names *)
+ | IPureElim :: ?pats => iIntro (?); iIntros_go pats startproof
+ | IAlwaysElim (IIdent ?H) :: ?pats => iIntro #H; iIntros_go pats false
+ | IDrop :: ?pats => iIntro _; iIntros_go pats startproof
+ | IIdent ?H :: ?pats => iIntro H; iIntros_go pats startproof
+ (* Introduction patterns that can only occur at the top-level *)
+ | IPureIntro :: ?pats => iPureIntro; iIntros_go pats false
+ | IAlwaysIntro :: ?pats => iAlways; iIntros_go pats false
+ | IModalIntro :: ?pats => iModIntro; iIntros_go pats false
+ | IForall :: ?pats => repeat iIntroForall; iIntros_go pats startproof
+ | IAll :: ?pats => repeat (iIntroForall || iIntro); iIntros_go pats startproof
+ (* Clearing and simplifying introduction patterns *)
+ | ISimpl :: ?pats => simpl; iIntros_go pats startproof
+ | IClear ?H :: ?pats => iClear H; iIntros_go pats false
+ | IClearFrame ?H :: ?pats => iFrame H; iIntros_go pats false
+ | IDone :: ?pats => try done; iIntros_go pats startproof
+ (* Introduction + destruct *)
+ | IAlwaysElim ?pat :: ?pats =>
+ let H := iFresh in iIntro #H; iDestructHyp H as pat; iIntros_go pats false
+ | ?pat :: ?pats =>
+ let H := iFresh in iIntro H; iDestructHyp H as pat; iIntros_go pats false
+ end.
+Tactic Notation "iIntros" constr(pat) :=
+ let pats := intro_pat.parse pat in iIntros_go pats true.
+Tactic Notation "iIntros" := iIntros [IAll].
+
+Tactic Notation "iIntros" "(" simple_intropattern(x1) ")" :=
+ iIntro ( x1 ).
+Tactic Notation "iIntros" "(" simple_intropattern(x1)
+ simple_intropattern(x2) ")" :=
+ iIntros ( x1 ); iIntro ( x2 ).
+Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
+ simple_intropattern(x3) ")" :=
+ iIntros ( x1 x2 ); iIntro ( x3 ).
+Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
+ simple_intropattern(x3) simple_intropattern(x4) ")" :=
+ iIntros ( x1 x2 x3 ); iIntro ( x4 ).
+Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
+ simple_intropattern(x3) simple_intropattern(x4) simple_intropattern(x5) ")" :=
+ iIntros ( x1 x2 x3 x4 ); iIntro ( x5 ).
+Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
+ simple_intropattern(x3) simple_intropattern(x4) simple_intropattern(x5)
+ simple_intropattern(x6) ")" :=
+ iIntros ( x1 x2 x3 x4 x5 ); iIntro ( x6 ).
+Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
+ simple_intropattern(x3) simple_intropattern(x4) simple_intropattern(x5)
+ simple_intropattern(x6) simple_intropattern(x7) ")" :=
+ iIntros ( x1 x2 x3 x4 x5 x6 ); iIntro ( x7 ).
+Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
+ simple_intropattern(x3) simple_intropattern(x4) simple_intropattern(x5)
+ simple_intropattern(x6) simple_intropattern(x7) simple_intropattern(x8) ")" :=
+ iIntros ( x1 x2 x3 x4 x5 x6 x7 ); iIntro ( x8 ).
+Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
+ simple_intropattern(x3) simple_intropattern(x4) simple_intropattern(x5)
+ simple_intropattern(x6) simple_intropattern(x7) simple_intropattern(x8)
+ simple_intropattern(x9) ")" :=
+ iIntros ( x1 x2 x3 x4 x5 x6 x7 x8 ); iIntro ( x9 ).
+Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
+ simple_intropattern(x3) simple_intropattern(x4) simple_intropattern(x5)
+ simple_intropattern(x6) simple_intropattern(x7) simple_intropattern(x8)
+ simple_intropattern(x9) simple_intropattern(x10) ")" :=
+ iIntros ( x1 x2 x3 x4 x5 x6 x7 x8 x9 ); iIntro ( x10 ).
+Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
+ simple_intropattern(x3) simple_intropattern(x4) simple_intropattern(x5)
+ simple_intropattern(x6) simple_intropattern(x7) simple_intropattern(x8)
+ simple_intropattern(x9) simple_intropattern(x10) simple_intropattern(x11) ")" :=
+ iIntros ( x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 ); iIntro ( x11 ).
+Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
+ simple_intropattern(x3) simple_intropattern(x4) simple_intropattern(x5)
+ simple_intropattern(x6) simple_intropattern(x7) simple_intropattern(x8)
+ simple_intropattern(x9) simple_intropattern(x10) simple_intropattern(x11)
+ simple_intropattern(x12) ")" :=
+ iIntros ( x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 ); iIntro ( x12 ).
+
+Tactic Notation "iIntros" "(" simple_intropattern(x1) ")" constr(p) :=
+ iIntros ( x1 ); iIntros p.
+Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
+ ")" constr(p) :=
+ iIntros ( x1 x2 ); iIntros p.
+Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
+ simple_intropattern(x3) ")" constr(p) :=
+ iIntros ( x1 x2 x3 ); iIntros p.
+Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
+ simple_intropattern(x3) simple_intropattern(x4) ")" constr(p) :=
+ iIntros ( x1 x2 x3 x4 ); iIntros p.
+Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
+ simple_intropattern(x3) simple_intropattern(x4) simple_intropattern(x5)
+ ")" constr(p) :=
+ iIntros ( x1 x2 x3 x4 x5 ); iIntros p.
+Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
+ simple_intropattern(x3) simple_intropattern(x4) simple_intropattern(x5)
+ simple_intropattern(x6) ")" constr(p) :=
+ iIntros ( x1 x2 x3 x4 x5 x6 ); iIntros p.
+Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
+ simple_intropattern(x3) simple_intropattern(x4) simple_intropattern(x5)
+ simple_intropattern(x6) simple_intropattern(x7) ")" constr(p) :=
+ iIntros ( x1 x2 x3 x4 x5 x6 x7 ); iIntros p.
+Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
+ simple_intropattern(x3) simple_intropattern(x4) simple_intropattern(x5)
+ simple_intropattern(x6) simple_intropattern(x7) simple_intropattern(x8)
+ ")" constr(p) :=
+ iIntros ( x1 x2 x3 x4 x5 x6 x7 x8 ); iIntros p.
+Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
+ simple_intropattern(x3) simple_intropattern(x4) simple_intropattern(x5)
+ simple_intropattern(x6) simple_intropattern(x7) simple_intropattern(x8)
+ simple_intropattern(x9) ")" constr(p) :=
+ iIntros ( x1 x2 x3 x4 x5 x6 x7 x8 x9 ); iIntros p.
+Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
+ simple_intropattern(x3) simple_intropattern(x4) simple_intropattern(x5)
+ simple_intropattern(x6) simple_intropattern(x7) simple_intropattern(x8)
+ simple_intropattern(x9) simple_intropattern(x10) ")" constr(p) :=
+ iIntros ( x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 ); iIntros p.
+Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
+ simple_intropattern(x3) simple_intropattern(x4) simple_intropattern(x5)
+ simple_intropattern(x6) simple_intropattern(x7) simple_intropattern(x8)
+ simple_intropattern(x9) simple_intropattern(x10) simple_intropattern(x11)
+ ")" constr(p) :=
+ iIntros ( x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 ); iIntros p.
+Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
+ simple_intropattern(x3) simple_intropattern(x4) simple_intropattern(x5)
+ simple_intropattern(x6) simple_intropattern(x7) simple_intropattern(x8)
+ simple_intropattern(x9) simple_intropattern(x10) simple_intropattern(x11)
+ simple_intropattern(x12) ")" constr(p) :=
+ iIntros ( x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 ); iIntros p.
+
+Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1) ")" :=
+ iIntros p; iIntros ( x1 ).
+Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1)
+ simple_intropattern(x2) ")" :=
+ iIntros p; iIntros ( x1 x2 ).
+Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) ")" :=
+ iIntros p; iIntros ( x1 x2 x3 ).
+Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4) ")" :=
+ iIntros p; iIntros ( x1 x2 x3 x4 ).
+Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
+ simple_intropattern(x5) ")" :=
+ iIntros p; iIntros ( x1 x2 x3 x4 x5 ).
+Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
+ simple_intropattern(x5) simple_intropattern(x6) ")" :=
+ iIntros p; iIntros ( x1 x2 x3 x4 x5 x6 ).
+Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
+ simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7) ")" :=
+ iIntros p; iIntros ( x1 x2 x3 x4 x5 x6 x7 ).
+Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
+ simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7)
+ simple_intropattern(x8) ")" :=
+ iIntros p; iIntros ( x1 x2 x3 x4 x5 x6 x7 x8 ).
+Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
+ simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7)
+ simple_intropattern(x8) simple_intropattern(x9) ")" :=
+ iIntros p; iIntros ( x1 x2 x3 x4 x5 x6 x7 x8 x9 ).
+Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
+ simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7)
+ simple_intropattern(x8) simple_intropattern(x9) simple_intropattern(x10) ")" :=
+ iIntros p; iIntros ( x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 ).
+Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
+ simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7)
+ simple_intropattern(x8) simple_intropattern(x9) simple_intropattern(x10)
+ simple_intropattern(x11) ")" :=
+ iIntros p; iIntros ( x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 ).
+Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
+ simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7)
+ simple_intropattern(x8) simple_intropattern(x9) simple_intropattern(x10)
+ simple_intropattern(x11) simple_intropattern(x12) ")" :=
+ iIntros p; iIntros ( x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 ).
+
+Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1) ")" constr(p2) :=
+ iIntros p; iIntros ( x1 ); iIntros p2.
+Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1)
+ simple_intropattern(x2) ")" constr(p2) :=
+ iIntros p; iIntros ( x1 x2 ); iIntros p2.
+Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) ")" constr(p2) :=
+ iIntros p; iIntros ( x1 x2 x3 ); iIntros p2.
+Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
+ ")" constr(p2) :=
+ iIntros p; iIntros ( x1 x2 x3 x4 ); iIntros p2.
+Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
+ simple_intropattern(x5) ")" constr(p2) :=
+ iIntros p; iIntros ( x1 x2 x3 x4 x5 ); iIntros p2.
+Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
+ simple_intropattern(x5) simple_intropattern(x6) ")" constr(p2) :=
+ iIntros p; iIntros ( x1 x2 x3 x4 x5 x6 ); iIntros p2.
+Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
+ simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7)
+ ")" constr(p2) :=
+ iIntros p; iIntros ( x1 x2 x3 x4 x5 x6 x7 ); iIntros p2.
+Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
+ simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7)
+ simple_intropattern(x8) ")" constr(p2) :=
+ iIntros p; iIntros ( x1 x2 x3 x4 x5 x6 x7 x8 ); iIntros p2.
+Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
+ simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7)
+ simple_intropattern(x8) simple_intropattern(x9) ")" constr(p2) :=
+ iIntros p; iIntros ( x1 x2 x3 x4 x5 x6 x7 x8 x9 ); iIntros p2.
+Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
+ simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7)
+ simple_intropattern(x8) simple_intropattern(x9) simple_intropattern(x10)
+ ")" constr(p2) :=
+ iIntros p; iIntros ( x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 ); iIntros p2.
+Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
+ simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7)
+ simple_intropattern(x8) simple_intropattern(x9) simple_intropattern(x10)
+ simple_intropattern(x11) ")" constr(p2) :=
+ iIntros p; iIntros ( x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 ); iIntros p2.
+Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
+ simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7)
+ simple_intropattern(x8) simple_intropattern(x9) simple_intropattern(x10)
+ simple_intropattern(x11) simple_intropattern(x12) ")" constr(p2) :=
+ iIntros p; iIntros ( x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 ); iIntros p2.
+
+
+(* Used for generalization in iInduction and iLöb *)
+Tactic Notation "iRevertIntros" constr(Hs) "with" tactic(tac) :=
+ let rec go Hs :=
+ lazymatch Hs with
+ | [] => tac
+ | ESelPure :: ?Hs => fail "iRevertIntros: % not supported"
+ | ESelIdent ?p ?H :: ?Hs =>
+ iRevert H; go Hs;
+ let H' :=
+ match p with true => constr:([IAlwaysElim (IIdent H)]) | false => H end in
+ iIntros H'
+ end in
+ try iStartProof; let Hs := iElaborateSelPat Hs in go Hs.
+
+Tactic Notation "iRevertIntros" "(" ident(x1) ")" constr(Hs) "with" tactic(tac):=
+ iRevertIntros Hs with (iRevert (x1); tac; iIntros (x1)).
+Tactic Notation "iRevertIntros" "(" ident(x1) ident(x2) ")" constr(Hs)
+ "with" tactic(tac):=
+ iRevertIntros Hs with (iRevert (x1 x2); tac; iIntros (x1 x2)).
+Tactic Notation "iRevertIntros" "(" ident(x1) ident(x2) ident(x3) ")" constr(Hs)
+ "with" tactic(tac):=
+ iRevertIntros Hs with (iRevert (x1 x2 x3); tac; iIntros (x1 x2 x3)).
+Tactic Notation "iRevertIntros" "(" ident(x1) ident(x2) ident(x3) ident(x4) ")"
+ constr(Hs) "with" tactic(tac):=
+ iRevertIntros Hs with (iRevert (x1 x2 x3 x4); tac; iIntros (x1 x2 x3 x4)).
+Tactic Notation "iRevertIntros" "(" ident(x1) ident(x2) ident(x3) ident(x4)
+ ident(x5) ")" constr(Hs) "with" tactic(tac):=
+ iRevertIntros Hs with (iRevert (x1 x2 x3 x4 x5); tac; iIntros (x1 x2 x3 x4 x5)).
+Tactic Notation "iRevertIntros" "(" ident(x1) ident(x2) ident(x3) ident(x4)
+ ident(x5) ident(x6) ")" constr(Hs) "with" tactic(tac):=
+ iRevertIntros Hs with (iRevert (x1 x2 x3 x4 x5 x6);
+ tac; iIntros (x1 x2 x3 x4 x5 x6)).
+Tactic Notation "iRevertIntros" "(" ident(x1) ident(x2) ident(x3) ident(x4)
+ ident(x5) ident(x6) ident(x7) ")" constr(Hs) "with" tactic(tac):=
+ iRevertIntros Hs with (iRevert (x1 x2 x3 x4 x5 x6 x7);
+ tac; iIntros (x1 x2 x3 x4 x5 x6 x7)).
+Tactic Notation "iRevertIntros" "(" ident(x1) ident(x2) ident(x3) ident(x4)
+ ident(x5) ident(x6) ident(x7) ident(x8) ")" constr(Hs) "with" tactic(tac):=
+ iRevertIntros Hs with (iRevert (x1 x2 x3 x4 x5 x6 x7 x8);
+ tac; iIntros (x1 x2 x3 x4 x5 x6 x7 x8)).
+
+Tactic Notation "iRevertIntros" "with" tactic(tac) :=
+ iRevertIntros "" with tac.
+Tactic Notation "iRevertIntros" "(" ident(x1) ")" "with" tactic(tac):=
+ iRevertIntros (x1) "" with tac.
+Tactic Notation "iRevertIntros" "(" ident(x1) ident(x2) ")" "with" tactic(tac):=
+ iRevertIntros (x1 x2) "" with tac.
+Tactic Notation "iRevertIntros" "(" ident(x1) ident(x2) ident(x3) ")"
+ "with" tactic(tac):=
+ iRevertIntros (x1 x2 x3) "" with tac.
+Tactic Notation "iRevertIntros" "(" ident(x1) ident(x2) ident(x3) ident(x4) ")"
+ "with" tactic(tac):=
+ iRevertIntros (x1 x2 x3 x4) "" with tac.
+Tactic Notation "iRevertIntros" "(" ident(x1) ident(x2) ident(x3) ident(x4)
+ ident(x5) ")" "with" tactic(tac):=
+ iRevertIntros (x1 x2 x3 x4 x5) "" with tac.
+Tactic Notation "iRevertIntros" "(" ident(x1) ident(x2) ident(x3) ident(x4)
+ ident(x5) ident(x6) ")" "with" tactic(tac):=
+ iRevertIntros (x1 x2 x3 x4 x5 x6) "" with tac.
+Tactic Notation "iRevertIntros" "(" ident(x1) ident(x2) ident(x3) ident(x4)
+ ident(x5) ident(x6) ident(x7) ")" "with" tactic(tac):=
+ iRevertIntros (x1 x2 x3 x4 x5 x6 x7) "" with tac.
+Tactic Notation "iRevertIntros" "(" ident(x1) ident(x2) ident(x3) ident(x4)
+ ident(x5) ident(x6) ident(x7) ident(x8) ")" "with" tactic(tac):=
+ iRevertIntros (x1 x2 x3 x4 x5 x6 x7 x8) "" with tac.
+
+(** * Destruct tactic *)
+Class CopyDestruct {PROP : bi} (P : PROP).
+Arguments CopyDestruct {_} _%I.
+Hint Mode CopyDestruct + ! : typeclass_instances.
+
+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 {PROP : bi} (P Q : PROP) :
+ CopyDestruct Q → CopyDestruct (P -∗ Q).
+Instance copy_destruct_affinely {PROP : bi} (P : PROP) :
+ CopyDestruct P → CopyDestruct (<affine> P).
+Instance copy_destruct_persistently {PROP : bi} (P : PROP) :
+ CopyDestruct P → CopyDestruct (<pers> P).
+
+Tactic Notation "iDestructCore" open_constr(lem) "as" constr(p) tactic(tac) :=
+ let ident :=
+ lazymatch type of lem with
+ | ident => constr:(Some lem)
+ | string => constr:(Some (INamed lem))
+ | iTrm =>
+ lazymatch lem with
+ | @iTrm ident ?H _ _ => constr:(Some H)
+ | @iTrm string ?H _ _ => constr:(Some (INamed H))
+ | _ => constr:(@None ident)
+ end
+ | _ => constr:(@None ident)
+ end in
+ let intro_destruct n :=
+ let rec go n' :=
+ lazymatch n' with
+ | 0 => fail "iDestruct: cannot introduce" n "hypotheses"
+ | 1 => repeat iIntroForall; let H := iFresh in iIntro H; tac H
+ | S ?n' => repeat iIntroForall; let H := iFresh in iIntro H; go n'
+ end in
+ intros; go n in
+ lazymatch type of lem with
+ | nat => intro_destruct lem
+ | Z => (* to make it work in Z_scope. We should just be able to bind
+ tactic notation arguments to notation scopes. *)
+ let n := eval compute in (Z.to_nat lem) in intro_destruct n
+ | _ =>
+ (* Only copy the hypothesis in case there is a [CopyDestruct] instance.
+ Also, rule out cases in which it does not make sense to copy, namely when
+ destructing a lemma (instead of a hypothesis) or a spatial hyopthesis
+ (which cannot be kept). *)
+ iStartProof;
+ lazymatch ident with
+ | None => iPoseProofCore lem as p false tac
+ | Some ?H =>
+ lazymatch iTypeOf H with
+ | None =>
+ let H := pretty_ident H in
+ fail "iDestruct:" H "not found"
+ | Some (true, ?P) =>
+ (* persistent hypothesis, check for a CopyDestruct instance *)
+ tryif (let dummy := constr:(_ : CopyDestruct P) in idtac)
+ then (iPoseProofCore lem as p false tac)
+ else (iSpecializeCore lem as p; last (tac H))
+ | Some (false, ?P) =>
+ (* spatial hypothesis, cannot copy *)
+ iSpecializeCore lem as p; last (tac H)
+ end
+ end
+ end.
+
+Tactic Notation "iDestruct" open_constr(lem) "as" constr(pat) :=
+ iDestructCore lem as pat (fun H => iDestructHyp H as pat).
+Tactic Notation "iDestruct" open_constr(lem) "as" "(" simple_intropattern(x1) ")"
+ constr(pat) :=
+ iDestructCore lem as pat (fun H => iDestructHyp H as ( x1 ) pat).
+Tactic Notation "iDestruct" open_constr(lem) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) ")" constr(pat) :=
+ iDestructCore lem as pat (fun H => iDestructHyp H as ( x1 x2 ) pat).
+Tactic Notation "iDestruct" open_constr(lem) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) ")" constr(pat) :=
+ iDestructCore lem as pat (fun H => iDestructHyp H as ( x1 x2 x3 ) pat).
+Tactic Notation "iDestruct" open_constr(lem) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4) ")"
+ constr(pat) :=
+ iDestructCore lem as pat (fun H => iDestructHyp H as ( x1 x2 x3 x4 ) pat).
+Tactic Notation "iDestruct" open_constr(lem) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
+ simple_intropattern(x5) ")" constr(pat) :=
+ iDestructCore lem as pat (fun H => iDestructHyp H as ( x1 x2 x3 x4 x5 ) pat).
+Tactic Notation "iDestruct" open_constr(lem) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
+ simple_intropattern(x5) simple_intropattern(x6) ")" constr(pat) :=
+ iDestructCore lem as pat (fun H => iDestructHyp H as ( x1 x2 x3 x4 x5 x6 ) pat).
+Tactic Notation "iDestruct" open_constr(lem) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
+ simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7) ")"
+ constr(pat) :=
+ iDestructCore lem as pat (fun H => iDestructHyp H as ( x1 x2 x3 x4 x5 x6 x7 ) pat).
+Tactic Notation "iDestruct" open_constr(lem) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
+ simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7)
+ simple_intropattern(x8) ")" constr(pat) :=
+ iDestructCore lem as pat (fun H => iDestructHyp H as ( x1 x2 x3 x4 x5 x6 x7 x8 ) pat).
+
+Tactic Notation "iDestruct" open_constr(lem) "as" "%" simple_intropattern(pat) :=
+ iDestructCore lem as true (fun H => iPure H as pat).
+
+Tactic Notation "iPoseProof" open_constr(lem) "as" constr(pat) :=
+ iPoseProofCore lem as pat false (fun H => iDestructHyp H as pat).
+Tactic Notation "iPoseProof" open_constr(lem) "as" "(" simple_intropattern(x1) ")"
+ constr(pat) :=
+ iPoseProofCore lem as pat false (fun H => iDestructHyp H as ( x1 ) pat).
+Tactic Notation "iPoseProof" open_constr(lem) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) ")" constr(pat) :=
+ iPoseProofCore lem as pat false (fun H => iDestructHyp H as ( x1 x2 ) pat).
+Tactic Notation "iPoseProof" open_constr(lem) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) ")" constr(pat) :=
+ iPoseProofCore lem as pat false (fun H => iDestructHyp H as ( x1 x2 x3 ) pat).
+Tactic Notation "iPoseProof" open_constr(lem) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4) ")"
+ constr(pat) :=
+ iPoseProofCore lem as pat false (fun H => iDestructHyp H as ( x1 x2 x3 x4 ) pat).
+Tactic Notation "iPoseProof" open_constr(lem) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
+ simple_intropattern(x5) ")" constr(pat) :=
+ iPoseProofCore lem as pat false (fun H => iDestructHyp H as ( x1 x2 x3 x4 x5 ) pat).
+Tactic Notation "iPoseProof" open_constr(lem) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
+ simple_intropattern(x5) simple_intropattern(x6) ")" constr(pat) :=
+ iPoseProofCore lem as pat false (fun H => iDestructHyp H as ( x1 x2 x3 x4 x5 x6 ) pat).
+Tactic Notation "iPoseProof" open_constr(lem) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
+ simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7) ")"
+ constr(pat) :=
+ iPoseProofCore lem as pat false (fun H => iDestructHyp H as ( x1 x2 x3 x4 x5 x6 x7 ) pat).
+Tactic Notation "iPoseProof" open_constr(lem) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
+ simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7)
+ simple_intropattern(x8) ")" constr(pat) :=
+ iPoseProofCore lem as pat false (fun H => iDestructHyp H as ( x1 x2 x3 x4 x5 x6 x7 x8 ) pat).
+
+(** * Induction *)
+(* An invocation of [iInduction (x) as pat IH forall (x1...xn) Hs] will
+result in the following actions:
+
+- Revert the proofmode hypotheses [Hs]
+- Revert all remaining spatial hypotheses and the remaining persistent
+ hypotheses containing the induction variable [x]
+- Revert the pure hypotheses [x1..xn]
+
+- Actuall perform induction
+
+- Introduce thee pure hypotheses [x1..xn]
+- Introduce the spatial hypotheses and persistent hypotheses involving [x]
+- Introduce the proofmode hypotheses [Hs]
+*)
+Tactic Notation "iInductionCore" constr(x) "as" simple_intropattern(pat) constr(IH) :=
+ let rec fix_ihs rev_tac :=
+ lazymatch goal with
+ | H : context [envs_entails _ _] |- _ =>
+ eapply (tac_revert_ih _ _ _ H _);
+ [pm_reflexivity
+ || fail "iInduction: spatial context not empty, this should not happen"
+ |clear H];
+ fix_ihs ltac:(fun j =>
+ let IH' := eval vm_compute in
+ match j with 0%N => IH | _ => IH +:+ pretty j end in
+ iIntros [IAlwaysElim (IIdent IH')];
+ let j := eval vm_compute in (1 + j)%N in
+ rev_tac j)
+ | _ => rev_tac 0%N
+ end in
+ induction x as pat; fix_ihs ltac:(fun _ => idtac).
+
+Ltac iHypsContaining x :=
+ let rec go Γ x Hs :=
+ lazymatch Γ with
+ | Enil => constr:(Hs)
+ | Esnoc ?Γ ?H ?Q =>
+ match Q with
+ | context [x] => go Γ x (H :: Hs)
+ | _ => go Γ x Hs
+ end
+ end in
+ let Γp := lazymatch goal with |- envs_entails (Envs ?Γp _ _) _ => Γp end in
+ let Γs := lazymatch goal with |- envs_entails (Envs _ ?Γs _) _ => Γs end in
+ let Hs := go Γp x (@nil ident) in go Γs x Hs.
+
+Tactic Notation "iInductionRevert" constr(x) constr(Hs) "with" tactic(tac) :=
+ iRevertIntros Hs with (
+ iRevertIntros "∗" with (
+ idtac;
+ let Hsx := iHypsContaining x in
+ iRevertIntros Hsx with tac
+ )
+ ).
+
+Tactic Notation "iInduction" constr(x) "as" simple_intropattern(pat) constr(IH) :=
+ iInductionRevert x "" with (iInductionCore x as pat IH).
+Tactic Notation "iInduction" constr(x) "as" simple_intropattern(pat) constr(IH)
+ "forall" "(" ident(x1) ")" :=
+ iInductionRevert x "" with (iRevertIntros(x1) "" with (iInductionCore x as pat IH)).
+Tactic Notation "iInduction" constr(x) "as" simple_intropattern(pat) constr(IH)
+ "forall" "(" ident(x1) ident(x2) ")" :=
+ iInductionRevert x "" with (iRevertIntros(x1 x2) "" with (iInductionCore x as pat IH)).
+Tactic Notation "iInduction" constr(x) "as" simple_intropattern(pat) constr(IH)
+ "forall" "(" ident(x1) ident(x2) ident(x3) ")" :=
+ iInductionRevert x "" with (iRevertIntros(x1 x2 x3) "" with (iInductionCore x as pat IH)).
+Tactic Notation "iInduction" constr(x) "as" simple_intropattern(pat) constr(IH)
+ "forall" "(" ident(x1) ident(x2) ident(x3) ident(x4) ")" :=
+ iInductionRevert x "" with (iRevertIntros(x1 x2 x3 x4) "" with (iInductionCore x as pat IH)).
+Tactic Notation "iInduction" constr(x) "as" simple_intropattern(pat) constr(IH)
+ "forall" "(" ident(x1) ident(x2) ident(x3) ident(x4) ident(x5) ")" :=
+ iInductionRevert x "" with (iRevertIntros(x1 x2 x3 x4 x5) "" with (iInductionCore x as pat IH)).
+Tactic Notation "iInduction" constr(x) "as" simple_intropattern(pat) constr(IH)
+ "forall" "(" ident(x1) ident(x2) ident(x3) ident(x4) ident(x5) ident(x6) ")" :=
+ iInductionRevert x "" with (iRevertIntros(x1 x2 x3 x4 x5 x6) "" with (iInductionCore x as pat IH)).
+Tactic Notation "iInduction" constr(x) "as" simple_intropattern(pat) constr(IH)
+ "forall" "(" ident(x1) ident(x2) ident(x3) ident(x4) ident(x5) ident(x6)
+ ident(x7) ")" :=
+ iInductionRevert x "" with (iRevertIntros(x1 x2 x3 x4 x5 x6 x7) "" with (iInductionCore x as pat IH)).
+Tactic Notation "iInduction" constr(x) "as" simple_intropattern(pat) constr(IH)
+ "forall" "(" ident(x1) ident(x2) ident(x3) ident(x4) ident(x5) ident(x6)
+ ident(x7) ident(x8) ")" :=
+ iInductionRevert x "" with (iRevertIntros(x1 x2 x3 x4 x5 x6 x7 x8) "" with (iInductionCore x as pat IH)).
+
+Tactic Notation "iInduction" constr(x) "as" simple_intropattern(pat) constr(IH)
+ "forall" constr(Hs) :=
+ iInductionRevert x Hs with (iInductionCore x as pat IH).
+Tactic Notation "iInduction" constr(x) "as" simple_intropattern(pat) constr(IH)
+ "forall" "(" ident(x1) ")" constr(Hs) :=
+ iInductionRevert x Hs with (iRevertIntros(x1) "" with (iInductionCore x as pat IH)).
+Tactic Notation "iInduction" constr(x) "as" simple_intropattern(pat) constr(IH)
+ "forall" "(" ident(x1) ident(x2) ")" constr(Hs) :=
+ iInductionRevert x Hs with (iRevertIntros(x1 x2) "" with (iInductionCore x as pat IH)).
+Tactic Notation "iInduction" constr(x) "as" simple_intropattern(pat) constr(IH)
+ "forall" "(" ident(x1) ident(x2) ident(x3) ")" constr(Hs) :=
+ iInductionRevert x Hs with (iRevertIntros(x1 x2 x3) "" with (iInductionCore x as pat IH)).
+Tactic Notation "iInduction" constr(x) "as" simple_intropattern(pat) constr(IH)
+ "forall" "(" ident(x1) ident(x2) ident(x3) ident(x4) ")" constr(Hs) :=
+ iInductionRevert x Hs with (iRevertIntros(x1 x2 x3 x4) "" with (iInductionCore x as pat IH)).
+Tactic Notation "iInduction" constr(x) "as" simple_intropattern(pat) constr(IH)
+ "forall" "(" ident(x1) ident(x2) ident(x3) ident(x4) ident(x5) ")"
+ constr(Hs) :=
+ iInductionRevert x Hs with (iRevertIntros(x1 x2 x3 x4 x5) "" with (iInductionCore x as pat IH)).
+Tactic Notation "iInduction" constr(x) "as" simple_intropattern(pat) constr(IH)
+ "forall" "(" ident(x1) ident(x2) ident(x3) ident(x4) ident(x5) ident(x6) ")"
+ constr(Hs) :=
+ iInductionRevert x Hs with (iRevertIntros(x1 x2 x3 x4 x5 x6) "" with (iInductionCore x as pat IH)).
+Tactic Notation "iInduction" constr(x) "as" simple_intropattern(pat) constr(IH)
+ "forall" "(" ident(x1) ident(x2) ident(x3) ident(x4) ident(x5) ident(x6)
+ ident(x7) ")" constr(Hs) :=
+ iInductionRevert x Hs with (iRevertIntros(x1 x2 x3 x4 x5 x6 x7) "" with (iInductionCore x as pat IH)).
+Tactic Notation "iInduction" constr(x) "as" simple_intropattern(pat) constr(IH)
+ "forall" "(" ident(x1) ident(x2) ident(x3) ident(x4) ident(x5) ident(x6)
+ ident(x7) ident(x8) ")" constr(Hs) :=
+ iInductionRevert x Hs with (iRevertIntros(x1 x2 x3 x4 x5 x6 x7 x8) "" with (iInductionCore x as pat IH)).
+
+(** * Löb Induction *)
+Tactic Notation "iLöbCore" "as" constr (IH) :=
+ iStartProof;
+ (* apply is sometimes confused wrt. canonical structures search.
+ refine should use the other unification algorithm, which should
+ not have this issue. *)
+ notypeclasses refine (tac_löb _ _ IH _ _ _ _);
+ [reflexivity || fail "iLöb: spatial context not empty, this should not happen"
+ |pm_reflexivity ||
+ let IH := pretty_ident IH in
+ fail "iLöb:" IH "not fresh"|].
+
+Tactic Notation "iLöbRevert" constr(Hs) "with" tactic(tac) :=
+ iRevertIntros Hs with (
+ iRevertIntros "∗" with tac
+ ).
+
+Tactic Notation "iLöb" "as" constr (IH) :=
+ iLöbRevert "" with (iLöbCore as IH).
+Tactic Notation "iLöb" "as" constr (IH) "forall" "(" ident(x1) ")" :=
+ iLöbRevert "" with (iRevertIntros(x1) "" with (iLöbCore as IH)).
+Tactic Notation "iLöb" "as" constr (IH) "forall" "(" ident(x1) ident(x2) ")" :=
+ iLöbRevert "" with (iRevertIntros(x1 x2) "" with (iLöbCore as IH)).
+Tactic Notation "iLöb" "as" constr (IH) "forall" "(" ident(x1) ident(x2)
+ ident(x3) ")" :=
+ iLöbRevert "" with (iRevertIntros(x1 x2 x3) "" with (iLöbCore as IH)).
+Tactic Notation "iLöb" "as" constr (IH) "forall" "(" ident(x1) ident(x2)
+ ident(x3) ident(x4) ")" :=
+ iLöbRevert "" with (iRevertIntros(x1 x2 x3 x4) "" with (iLöbCore as IH)).
+Tactic Notation "iLöb" "as" constr (IH) "forall" "(" ident(x1) ident(x2)
+ ident(x3) ident(x4) ident(x5) ")" :=
+ iLöbRevert "" with (iRevertIntros(x1 x2 x3 x4 x5) "" with (iLöbCore as IH)).
+Tactic Notation "iLöb" "as" constr (IH) "forall" "(" ident(x1) ident(x2)
+ ident(x3) ident(x4) ident(x5) ident(x6) ")" :=
+ iLöbRevert "" with (iRevertIntros(x1 x2 x3 x4 x5 x6) "" with (iLöbCore as IH)).
+Tactic Notation "iLöb" "as" constr (IH) "forall" "(" ident(x1) ident(x2)
+ ident(x3) ident(x4) ident(x5) ident(x6) ident(x7) ")" :=
+ iLöbRevert "" with (iRevertIntros(x1 x2 x3 x4 x5 x6 x7) "" with (iLöbCore as IH)).
+Tactic Notation "iLöb" "as" constr (IH) "forall" "(" ident(x1) ident(x2)
+ ident(x3) ident(x4) ident(x5) ident(x6) ident(x7) ident(x8) ")" :=
+ iLöbRevert "" with (iRevertIntros(x1 x2 x3 x4 x5 x6 x7 x8) "" with (iLöbCore as IH)).
+
+Tactic Notation "iLöb" "as" constr (IH) "forall" constr(Hs) :=
+ iLöbRevert Hs with (iLöbCore as IH).
+Tactic Notation "iLöb" "as" constr (IH) "forall" "(" ident(x1) ")" constr(Hs) :=
+ iLöbRevert Hs with (iRevertIntros(x1) "" with (iLöbCore as IH)).
+Tactic Notation "iLöb" "as" constr (IH) "forall" "(" ident(x1) ident(x2) ")"
+ constr(Hs) :=
+ iLöbRevert Hs with (iRevertIntros(x1 x2) "" with (iLöbCore as IH)).
+Tactic Notation "iLöb" "as" constr (IH) "forall" "(" ident(x1) ident(x2)
+ ident(x3) ")" constr(Hs) :=
+ iLöbRevert Hs with (iRevertIntros(x1 x2 x3) "" with (iLöbCore as IH)).
+Tactic Notation "iLöb" "as" constr (IH) "forall" "(" ident(x1) ident(x2)
+ ident(x3) ident(x4) ")" constr(Hs) :=
+ iLöbRevert Hs with (iRevertIntros(x1 x2 x3 x4) "" with (iLöbCore as IH)).
+Tactic Notation "iLöb" "as" constr (IH) "forall" "(" ident(x1) ident(x2)
+ ident(x3) ident(x4) ident(x5) ")" constr(Hs) :=
+ iLöbRevert Hs with (iRevertIntros(x1 x2 x3 x4 x5) "" with (iLöbCore as IH)).
+Tactic Notation "iLöb" "as" constr (IH) "forall" "(" ident(x1) ident(x2)
+ ident(x3) ident(x4) ident(x5) ident(x6) ")" constr(Hs) :=
+ iLöbRevert Hs with (iRevertIntros(x1 x2 x3 x4 x5 x6) "" with (iLöbCore as IH)).
+Tactic Notation "iLöb" "as" constr (IH) "forall" "(" ident(x1) ident(x2)
+ ident(x3) ident(x4) ident(x5) ident(x6) ident(x7) ")" constr(Hs) :=
+ iLöbRevert Hs with (iRevertIntros(x1 x2 x3 x4 x5 x6 x7) "" with (iLöbCore as IH)).
+Tactic Notation "iLöb" "as" constr (IH) "forall" "(" ident(x1) ident(x2)
+ ident(x3) ident(x4) ident(x5) ident(x6) ident(x7) ident(x8) ")" constr(Hs) :=
+ iLöbRevert Hs with (iRevertIntros(x1 x2 x3 x4 x5 x6 x7 x8) "" with (iLöbCore as IH)).
+
+(** * Assert *)
+(* The argument [p] denotes whether [Q] is persistent. It can either be a
+Boolean or an introduction pattern, which will be coerced into [true] if it
+only contains `#` or `%` patterns at the top-level, and [false] otherwise. *)
+Tactic Notation "iAssertCore" open_constr(Q)
+ "with" constr(Hs) "as" constr(p) tactic(tac) :=
+ iStartProof;
+ let pats := spec_pat.parse Hs in
+ lazymatch pats with
+ | [_] => idtac
+ | _ => fail "iAssert: exactly one specialization pattern should be given"
+ end;
+ let H := iFresh in
+ eapply tac_assert with _ H Q;
+ [pm_reflexivity
+ |iSpecializeCore H with hnil pats as p; [..|tac H]].
+
+Tactic Notation "iAssertCore" open_constr(Q) "as" constr(p) tactic(tac) :=
+ let p := intro_pat_persistent p in
+ lazymatch p with
+ | true => iAssertCore Q with "[#]" as p tac
+ | false => iAssertCore Q with "[]" as p tac
+ end.
+
+Tactic Notation "iAssert" open_constr(Q) "with" constr(Hs) "as" constr(pat) :=
+ iAssertCore Q with Hs as pat (fun H => iDestructHyp H as pat).
+Tactic Notation "iAssert" open_constr(Q) "with" constr(Hs) "as"
+ "(" simple_intropattern(x1) ")" constr(pat) :=
+ iAssertCore Q with Hs as pat (fun H => iDestructHyp H as (x1) pat).
+Tactic Notation "iAssert" open_constr(Q) "with" constr(Hs) "as"
+ "(" simple_intropattern(x1) simple_intropattern(x2) ")" constr(pat) :=
+ iAssertCore Q with Hs as pat (fun H => iDestructHyp H as (x1 x2) pat).
+Tactic Notation "iAssert" open_constr(Q) "with" constr(Hs) "as"
+ "(" simple_intropattern(x1) simple_intropattern(x2) simple_intropattern(x3)
+ ")" constr(pat) :=
+ iAssertCore Q with Hs as pat (fun H => iDestructHyp H as (x1 x2 x3) pat).
+Tactic Notation "iAssert" open_constr(Q) "with" constr(Hs) "as"
+ "(" simple_intropattern(x1) simple_intropattern(x2) simple_intropattern(x3)
+ simple_intropattern(x4) ")" constr(pat) :=
+ iAssertCore Q with Hs as pat (fun H => iDestructHyp H as (x1 x2 x3 x4) pat).
+
+Tactic Notation "iAssert" open_constr(Q) "as" constr(pat) :=
+ iAssertCore Q as pat (fun H => iDestructHyp H as pat).
+Tactic Notation "iAssert" open_constr(Q) "as"
+ "(" simple_intropattern(x1) ")" constr(pat) :=
+ iAssertCore Q as pat (fun H => iDestructHyp H as (x1) pat).
+Tactic Notation "iAssert" open_constr(Q) "as"
+ "(" simple_intropattern(x1) simple_intropattern(x2) ")" constr(pat) :=
+ iAssertCore Q as pat (fun H => iDestructHyp H as (x1 x2) pat).
+Tactic Notation "iAssert" open_constr(Q) "as"
+ "(" simple_intropattern(x1) simple_intropattern(x2) simple_intropattern(x3)
+ ")" constr(pat) :=
+ iAssertCore Q as pat (fun H => iDestructHyp H as (x1 x2 x3) pat).
+Tactic Notation "iAssert" open_constr(Q) "as"
+ "(" simple_intropattern(x1) simple_intropattern(x2) simple_intropattern(x3)
+ simple_intropattern(x4) ")" constr(pat) :=
+ iAssertCore Q as pat (fun H => iDestructHyp H as (x1 x2 x3 x4) pat).
+
+Tactic Notation "iAssert" open_constr(Q) "with" constr(Hs)
+ "as" "%" simple_intropattern(pat) :=
+ iAssertCore Q with Hs as true (fun H => iPure H as pat).
+Tactic Notation "iAssert" open_constr(Q) "as" "%" simple_intropattern(pat) :=
+ iAssert Q with "[-]" as %pat.
+
+(** * Rewrite *)
+Local Ltac iRewriteFindPred :=
+ match goal with
+ | |- _ ⊣⊢ ?Φ ?x =>
+ generalize x;
+ match goal with |- (∀ y, @?Ψ y ⊣⊢ _) => unify Φ Ψ; reflexivity end
+ end.
+
+Local Tactic Notation "iRewriteCore" constr(lr) open_constr(lem) :=
+ iPoseProofCore lem as true true (fun Heq =>
+ eapply (tac_rewrite _ Heq _ _ lr);
+ [pm_reflexivity ||
+ let Heq := pretty_ident Heq in
+ fail "iRewrite:" Heq "not found"
+ |iSolveTC ||
+ let P := match goal with |- IntoInternalEq ?P _ _ ⊢ _ => P end in
+ fail "iRewrite:" P "not an equality"
+ |iRewriteFindPred
+ |intros ??? ->; reflexivity|pm_prettify; iClearHyp Heq]).
+
+Tactic Notation "iRewrite" open_constr(lem) := iRewriteCore Right lem.
+Tactic Notation "iRewrite" "-" open_constr(lem) := iRewriteCore Left lem.
+
+Local Tactic Notation "iRewriteCore" constr(lr) open_constr(lem) "in" constr(H) :=
+ iPoseProofCore lem as true true (fun Heq =>
+ eapply (tac_rewrite_in _ Heq _ _ H _ _ lr);
+ [pm_reflexivity ||
+ let Heq := pretty_ident Heq in
+ fail "iRewrite:" Heq "not found"
+ |pm_reflexivity ||
+ let H := pretty_ident H in
+ fail "iRewrite:" H "not found"
+ |iSolveTC ||
+ let P := match goal with |- IntoInternalEq ?P _ _ ⊢ _ => P end in
+ fail "iRewrite:" P "not an equality"
+ |iRewriteFindPred
+ |intros ??? ->; reflexivity
+ |pm_reflexivity|pm_prettify; iClearHyp Heq]).
+
+Tactic Notation "iRewrite" open_constr(lem) "in" constr(H) :=
+ iRewriteCore Right lem in H.
+Tactic Notation "iRewrite" "-" open_constr(lem) "in" constr(H) :=
+ iRewriteCore Left lem in H.
+
+Ltac iSimplifyEq := repeat (
+ iMatchHyp (fun H P => match P with ⌜_ = _âŒ%I => iDestruct H as %? end)
+ || simplify_eq/=).
+
+(** * Update modality *)
+Tactic Notation "iMod" open_constr(lem) :=
+ iDestructCore lem as false (fun H => iModCore H).
+Tactic Notation "iMod" open_constr(lem) "as" constr(pat) :=
+ iDestructCore lem as false (fun H => iModCore H; last iDestructHyp H as pat).
+Tactic Notation "iMod" open_constr(lem) "as" "(" simple_intropattern(x1) ")"
+ constr(pat) :=
+ iDestructCore lem as false (fun H => iModCore H; last iDestructHyp H as ( x1 ) pat).
+Tactic Notation "iMod" open_constr(lem) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) ")" constr(pat) :=
+ iDestructCore lem as false (fun H => iModCore H; last iDestructHyp H as ( x1 x2 ) pat).
+Tactic Notation "iMod" open_constr(lem) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) ")" constr(pat) :=
+ iDestructCore lem as false (fun H => iModCore H; last iDestructHyp H as ( x1 x2 x3 ) pat).
+Tactic Notation "iMod" open_constr(lem) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4) ")"
+ constr(pat) :=
+ iDestructCore lem as false (fun H =>
+ iModCore H; last iDestructHyp H as ( x1 x2 x3 x4 ) pat).
+Tactic Notation "iMod" open_constr(lem) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
+ simple_intropattern(x5) ")" constr(pat) :=
+ iDestructCore lem as false (fun H =>
+ iModCore H; last iDestructHyp H as ( x1 x2 x3 x4 x5 ) pat).
+Tactic Notation "iMod" open_constr(lem) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
+ simple_intropattern(x5) simple_intropattern(x6) ")" constr(pat) :=
+ iDestructCore lem as false (fun H =>
+ iModCore H; last iDestructHyp H as ( x1 x2 x3 x4 x5 x6 ) pat).
+Tactic Notation "iMod" open_constr(lem) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
+ simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7) ")"
+ constr(pat) :=
+ iDestructCore lem as false (fun H =>
+ iModCore H; last iDestructHyp H as ( x1 x2 x3 x4 x5 x6 x7 ) pat).
+Tactic Notation "iMod" open_constr(lem) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
+ simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7)
+ simple_intropattern(x8) ")" constr(pat) :=
+ iDestructCore lem as false (fun H =>
+ iModCore H; last iDestructHyp H as ( x1 x2 x3 x4 x5 x6 x7 x8 ) pat).
+
+Tactic Notation "iMod" open_constr(lem) "as" "%" simple_intropattern(pat) :=
+ iDestructCore lem as false (fun H => iModCore H; iPure H as pat).
+
+(** * Invariant *)
+
+(* Finds a hypothesis in the context that is an invariant with
+ namespace [N]. To do so, we check whether for each hypothesis
+ ["H":P] we can find an instance of [IntoInv P N] *)
+Tactic Notation "iAssumptionInv" constr(N) :=
+ let rec find Γ i :=
+ lazymatch Γ with
+ | Esnoc ?Γ ?j ?P' =>
+ first [let H := constr:(_: IntoInv P' N) in unify i j|find Γ i]
+ end in
+ lazymatch goal with
+ | |- envs_lookup_delete _ ?i (Envs ?Γp ?Γs _) = Some _ =>
+ first [find Γp i|find Γs i]; pm_reflexivity
+ end.
+
+(* The argument [select] is the namespace [N] or hypothesis name ["H"] of the
+invariant. *)
+Tactic Notation "iInvCore" constr(select) "with" constr(pats) "as" open_constr(Hclose) "in" tactic(tac) :=
+ iStartProof;
+ let pats := spec_pat.parse pats in
+ lazymatch pats with
+ | [_] => idtac
+ | _ => fail "iInv: exactly one specialization pattern should be given"
+ end;
+ let H := iFresh in
+ let Pclose_pat :=
+ lazymatch Hclose with
+ | Some _ => open_constr:(Some _)
+ | None => open_constr:(None)
+ end in
+ lazymatch type of select with
+ | string =>
+ eapply @tac_inv_elim with (i:=select) (j:=H) (Pclose:=Pclose_pat);
+ first by (iAssumptionCore || fail "iInv: invariant" select "not found")
+ | ident =>
+ eapply @tac_inv_elim with (i:=select) (j:=H) (Pclose:=Pclose_pat);
+ first by (iAssumptionCore || fail "iInv: invariant" select "not found")
+ | namespace =>
+ eapply @tac_inv_elim with (j:=H) (Pclose:=Pclose_pat);
+ first by (iAssumptionInv select || fail "iInv: invariant" select "not found")
+ | _ => fail "iInv: selector" select "is not of the right type "
+ end;
+ [iSolveTC ||
+ let I := match goal with |- ElimInv _ ?I _ _ _ _ _ => I end in
+ fail "iInv: cannot eliminate invariant " I
+ |iSolveSideCondition
+ |let R := fresh in intros R; eexists; split; [pm_reflexivity|];
+ (* Now we are left proving [envs_entails Δ'' R]. *)
+ iSpecializePat H pats; last (
+ iApplyHyp H; clear R; pm_reduce;
+ (* Now the goal is
+ [∀ x, Pout x -∗ pm_option_fun Pclose x -∗? Q' x],
+ reduced because we can rely on Pclose being a constructor. *)
+ let x := fresh in
+ iIntros (x);
+ iIntro H; (* H was spatial, so it's gone due to the apply and we can reuse the name *)
+ lazymatch Hclose with
+ | Some ?Hcl => iIntros Hcl
+ | None => idtac
+ end;
+ tac x H
+ )].
+
+(* Without closing view shift *)
+Tactic Notation "iInvCore" constr(N) "with" constr(pats) "in" tactic(tac) :=
+ iInvCore N with pats as (@None string) in ltac:(tac).
+(* Without pattern *)
+Tactic Notation "iInvCore" constr(N) "as" constr(Hclose) "in" tactic(tac) :=
+ iInvCore N with "[$]" as Hclose in ltac:(tac).
+(* Without both *)
+Tactic Notation "iInvCore" constr(N) "in" tactic(tac) :=
+ iInvCore N with "[$]" as (@None string) in ltac:(tac).
+
+(* With everything *)
+Tactic Notation "iInv" constr(N) "with" constr(Hs) "as" constr(pat) constr(Hclose) :=
+ iInvCore N with Hs as (Some Hclose) in (fun x H => iDestructHyp H as pat).
+Tactic Notation "iInv" constr(N) "with" constr(Hs) "as" "(" simple_intropattern(x1) ")"
+ constr(pat) constr(Hclose) :=
+ iInvCore N with Hs as (Some Hclose) in (fun x H => iDestructHyp H as (x1) pat).
+Tactic Notation "iInv" constr(N) "with" constr(Hs) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) ")" constr(pat) constr(Hclose) :=
+ iInvCore N with Hs as (Some Hclose) in (fun x H => iDestructHyp H as (x1 x2) pat).
+Tactic Notation "iInv" constr(N) "with" constr(Hs) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) ")"
+ constr(pat) constr(Hclose) :=
+ iInvCore N with Hs as (Some Hclose) in (fun x H => iDestructHyp H as (x1 x2 x3) pat).
+Tactic Notation "iInv" constr(N) "with" constr(Hs) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4) ")"
+ constr(pat) constr(Hclose) :=
+ iInvCore N with Hs as (Some Hclose) in (fun x H => iDestructHyp H as (x1 x2 x3 x4) pat).
+
+(* Without closing view shift *)
+Tactic Notation "iInv" constr(N) "with" constr(Hs) "as" constr(pat) :=
+ iInvCore N with Hs in
+ (fun x H => lazymatch type of x with
+ | unit => destruct x as []; iDestructHyp H as pat
+ | _ => fail "Missing intro pattern for accessor variable"
+ end).
+Tactic Notation "iInv" constr(N) "with" constr(Hs) "as" "(" simple_intropattern(x1) ")"
+ constr(pat) :=
+ iInvCore N with Hs in
+ (fun x H => lazymatch type of x with
+ | unit => destruct x as []; iDestructHyp H as (x1) pat
+ | _ => revert x; intros x1; iDestructHyp H as pat
+ end).
+Tactic Notation "iInv" constr(N) "with" constr(Hs) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) ")" constr(pat) :=
+ iInvCore N with Hs in
+ (fun x H => lazymatch type of x with
+ | unit => destruct x as []; iDestructHyp H as (x1 x2) pat
+ | _ => revert x; intros x1; iDestructHyp H as ( x2) pat
+ end).
+Tactic Notation "iInv" constr(N) "with" constr(Hs) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) ")"
+ constr(pat) :=
+ iInvCore N with Hs in
+ (fun x H => lazymatch type of x with
+ | unit => destruct x as []; iDestructHyp H as (x1 x2 x3) pat
+ | _ => revert x; intros x1; iDestructHyp H as ( x2 x3) pat
+ end).
+Tactic Notation "iInv" constr(N) "with" constr(Hs) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4) ")"
+ constr(pat) :=
+ iInvCore N with Hs in
+ (fun x H => lazymatch type of x with
+ | unit => destruct x as []; iDestructHyp H as (x1 x2 x3 x4) pat
+ | _ => revert x; intros x1; iDestructHyp H as ( x2 x3 x4) pat
+ end).
+
+(* Without pattern *)
+Tactic Notation "iInv" constr(N) "as" constr(pat) constr(Hclose) :=
+ iInvCore N as (Some Hclose) in
+ (fun x H => lazymatch type of x with
+ | unit => destruct x as []; iDestructHyp H as pat
+ | _ => fail "Missing intro pattern for accessor variable"
+ end).
+Tactic Notation "iInv" constr(N) "as" "(" simple_intropattern(x1) ")"
+ constr(pat) constr(Hclose) :=
+ iInvCore N as (Some Hclose) in
+ (fun x H => lazymatch type of x with
+ | unit => destruct x as []; iDestructHyp H as (x1) pat
+ | _ => revert x; intros x1; iDestructHyp H as pat
+ end).
+Tactic Notation "iInv" constr(N) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) ")" constr(pat) constr(Hclose) :=
+ iInvCore N as (Some Hclose) in
+ (fun x H => lazymatch type of x with
+ | unit => destruct x as []; iDestructHyp H as (x1 x2) pat
+ | _ => revert x; intros x1; iDestructHyp H as ( x2) pat
+ end).
+Tactic Notation "iInv" constr(N) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) ")"
+ constr(pat) constr(Hclose) :=
+ iInvCore N as (Some Hclose) in
+ (fun x H => lazymatch type of x with
+ | unit => destruct x as []; iDestructHyp H as (x1 x2 x3) pat
+ | _ => revert x; intros x1; iDestructHyp H as ( x2 x3) pat
+ end).
+Tactic Notation "iInv" constr(N) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4) ")"
+ constr(pat) constr(Hclose) :=
+ iInvCore N as (Some Hclose) in
+ (fun x H => lazymatch type of x with
+ | unit => destruct x as []; iDestructHyp H as (x1 x2 x3 x4) pat
+ | _ => revert x; intros x1; iDestructHyp H as ( x2 x3 x4) pat
+ end).
+
+(* Without both *)
+Tactic Notation "iInv" constr(N) "as" constr(pat) :=
+ iInvCore N in
+ (fun x H => lazymatch type of x with
+ | unit => destruct x as []; iDestructHyp H as pat
+ | _ => fail "Missing intro pattern for accessor variable"
+ end).
+Tactic Notation "iInv" constr(N) "as" "(" simple_intropattern(x1) ")"
+ constr(pat) :=
+ iInvCore N in
+ (fun x H => lazymatch type of x with
+ | unit => destruct x as []; iDestructHyp H as (x1) pat
+ | _ => revert x; intros x1; iDestructHyp H as pat
+ end).
+Tactic Notation "iInv" constr(N) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) ")" constr(pat) :=
+ iInvCore N in
+ (fun x H => lazymatch type of x with
+ | unit => destruct x as []; iDestructHyp H as (x1 x2) pat
+ | _ => revert x; intros x1; iDestructHyp H as ( x2) pat
+ end).
+Tactic Notation "iInv" constr(N) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) ")"
+ constr(pat) :=
+ iInvCore N in
+ (fun x H => lazymatch type of x with
+ | unit => destruct x as []; iDestructHyp H as (x1 x2 x3) pat
+ | _ => revert x; intros x1; iDestructHyp H as ( x2 x3) pat
+ end).
+Tactic Notation "iInv" constr(N) "as" "(" simple_intropattern(x1)
+ simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4) ")"
+ constr(pat) :=
+ iInvCore N in
+ (fun x H => lazymatch type of x with
+ | unit => destruct x as []; iDestructHyp H as (x1 x2 x3 x4) pat
+ | _ => revert x; intros x1; iDestructHyp H as ( x2 x3 x4) pat
+ end).
+
+(** Miscellaneous *)
+Tactic Notation "iAccu" :=
+ iStartProof; eapply tac_accu; [pm_reflexivity || fail "iAccu: not an evar"].
+
+(** Automation *)
+Hint Extern 0 (_ ⊢ _) => iStartProof.
+
+(* Make sure that by and done solve trivial things in proof mode *)
+Hint Extern 0 (envs_entails _ _) => iPureIntro; try done.
+Hint Extern 0 (envs_entails _ ?Q) =>
+ first [is_evar Q; fail 1|iAssumption].
+Hint Extern 0 (envs_entails _ emp) => iEmpIntro.
+
+(* TODO: look for a more principled way of adding trivial hints like those
+below; see the discussion in !75 for further details. *)
+Hint Extern 0 (envs_entails _ (_ ≡ _)) =>
+ rewrite envs_entails_eq; apply bi.internal_eq_refl.
+Hint Extern 0 (envs_entails _ (big_opL _ _ _)) =>
+ rewrite envs_entails_eq; apply big_sepL_nil'.
+Hint Extern 0 (envs_entails _ (big_sepL2 _ _ _)) =>
+ rewrite envs_entails_eq; apply big_sepL2_nil'.
+Hint Extern 0 (envs_entails _ (big_opM _ _ _)) =>
+ rewrite envs_entails_eq; apply big_sepM_empty'.
+Hint Extern 0 (envs_entails _ (big_opS _ _ _)) =>
+ rewrite envs_entails_eq; apply big_sepS_empty'.
+Hint Extern 0 (envs_entails _ (big_opMS _ _ _)) =>
+ rewrite envs_entails_eq; apply big_sepMS_empty'.
+
+(* These introduce as much as possible at once, for better performance. *)
+Hint Extern 0 (envs_entails _ (∀ _, _)) => iIntros.
+Hint Extern 0 (envs_entails _ (_ → _)) => iIntros.
+Hint Extern 0 (envs_entails _ (_ -∗ _)) => iIntros.
+(* Multi-intro doesn't work for custom binders. *)
+Hint Extern 0 (envs_entails _ (∀.. _, _)) => iIntros (?).
+
+Hint Extern 1 (envs_entails _ (_ ∧ _)) => iSplit.
+Hint Extern 1 (envs_entails _ (_ ∗ _)) => iSplit.
+Hint Extern 1 (envs_entails _ (â–· _)) => iNext.
+Hint Extern 1 (envs_entails _ (â– _)) => iAlways.
+Hint Extern 1 (envs_entails _ (<pers> _)) => iAlways.
+Hint Extern 1 (envs_entails _ (<affine> _)) => iAlways.
+Hint Extern 1 (envs_entails _ (â–¡ _)) => iAlways.
+Hint Extern 1 (envs_entails _ (∃ _, _)) => iExists _.
+Hint Extern 1 (envs_entails _ (∃.. _, _)) => iExists _.
+Hint Extern 1 (envs_entails _ (â—‡ _)) => iModIntro.
+Hint Extern 1 (envs_entails _ (_ ∨ _)) => iLeft.
+Hint Extern 1 (envs_entails _ (_ ∨ _)) => iRight.
+Hint Extern 1 (envs_entails _ (|==> _)) => iModIntro.
+Hint Extern 1 (envs_entails _ (<absorb> _)) => iModIntro.
+Hint Extern 2 (envs_entails _ (|={_}=> _)) => iModIntro.
+
+Hint Extern 2 (envs_entails _ (_ ∗ _)) => progress iFrame : iFrame.
diff --git a/theories/proofmode/modalities.v b/theories/proofmode/modalities.v
new file mode 100644
index 0000000000000000000000000000000000000000..4ed0b68fd75540be3b470890bd53bcfb061fdda9
--- /dev/null
+++ b/theories/proofmode/modalities.v
@@ -0,0 +1,160 @@
+From iris.bi Require Export bi.
+From stdpp Require Import namespaces.
+Set Default Proof Using "Type".
+Import bi.
+
+(** The `iModIntro` tactic is not tied the Iris modalities, but can be
+instantiated with a variety of modalities.
+
+In order to plug in a modality, one has to decide for both the intuitionistic and
+spatial context what action should be performed upon introducing the modality:
+
+- Introduction is only allowed when the context is empty.
+- Introduction is only allowed when all hypotheses satisfy some predicate
+ `C : PROP → Prop` (where `C` should be a type class).
+- Introduction will transform each hypotheses using a type class
+ `C : PROP → PROP → Prop`, where the first parameter is the input and the
+ second parameter is the output. Hypotheses that cannot be transformed (i.e.
+ for which no instance of `C` can be found) will be cleared.
+- Introduction will clear the context.
+- Introduction will keep the context as-if.
+
+Formally, these actions correspond to the following inductive type: *)
+
+Inductive modality_action (PROP1 : bi) : bi → Type :=
+ | MIEnvIsEmpty {PROP2 : bi} : modality_action PROP1 PROP2
+ | MIEnvForall (C : PROP1 → Prop) : modality_action PROP1 PROP1
+ | MIEnvTransform {PROP2 : bi} (C : PROP2 → PROP1 → Prop) : modality_action PROP1 PROP2
+ | MIEnvClear {PROP2} : modality_action PROP1 PROP2
+ | MIEnvId : modality_action PROP1 PROP1.
+Arguments MIEnvIsEmpty {_ _}.
+Arguments MIEnvForall {_} _.
+Arguments MIEnvTransform {_ _} _.
+Arguments MIEnvClear {_ _}.
+Arguments MIEnvId {_}.
+
+Notation MIEnvFilter C := (MIEnvTransform (TCDiag C)).
+
+Definition modality_intuitionistic_action_spec {PROP1 PROP2}
+ (s : modality_action PROP1 PROP2) : (PROP1 → PROP2) → Prop :=
+ match s with
+ | MIEnvIsEmpty => λ M, True
+ | MIEnvForall C => λ M,
+ (∀ P, C P → □ P ⊢ M (□ P)) ∧
+ (∀ P Q, M P ∧ M Q ⊢ M (P ∧ Q))
+ | MIEnvTransform C => λ M,
+ (∀ P Q, C P Q → □ P ⊢ M (□ Q)) ∧
+ (∀ P Q, M P ∧ M Q ⊢ M (P ∧ Q))
+ | MIEnvClear => λ M, True
+ | MIEnvId => λ M, ∀ P, □ P ⊢ M (□ P)
+ end.
+
+Definition modality_spatial_action_spec {PROP1 PROP2}
+ (s : modality_action PROP1 PROP2) : (PROP1 → PROP2) → Prop :=
+ match s with
+ | MIEnvIsEmpty => λ M, True
+ | MIEnvForall C => λ M, ∀ P, C P → P ⊢ M P
+ | MIEnvTransform C => λ M, ∀ P Q, C P Q → P ⊢ M Q
+ | MIEnvClear => λ M, ∀ P, Absorbing (M P)
+ | MIEnvId => λ M, ∀ P, P ⊢ M P
+ end.
+
+(* A modality is then a record packing together the modality with the laws it
+should satisfy to justify the given actions for both contexts: *)
+Record modality_mixin {PROP1 PROP2 : bi} (M : PROP1 → PROP2)
+ (iaction saction : modality_action PROP1 PROP2) := {
+ modality_mixin_intuitionistic : modality_intuitionistic_action_spec iaction M;
+ modality_mixin_spatial : modality_spatial_action_spec saction M;
+ modality_mixin_emp : emp ⊢ M emp;
+ modality_mixin_mono P Q : (P ⊢ Q) → M P ⊢ M Q;
+ modality_mixin_sep P Q : M P ∗ M Q ⊢ M (P ∗ Q)
+}.
+
+Record modality (PROP1 PROP2 : bi) := Modality {
+ modality_car :> PROP1 → PROP2;
+ modality_intuitionistic_action : modality_action PROP1 PROP2;
+ modality_spatial_action : modality_action PROP1 PROP2;
+ modality_mixin_of :
+ modality_mixin modality_car modality_intuitionistic_action modality_spatial_action
+}.
+Arguments Modality {_ _} _ {_ _} _.
+Arguments modality_intuitionistic_action {_ _} _.
+Arguments modality_spatial_action {_ _} _.
+
+Section modality.
+ Context {PROP1 PROP2} (M : modality PROP1 PROP2).
+
+ Lemma modality_intuitionistic_transform C P Q :
+ modality_intuitionistic_action M = MIEnvTransform C → C P Q → □ P ⊢ M (□ Q).
+ Proof. destruct M as [??? []]; naive_solver. Qed.
+ Lemma modality_and_transform C P Q :
+ modality_intuitionistic_action M = MIEnvTransform C → M P ∧ M Q ⊢ M (P ∧ Q).
+ Proof. destruct M as [??? []]; naive_solver. Qed.
+ Lemma modality_spatial_transform C P Q :
+ modality_spatial_action M = MIEnvTransform C → C P Q → P ⊢ M Q.
+ Proof. destruct M as [??? []]; naive_solver. Qed.
+ Lemma modality_spatial_clear P :
+ modality_spatial_action M = MIEnvClear → Absorbing (M P).
+ Proof. destruct M as [??? []]; naive_solver. Qed.
+
+ Lemma modality_emp : emp ⊢ M emp.
+ Proof. eapply modality_mixin_emp, modality_mixin_of. Qed.
+ Lemma modality_mono P Q : (P ⊢ Q) → M P ⊢ M Q.
+ Proof. eapply modality_mixin_mono, modality_mixin_of. Qed.
+ Lemma modality_sep P Q : M P ∗ M Q ⊢ M (P ∗ Q).
+ Proof. eapply modality_mixin_sep, modality_mixin_of. Qed.
+ Global Instance modality_mono' : Proper ((⊢) ==> (⊢)) M.
+ Proof. intros P Q. apply modality_mono. Qed.
+ Global Instance modality_flip_mono' : Proper (flip (⊢) ==> flip (⊢)) M.
+ Proof. intros P Q. apply modality_mono. Qed.
+ Global Instance modality_proper : Proper ((≡) ==> (≡)) M.
+ Proof. intros P Q. rewrite !equiv_spec=> -[??]; eauto using modality_mono. Qed.
+End modality.
+
+Section modality1.
+ Context {PROP} (M : modality PROP PROP).
+
+ Lemma modality_intuitionistic_forall C P :
+ modality_intuitionistic_action M = MIEnvForall C → C P → □ P ⊢ M (□ P).
+ Proof. destruct M as [??? []]; naive_solver. Qed.
+ Lemma modality_and_forall C P Q :
+ modality_intuitionistic_action M = MIEnvForall C → M P ∧ M Q ⊢ M (P ∧ Q).
+ Proof. destruct M as [??? []]; naive_solver. Qed.
+ Lemma modality_intuitionistic_id P :
+ modality_intuitionistic_action M = MIEnvId → □ P ⊢ M (□ P).
+ Proof. destruct M as [??? []]; naive_solver. Qed.
+ Lemma modality_spatial_forall C P :
+ modality_spatial_action M = MIEnvForall C → C P → P ⊢ M P.
+ Proof. destruct M as [??? []]; naive_solver. Qed.
+ Lemma modality_spatial_id P :
+ modality_spatial_action M = MIEnvId → P ⊢ M P.
+ Proof. destruct M as [??? []]; naive_solver. Qed.
+
+ Lemma modality_intuitionistic_forall_big_and C Ps :
+ modality_intuitionistic_action M = MIEnvForall C →
+ Forall C Ps → □ [∧] Ps ⊢ M (□ [∧] Ps).
+ Proof.
+ induction 2 as [|P Ps ? _ IH]; simpl.
+ - by rewrite intuitionistically_True_emp -modality_emp.
+ - rewrite intuitionistically_and -modality_and_forall // -IH.
+ by rewrite {1}(modality_intuitionistic_forall _ P).
+ Qed.
+ Lemma modality_spatial_forall_big_sep C Ps :
+ modality_spatial_action M = MIEnvForall C →
+ Forall C Ps → [∗] Ps ⊢ M ([∗] Ps).
+ Proof.
+ induction 2 as [|P Ps ? _ IH]; simpl.
+ - by rewrite -modality_emp.
+ - by rewrite -modality_sep -IH {1}(modality_spatial_forall _ P).
+ Qed.
+End modality1.
+
+(** The identity modality [modality_id] can be used in combination with
+[FromModal modality_id] to support introduction for modalities that enjoy
+[P ⊢ M P]. This is done by defining an instance [FromModal modality_id (M P) P],
+which will instruct [iModIntro] to introduce the modality without modifying the
+proof mode context. Examples of such modalities are [bupd], [fupd], [except_0],
+[monPred_subjectively] and [bi_absorbingly]. *)
+Lemma modality_id_mixin {PROP : bi} : modality_mixin (@id PROP) MIEnvId MIEnvId.
+Proof. split; simpl; eauto. Qed.
+Definition modality_id {PROP : bi} := Modality (@id PROP) modality_id_mixin.
diff --git a/theories/proofmode/modality_instances.v b/theories/proofmode/modality_instances.v
new file mode 100644
index 0000000000000000000000000000000000000000..2cb4571d58079a36b9aae058a7e4025d6e73718d
--- /dev/null
+++ b/theories/proofmode/modality_instances.v
@@ -0,0 +1,72 @@
+From iris.bi Require Import bi.
+From iris.proofmode Require Export classes.
+Set Default Proof Using "Type".
+Import bi.
+
+Section bi_modalities.
+ Context {PROP : bi}.
+
+ Lemma modality_persistently_mixin :
+ modality_mixin (@bi_persistently PROP) MIEnvId MIEnvClear.
+ Proof.
+ split; simpl; eauto using equiv_entails_sym, persistently_intro,
+ persistently_mono, persistently_sep_2 with typeclass_instances.
+ Qed.
+ Definition modality_persistently :=
+ Modality _ modality_persistently_mixin.
+
+ Lemma modality_affinely_mixin :
+ modality_mixin (@bi_affinely PROP) MIEnvId (MIEnvForall Affine).
+ Proof.
+ split; simpl; eauto using equiv_entails_sym, affinely_intro, affinely_mono,
+ affinely_sep_2 with typeclass_instances.
+ Qed.
+ Definition modality_affinely :=
+ Modality _ modality_affinely_mixin.
+
+ Lemma modality_intuitionistically_mixin :
+ modality_mixin (@bi_intuitionistically PROP) MIEnvId MIEnvIsEmpty.
+ Proof.
+ split; simpl; eauto using equiv_entails_sym, intuitionistically_emp,
+ affinely_mono, persistently_mono, intuitionistically_idemp,
+ intuitionistically_sep_2 with typeclass_instances.
+ Qed.
+ Definition modality_intuitionistically :=
+ Modality _ modality_intuitionistically_mixin.
+
+ Lemma modality_embed_mixin `{BiEmbed PROP PROP'} :
+ modality_mixin (@embed PROP PROP' _)
+ (MIEnvTransform IntoEmbed) (MIEnvTransform IntoEmbed).
+ Proof.
+ split; simpl; split_and?;
+ eauto using equiv_entails_sym, embed_emp_2, embed_sep, embed_and.
+ - intros P Q. rewrite /IntoEmbed=> ->. by rewrite embed_intuitionistically_2.
+ - by intros P Q ->.
+ Qed.
+ Definition modality_embed `{BiEmbed PROP PROP'} :=
+ Modality _ modality_embed_mixin.
+End bi_modalities.
+
+Section sbi_modalities.
+ Context {PROP : sbi}.
+
+ Lemma modality_plainly_mixin `{BiPlainly PROP} :
+ modality_mixin (@plainly PROP _) (MIEnvForall Plain) MIEnvClear.
+ Proof.
+ split; simpl; split_and?; eauto using equiv_entails_sym, plainly_intro,
+ plainly_mono, plainly_and, plainly_sep_2 with typeclass_instances.
+ Qed.
+ Definition modality_plainly `{BiPlainly PROP} :=
+ Modality _ modality_plainly_mixin.
+
+ Lemma modality_laterN_mixin n :
+ modality_mixin (@sbi_laterN PROP n)
+ (MIEnvTransform (MaybeIntoLaterN false n)) (MIEnvTransform (MaybeIntoLaterN false n)).
+ Proof.
+ split; simpl; split_and?; eauto using equiv_entails_sym, laterN_intro,
+ laterN_mono, laterN_and, laterN_sep with typeclass_instances.
+ rewrite /MaybeIntoLaterN=> P Q ->. by rewrite laterN_intuitionistically_2.
+ Qed.
+ Definition modality_laterN n :=
+ Modality _ (modality_laterN_mixin n).
+End sbi_modalities.
diff --git a/theories/proofmode/monpred.v b/theories/proofmode/monpred.v
new file mode 100644
index 0000000000000000000000000000000000000000..5d85ca71d0636797ebe12c4bcadf9a83204b5938
--- /dev/null
+++ b/theories/proofmode/monpred.v
@@ -0,0 +1,615 @@
+From iris.bi Require Export monpred.
+From iris.bi Require Import plainly.
+From iris.proofmode Require Import tactics modality_instances.
+
+Class MakeMonPredAt {I : biIndex} {PROP : bi} (i : I)
+ (P : monPred I PROP) (ð“Ÿ : PROP) :=
+ make_monPred_at : P i ⊣⊢ ð“Ÿ.
+Arguments MakeMonPredAt {_ _} _ _%I _%I.
+Hint Mode MakeMonPredAt + + - ! - : typeclass_instances.
+
+Class IsBiIndexRel {I : biIndex} (i j : I) := is_bi_index_rel : i ⊑ j.
+Hint Mode IsBiIndexRel + - - : typeclass_instances.
+Instance is_bi_index_rel_refl {I : biIndex} (i : I) : IsBiIndexRel i i | 0.
+Proof. by rewrite /IsBiIndexRel. Qed.
+Hint Extern 1 (IsBiIndexRel _ _) => unfold IsBiIndexRel; assumption
+ : typeclass_instances.
+
+(** Frame [ð“¡] into the goal [monPred_at P i] and determine the remainder [ð“ ].
+ Used when framing encounters a monPred_at in the goal. *)
+Class FrameMonPredAt {I : biIndex} {PROP : bi} (p : bool) (i : I)
+ (ð“¡ : PROP) (P : monPred I PROP) (ð“ : PROP) :=
+ frame_monPred_at : â–¡?p 𓡠∗ ð“ -∗ P i.
+Arguments FrameMonPredAt {_ _} _ _ _%I _%I _%I.
+Hint Mode FrameMonPredAt + + + - ! ! - : typeclass_instances.
+
+Section modalities.
+ Context {I : biIndex} {PROP : bi}.
+
+ Lemma modality_objectively_mixin :
+ modality_mixin (@monPred_objectively I PROP)
+ (MIEnvFilter Objective) (MIEnvFilter Objective).
+ Proof.
+ split; simpl; split_and?; intros;
+ try match goal with H : TCDiag _ _ _ |- _ => destruct H end;
+ eauto using bi.equiv_entails_sym, objective_objectively,
+ monPred_objectively_mono, monPred_objectively_and,
+ monPred_objectively_sep_2 with typeclass_instances.
+ Qed.
+ Definition modality_objectively :=
+ Modality _ modality_objectively_mixin.
+End modalities.
+
+Section bi.
+Context {I : biIndex} {PROP : bi}.
+Local Notation monPredI := (monPredI I PROP).
+Local Notation monPred := (monPred I PROP).
+Local Notation MakeMonPredAt := (@MakeMonPredAt I PROP).
+Implicit Types P Q R : monPred.
+Implicit Types ð“Ÿ ð“ ð“¡ : PROP.
+Implicit Types φ : Prop.
+Implicit Types i j : I.
+
+Global Instance from_modal_objectively P :
+ FromModal modality_objectively (<obj> P) (<obj> P) P | 1.
+Proof. by rewrite /FromModal. Qed.
+Global Instance from_modal_subjectively P :
+ FromModal modality_id (<subj> P) (<subj> P) P | 1.
+Proof. by rewrite /FromModal /= -monPred_subjectively_intro. Qed.
+
+Global Instance from_modal_affinely_monPred_at `(sel : A) P Q ð“ i :
+ FromModal modality_affinely sel P Q → MakeMonPredAt i Q ð“ →
+ FromModal modality_affinely sel (P i) ð“ | 0.
+Proof.
+ rewrite /FromModal /MakeMonPredAt /==> <- <-. by rewrite monPred_at_affinely.
+Qed.
+Global Instance from_modal_persistently_monPred_at `(sel : A) P Q ð“ i :
+ FromModal modality_persistently sel P Q → MakeMonPredAt i Q ð“ →
+ FromModal modality_persistently sel (P i) ð“ | 0.
+Proof.
+ rewrite /FromModal /MakeMonPredAt /==> <- <-. by rewrite monPred_at_persistently.
+Qed.
+Global Instance from_modal_intuitionistically_monPred_at `(sel : A) P Q ð“ i :
+ FromModal modality_intuitionistically sel P Q → MakeMonPredAt i Q ð“ →
+ FromModal modality_intuitionistically sel (P i) ð“ | 0.
+Proof.
+ rewrite /FromModal /MakeMonPredAt /==> <- <-.
+ by rewrite monPred_at_affinely monPred_at_persistently.
+Qed.
+Global Instance from_modal_id_monPred_at `(sel : A) P Q ð“ i :
+ FromModal modality_id sel P Q → MakeMonPredAt i Q ð“ →
+ FromModal modality_id sel (P i) ð“ .
+Proof. by rewrite /FromModal /MakeMonPredAt=> <- <-. Qed.
+
+Global Instance make_monPred_at_pure φ i : MakeMonPredAt i ⌜φ⌠⌜φâŒ.
+Proof. by rewrite /MakeMonPredAt monPred_at_pure. Qed.
+Global Instance make_monPred_at_emp i : MakeMonPredAt i emp emp.
+Proof. by rewrite /MakeMonPredAt monPred_at_emp. Qed.
+Global Instance make_monPred_at_sep i P ð“Ÿ Q ð“ :
+ MakeMonPredAt i P 𓟠→ MakeMonPredAt i Q ð“ →
+ MakeMonPredAt i (P ∗ Q) (𓟠∗ ð“ ).
+Proof. by rewrite /MakeMonPredAt monPred_at_sep=><-<-. Qed.
+Global Instance make_monPred_at_and i P ð“Ÿ Q ð“ :
+ MakeMonPredAt i P 𓟠→ MakeMonPredAt i Q ð“ →
+ MakeMonPredAt i (P ∧ Q) (𓟠∧ ð“ ).
+Proof. by rewrite /MakeMonPredAt monPred_at_and=><-<-. Qed.
+Global Instance make_monPred_at_or i P ð“Ÿ Q ð“ :
+ MakeMonPredAt i P 𓟠→ MakeMonPredAt i Q ð“ →
+ MakeMonPredAt i (P ∨ Q) (𓟠∨ ð“ ).
+Proof. by rewrite /MakeMonPredAt monPred_at_or=><-<-. Qed.
+Global Instance make_monPred_at_forall {A} i (Φ : A → monPred) (Ψ : A → PROP) :
+ (∀ a, MakeMonPredAt i (Φ a) (Ψ a)) → MakeMonPredAt i (∀ a, Φ a) (∀ a, Ψ a).
+Proof. rewrite /MakeMonPredAt monPred_at_forall=>H. by setoid_rewrite <- H. Qed.
+Global Instance make_monPred_at_exists {A} i (Φ : A → monPred) (Ψ : A → PROP) :
+ (∀ a, MakeMonPredAt i (Φ a) (Ψ a)) → MakeMonPredAt i (∃ a, Φ a) (∃ a, Ψ a).
+Proof. rewrite /MakeMonPredAt monPred_at_exist=>H. by setoid_rewrite <- H. Qed.
+Global Instance make_monPred_at_persistently i P ð“Ÿ :
+ MakeMonPredAt i P 𓟠→ MakeMonPredAt i (<pers> P) (<pers> ð“Ÿ).
+Proof. by rewrite /MakeMonPredAt monPred_at_persistently=><-. Qed.
+Global Instance make_monPred_at_affinely i P ð“Ÿ :
+ MakeMonPredAt i P 𓟠→ MakeMonPredAt i (<affine> P) (<affine> ð“Ÿ).
+Proof. by rewrite /MakeMonPredAt monPred_at_affinely=><-. Qed.
+Global Instance make_monPred_at_intuitionistically i P ð“Ÿ :
+ MakeMonPredAt i P 𓟠→ MakeMonPredAt i (â–¡ P) (â–¡ ð“Ÿ).
+Proof. by rewrite /MakeMonPredAt monPred_at_intuitionistically=><-. Qed.
+Global Instance make_monPred_at_absorbingly i P ð“Ÿ :
+ MakeMonPredAt i P 𓟠→ MakeMonPredAt i (<absorb> P) (<absorb> ð“Ÿ).
+Proof. by rewrite /MakeMonPredAt monPred_at_absorbingly=><-. Qed.
+Global Instance make_monPred_at_persistently_if i P ð“Ÿ p :
+ MakeMonPredAt i P 𓟠→
+ MakeMonPredAt i (<pers>?p P) (<pers>?p ð“Ÿ).
+Proof. destruct p; simpl; apply _. Qed.
+Global Instance make_monPred_at_affinely_if i P ð“Ÿ p :
+ MakeMonPredAt i P 𓟠→
+ MakeMonPredAt i (<affine>?p P) (<affine>?p ð“Ÿ).
+Proof. destruct p; simpl; apply _. Qed.
+Global Instance make_monPred_at_intuitionistically_if i P ð“Ÿ p :
+ MakeMonPredAt i P 𓟠→
+ MakeMonPredAt i (â–¡?p P) (â–¡?p ð“Ÿ).
+Proof. destruct p; simpl; apply _. Qed.
+Global Instance make_monPred_at_embed i ð“Ÿ : MakeMonPredAt i ⎡ð“ŸâŽ¤ ð“Ÿ.
+Proof. by rewrite /MakeMonPredAt monPred_at_embed. Qed.
+Global Instance make_monPred_at_in i j : MakeMonPredAt j (monPred_in i) ⌜i ⊑ jâŒ.
+Proof. by rewrite /MakeMonPredAt monPred_at_in. Qed.
+Global Instance make_monPred_at_default i P : MakeMonPredAt i P (P i) | 100.
+Proof. by rewrite /MakeMonPredAt. Qed.
+Global Instance make_monPred_at_bupd `{BiBUpd PROP} i P ð“Ÿ :
+ MakeMonPredAt i P 𓟠→ MakeMonPredAt i (|==> P)%I (|==> ð“Ÿ)%I.
+Proof. by rewrite /MakeMonPredAt monPred_at_bupd=> <-. Qed.
+
+Global Instance from_assumption_make_monPred_at_l p i j P ð“Ÿ :
+ MakeMonPredAt i P 𓟠→ IsBiIndexRel j i → KnownLFromAssumption p (P j) ð“Ÿ.
+Proof.
+ rewrite /MakeMonPredAt /KnownLFromAssumption /FromAssumption /IsBiIndexRel=><- ->.
+ apply bi.intuitionistically_if_elim.
+Qed.
+Global Instance from_assumption_make_monPred_at_r p i j P ð“Ÿ :
+ MakeMonPredAt i P 𓟠→ IsBiIndexRel i j → KnownRFromAssumption p 𓟠(P j).
+Proof.
+ rewrite /MakeMonPredAt /KnownRFromAssumption /FromAssumption /IsBiIndexRel=><- ->.
+ apply bi.intuitionistically_if_elim.
+Qed.
+
+Global Instance from_assumption_make_monPred_objectively P Q :
+ FromAssumption p P Q → KnownLFromAssumption p (<obj> P) Q.
+Proof.
+ intros ?.
+ by rewrite /KnownLFromAssumption /FromAssumption monPred_objectively_elim.
+Qed.
+Global Instance from_assumption_make_monPred_subjectively P Q :
+ FromAssumption p P Q → KnownRFromAssumption p P (<subj> Q).
+Proof.
+ intros ?.
+ by rewrite /KnownRFromAssumption /FromAssumption -monPred_subjectively_intro.
+Qed.
+
+Global Instance as_emp_valid_monPred_at φ P (Φ : I → PROP) :
+ AsEmpValid0 φ P → (∀ i, MakeMonPredAt i P (Φ i)) → AsEmpValid φ (∀ i, Φ i) | 100.
+Proof.
+ rewrite /MakeMonPredAt /AsEmpValid0 /AsEmpValid /bi_emp_valid=> -> EQ.
+ setoid_rewrite <-EQ. split.
+ - move=>[H]. apply bi.forall_intro=>i. rewrite -H. by rewrite monPred_at_emp.
+ - move=>HP. split=>i. rewrite monPred_at_emp HP bi.forall_elim //.
+Qed.
+Global Instance as_emp_valid_monPred_at_wand φ P Q (Φ Ψ : I → PROP) :
+ AsEmpValid0 φ (P -∗ Q) →
+ (∀ i, MakeMonPredAt i P (Φ i)) → (∀ i, MakeMonPredAt i Q (Ψ i)) →
+ AsEmpValid φ (∀ i, Φ i -∗ Ψ i).
+Proof.
+ rewrite /AsEmpValid0 /AsEmpValid /MakeMonPredAt. intros -> EQ1 EQ2.
+ setoid_rewrite <-EQ1. setoid_rewrite <-EQ2. split.
+ - move=>/bi.wand_entails HP. setoid_rewrite HP. by iIntros (i) "$".
+ - move=>HP. apply bi.entails_wand. split=>i. iIntros "H". by iApply HP.
+Qed.
+Global Instance as_emp_valid_monPred_at_equiv φ P Q (Φ Ψ : I → PROP) :
+ AsEmpValid0 φ (P ∗-∗ Q) →
+ (∀ i, MakeMonPredAt i P (Φ i)) → (∀ i, MakeMonPredAt i Q (Ψ i)) →
+ AsEmpValid φ (∀ i, Φ i ∗-∗ Ψ i).
+Proof.
+ rewrite /AsEmpValid0 /AsEmpValid /MakeMonPredAt. intros -> EQ1 EQ2.
+ setoid_rewrite <-EQ1. setoid_rewrite <-EQ2. split.
+ - move=>/bi.wand_iff_equiv HP. setoid_rewrite HP. iIntros. iSplit; iIntros "$".
+ - move=>HP. apply bi.equiv_wand_iff. split=>i. by iSplit; iIntros; iApply HP.
+Qed.
+
+Global Instance into_pure_monPred_at P φ i : IntoPure P φ → IntoPure (P i) φ.
+Proof. rewrite /IntoPure=>->. by rewrite monPred_at_pure. Qed.
+Global Instance from_pure_monPred_at a P φ i : FromPure a P φ → FromPure a (P i) φ.
+Proof. rewrite /FromPure=><-. by rewrite monPred_at_affinely_if monPred_at_pure. Qed.
+Global Instance into_pure_monPred_in i j : @IntoPure PROP (monPred_in i j) (i ⊑ j).
+Proof. by rewrite /IntoPure monPred_at_in. Qed.
+Global Instance from_pure_monPred_in i j af : @FromPure PROP af (monPred_in i j) (i ⊑ j).
+Proof. by rewrite /FromPure monPred_at_in bi.affinely_if_elim. Qed.
+
+Global Instance into_persistent_monPred_at p P Q ð“ i :
+ IntoPersistent p P Q → MakeMonPredAt i Q ð“ → IntoPersistent p (P i) ð“ | 0.
+Proof.
+ rewrite /IntoPersistent /MakeMonPredAt =>-[/(_ i) ?] <-.
+ by rewrite -monPred_at_persistently -monPred_at_persistently_if.
+Qed.
+
+Lemma into_wand_monPred_at_unknown_unknown p q R P ð“Ÿ Q ð“ i :
+ IntoWand p q R P Q → MakeMonPredAt i P 𓟠→ MakeMonPredAt i Q ð“ →
+ IntoWand p q (R i) ð“Ÿ ð“ .
+Proof.
+ rewrite /IntoWand /MakeMonPredAt /bi_affinely_if /bi_persistently_if.
+ destruct p, q=> /bi.wand_elim_l' [/(_ i) H] <- <-; apply bi.wand_intro_r;
+ revert H; by rewrite monPred_at_sep ?monPred_at_affinely ?monPred_at_persistently.
+Qed.
+Lemma into_wand_monPred_at_unknown_known p q R P ð“Ÿ Q i j :
+ IsBiIndexRel i j → IntoWand p q R P Q →
+ MakeMonPredAt j P 𓟠→ IntoWand p q (R i) 𓟠(Q j).
+Proof.
+ rewrite /IntoWand /IsBiIndexRel /MakeMonPredAt=>-> ? ?.
+ eapply into_wand_monPred_at_unknown_unknown=>//. apply _.
+Qed.
+Lemma into_wand_monPred_at_known_unknown_le p q R P Q ð“ i j :
+ IsBiIndexRel i j → IntoWand p q R P Q →
+ MakeMonPredAt j Q ð“ → IntoWand p q (R i) (P j) ð“ .
+Proof.
+ rewrite /IntoWand /IsBiIndexRel /MakeMonPredAt=>-> ? ?.
+ eapply into_wand_monPred_at_unknown_unknown=>//. apply _.
+Qed.
+Lemma into_wand_monPred_at_known_unknown_ge p q R P Q ð“ i j :
+ IsBiIndexRel i j → IntoWand p q R P Q →
+ MakeMonPredAt j Q ð“ → IntoWand p q (R j) (P i) ð“ .
+Proof.
+ rewrite /IntoWand /IsBiIndexRel /MakeMonPredAt=>-> ? ?.
+ eapply into_wand_monPred_at_unknown_unknown=>//. apply _.
+Qed.
+
+Global Instance into_wand_wand'_monPred p q P Q ð“Ÿ ð“ i :
+ IntoWand' p q ((P -∗ Q) i) ð“Ÿ ð“ → IntoWand p q ((P -∗ Q) i) ð“Ÿ ð“ | 100.
+Proof. done. Qed.
+Global Instance into_wand_impl'_monPred p q P Q ð“Ÿ ð“ i :
+ IntoWand' p q ((P → Q) i) ð“Ÿ ð“ → IntoWand p q ((P → Q) i) ð“Ÿ ð“ | 100.
+Proof. done. Qed.
+
+Global Instance from_forall_monPred_at_wand P Q (Φ Ψ : I → PROP) i :
+ (∀ j, MakeMonPredAt j P (Φ j)) → (∀ j, MakeMonPredAt j Q (Ψ j)) →
+ FromForall ((P -∗ Q) i)%I (λ j, ⌜i ⊑ j⌠→ Φ j -∗ Ψ j)%I.
+Proof.
+ rewrite /FromForall /MakeMonPredAt monPred_at_wand=> H1 H2. do 2 f_equiv.
+ by rewrite H1 H2.
+Qed.
+Global Instance from_forall_monPred_at_impl P Q (Φ Ψ : I → PROP) i :
+ (∀ j, MakeMonPredAt j P (Φ j)) → (∀ j, MakeMonPredAt j Q (Ψ j)) →
+ FromForall ((P → Q) i)%I (λ j, ⌜i ⊑ j⌠→ Φ j → Ψ j)%I.
+Proof.
+ rewrite /FromForall /MakeMonPredAt monPred_at_impl=> H1 H2. do 2 f_equiv.
+ by rewrite H1 H2 bi.pure_impl_forall.
+Qed.
+
+Global Instance into_forall_monPred_at_index P i :
+ IntoForall (P i) (λ j, ⌜i ⊑ j⌠→ P j)%I | 100.
+Proof.
+ rewrite /IntoForall. setoid_rewrite bi.pure_impl_forall.
+ do 2 apply bi.forall_intro=>?. by f_equiv.
+Qed.
+
+Global Instance from_and_monPred_at P Q1 ð“ 1 Q2 ð“ 2 i :
+ FromAnd P Q1 Q2 → MakeMonPredAt i Q1 ð“ 1 → MakeMonPredAt i Q2 ð“ 2 →
+ FromAnd (P i) ð“ 1 ð“ 2.
+Proof.
+ rewrite /FromAnd /MakeMonPredAt /MakeMonPredAt=> <- <- <-.
+ by rewrite monPred_at_and.
+Qed.
+Global Instance into_and_monPred_at p P Q1 ð“ 1 Q2 ð“ 2 i :
+ IntoAnd p P Q1 Q2 → MakeMonPredAt i Q1 ð“ 1 → MakeMonPredAt i Q2 ð“ 2 →
+ IntoAnd p (P i) ð“ 1 ð“ 2.
+Proof.
+ rewrite /IntoAnd /MakeMonPredAt /bi_affinely_if /bi_persistently_if.
+ destruct p=>-[/(_ i) H] <- <-; revert H;
+ by rewrite ?monPred_at_affinely ?monPred_at_persistently monPred_at_and.
+Qed.
+
+Global Instance from_sep_monPred_at P Q1 ð“ 1 Q2 ð“ 2 i :
+ FromSep P Q1 Q2 → MakeMonPredAt i Q1 ð“ 1 → MakeMonPredAt i Q2 ð“ 2 →
+ FromSep (P i) ð“ 1 ð“ 2.
+Proof. rewrite /FromSep /MakeMonPredAt=> <- <- <-. by rewrite monPred_at_sep. Qed.
+Global Instance into_sep_monPred_at P Q1 ð“ 1 Q2 ð“ 2 i :
+ IntoSep P Q1 Q2 → MakeMonPredAt i Q1 ð“ 1 → MakeMonPredAt i Q2 ð“ 2 →
+ IntoSep (P i) ð“ 1 ð“ 2.
+Proof. rewrite /IntoSep /MakeMonPredAt=> -> <- <-. by rewrite monPred_at_sep. Qed.
+Global Instance from_or_monPred_at P Q1 ð“ 1 Q2 ð“ 2 i :
+ FromOr P Q1 Q2 → MakeMonPredAt i Q1 ð“ 1 → MakeMonPredAt i Q2 ð“ 2 →
+ FromOr (P i) ð“ 1 ð“ 2.
+Proof. rewrite /FromOr /MakeMonPredAt=> <- <- <-. by rewrite monPred_at_or. Qed.
+Global Instance into_or_monPred_at P Q1 ð“ 1 Q2 ð“ 2 i :
+ IntoOr P Q1 Q2 → MakeMonPredAt i Q1 ð“ 1 → MakeMonPredAt i Q2 ð“ 2 →
+ IntoOr (P i) ð“ 1 ð“ 2.
+Proof. rewrite /IntoOr /MakeMonPredAt=> -> <- <-. by rewrite monPred_at_or. Qed.
+
+Global Instance from_exist_monPred_at {A} P (Φ : A → monPred) (Ψ : A → PROP) i :
+ FromExist P Φ → (∀ a, MakeMonPredAt i (Φ a) (Ψ a)) → FromExist (P i) Ψ.
+Proof.
+ rewrite /FromExist /MakeMonPredAt=><- H. setoid_rewrite <- H.
+ by rewrite monPred_at_exist.
+Qed.
+Global Instance into_exist_monPred_at {A} P (Φ : A → monPred) (Ψ : A → PROP) i :
+ IntoExist P Φ → (∀ a, MakeMonPredAt i (Φ a) (Ψ a)) → IntoExist (P i) Ψ.
+Proof.
+ rewrite /IntoExist /MakeMonPredAt=>-> H. setoid_rewrite <- H.
+ by rewrite monPred_at_exist.
+Qed.
+
+Global Instance from_forall_monPred_at_objectively P (Φ : I → PROP) i :
+ (∀ i, MakeMonPredAt i P (Φ i)) → FromForall ((<obj> P) i)%I Φ.
+Proof.
+ rewrite /FromForall /MakeMonPredAt monPred_at_objectively=>H. by setoid_rewrite <- H.
+Qed.
+Global Instance into_forall_monPred_at_objectively P (Φ : I → PROP) i :
+ (∀ i, MakeMonPredAt i P (Φ i)) → IntoForall ((<obj> P) i) Φ.
+Proof.
+ rewrite /IntoForall /MakeMonPredAt monPred_at_objectively=>H. by setoid_rewrite <- H.
+Qed.
+
+Global Instance from_exist_monPred_at_ex P (Φ : I → PROP) i :
+ (∀ i, MakeMonPredAt i P (Φ i)) → FromExist ((<subj> P) i) Φ.
+Proof.
+ rewrite /FromExist /MakeMonPredAt monPred_at_subjectively=>H. by setoid_rewrite <- H.
+Qed.
+Global Instance into_exist_monPred_at_ex P (Φ : I → PROP) i :
+ (∀ i, MakeMonPredAt i P (Φ i)) → IntoExist ((<subj> P) i) Φ.
+Proof.
+ rewrite /IntoExist /MakeMonPredAt monPred_at_subjectively=>H. by setoid_rewrite <- H.
+Qed.
+
+Global Instance from_forall_monPred_at {A} P (Φ : A → monPred) (Ψ : A → PROP) i :
+ FromForall P Φ → (∀ a, MakeMonPredAt i (Φ a) (Ψ a)) → FromForall (P i) Ψ.
+Proof.
+ rewrite /FromForall /MakeMonPredAt=><- H. setoid_rewrite <- H.
+ by rewrite monPred_at_forall.
+Qed.
+Global Instance into_forall_monPred_at {A} P (Φ : A → monPred) (Ψ : A → PROP) i :
+ IntoForall P Φ → (∀ a, MakeMonPredAt i (Φ a) (Ψ a)) → IntoForall (P i) Ψ.
+Proof.
+ rewrite /IntoForall /MakeMonPredAt=>-> H. setoid_rewrite <- H.
+ by rewrite monPred_at_forall.
+Qed.
+
+(* Framing. *)
+Global Instance frame_monPred_at_enter p i ð“¡ P ð“ :
+ FrameMonPredAt p i ð“¡ P ð“ → Frame p ð“¡ (P i) ð“ .
+Proof. intros. done. Qed.
+Global Instance frame_monPred_at_here p P i j :
+ IsBiIndexRel i j → FrameMonPredAt p j (P i) P emp | 0.
+Proof.
+ rewrite /FrameMonPredAt /IsBiIndexRel right_id bi.intuitionistically_if_elim=> -> //.
+Qed.
+
+Global Instance frame_monPred_at_embed p ð“¡ ð“ ð“Ÿ i :
+ Frame p ð“¡ ð“Ÿ ð“ → FrameMonPredAt p i ð“¡ (embed (B:=monPredI) ð“Ÿ) ð“ .
+Proof. rewrite /Frame /FrameMonPredAt=> ->. by rewrite monPred_at_embed. Qed.
+Global Instance frame_monPred_at_sep p P Q ð“¡ ð“ i :
+ Frame p ð“¡ (P i ∗ Q i) ð“ → FrameMonPredAt p i ð“¡ (P ∗ Q) ð“ .
+Proof. rewrite /Frame /FrameMonPredAt=> ->. by rewrite monPred_at_sep. Qed.
+Global Instance frame_monPred_at_and p P Q ð“¡ ð“ i :
+ Frame p ð“¡ (P i ∧ Q i) ð“ → FrameMonPredAt p i ð“¡ (P ∧ Q) ð“ .
+Proof. rewrite /Frame /FrameMonPredAt=> ->. by rewrite monPred_at_and. Qed.
+Global Instance frame_monPred_at_or p P Q ð“¡ ð“ i :
+ Frame p ð“¡ (P i ∨ Q i) ð“ → FrameMonPredAt p i ð“¡ (P ∨ Q) ð“ .
+Proof. rewrite /Frame /FrameMonPredAt=> ->. by rewrite monPred_at_or. Qed.
+Global Instance frame_monPred_at_wand p P R Q1 Q2 i j :
+ IsBiIndexRel i j →
+ Frame p R Q1 Q2 →
+ FrameMonPredAt p j (R i) (P -∗ Q1) ((P -∗ Q2) i).
+Proof.
+ rewrite /Frame /FrameMonPredAt=>-> Hframe.
+ rewrite -monPred_at_intuitionistically_if -monPred_at_sep. apply monPred_in_entails.
+ change ((□?p R ∗ (P -∗ Q2)) -∗ P -∗ Q1). apply bi.wand_intro_r.
+ rewrite -assoc bi.wand_elim_l. done.
+Qed.
+Global Instance frame_monPred_at_impl P R Q1 Q2 i j :
+ IsBiIndexRel i j →
+ Frame true R Q1 Q2 →
+ FrameMonPredAt true j (R i) (P → Q1) ((P → Q2) i).
+Proof.
+ rewrite /Frame /FrameMonPredAt=>-> Hframe.
+ rewrite -monPred_at_intuitionistically_if -monPred_at_sep. apply monPred_in_entails.
+ change ((□ R ∗ (P → Q2)) -∗ P → Q1).
+ rewrite -bi.persistently_and_intuitionistically_sep_l. apply bi.impl_intro_r.
+ rewrite -assoc bi.impl_elim_l bi.persistently_and_intuitionistically_sep_l. done.
+Qed.
+Global Instance frame_monPred_at_forall {X : Type} p (Ψ : X → monPred) ð“¡ ð“ i :
+ Frame p ð“¡ (∀ x, Ψ x i) ð“ → FrameMonPredAt p i ð“¡ (∀ x, Ψ x) ð“ .
+Proof. rewrite /Frame /FrameMonPredAt=> ->. by rewrite monPred_at_forall. Qed.
+Global Instance frame_monPred_at_exist {X : Type} p (Ψ : X → monPred) ð“¡ ð“ i :
+ Frame p ð“¡ (∃ x, Ψ x i) ð“ → FrameMonPredAt p i ð“¡ (∃ x, Ψ x) ð“ .
+Proof. rewrite /Frame /FrameMonPredAt=> ->. by rewrite monPred_at_exist. Qed.
+
+Global Instance frame_monPred_at_absorbingly p P ð“¡ ð“ i :
+ Frame p ð“¡ (<absorb> P i) ð“ → FrameMonPredAt p i ð“¡ (<absorb> P) ð“ .
+Proof. rewrite /Frame /FrameMonPredAt=> ->. by rewrite monPred_at_absorbingly. Qed.
+Global Instance frame_monPred_at_affinely p P ð“¡ ð“ i :
+ Frame p ð“¡ (<affine> P i) ð“ → FrameMonPredAt p i ð“¡ (<affine> P) ð“ .
+Proof. rewrite /Frame /FrameMonPredAt=> ->. by rewrite monPred_at_affinely. Qed.
+Global Instance frame_monPred_at_persistently p P ð“¡ ð“ i :
+ Frame p ð“¡ (<pers> P i) ð“ → FrameMonPredAt p i ð“¡ (<pers> P) ð“ .
+Proof. rewrite /Frame /FrameMonPredAt=> ->. by rewrite monPred_at_persistently. Qed.
+Global Instance frame_monPred_at_intuitionistically p P ð“¡ ð“ i :
+ Frame p ð“¡ (â–¡ P i) ð“ → FrameMonPredAt p i ð“¡ (â–¡ P) ð“ .
+Proof. rewrite /Frame /FrameMonPredAt=> ->. by rewrite monPred_at_intuitionistically. Qed.
+Global Instance frame_monPred_at_objectively p P ð“¡ ð“ i :
+ Frame p ð“¡ (∀ i, P i) ð“ → FrameMonPredAt p i ð“¡ (<obj> P) ð“ .
+Proof. rewrite /Frame /FrameMonPredAt=> ->. by rewrite monPred_at_objectively. Qed.
+Global Instance frame_monPred_at_subjectively p P ð“¡ ð“ i :
+ Frame p ð“¡ (∃ i, P i) ð“ → FrameMonPredAt p i ð“¡ (<subj> P) ð“ .
+Proof. rewrite /Frame /FrameMonPredAt=> ->. by rewrite monPred_at_subjectively. Qed.
+Global Instance frame_monPred_at_bupd `{BiBUpd PROP} p P ð“¡ ð“ i :
+ Frame p ð“¡ (|==> P i) ð“ → FrameMonPredAt p i ð“¡ (|==> P) ð“ .
+Proof. rewrite /Frame /FrameMonPredAt=> ->. by rewrite monPred_at_bupd. Qed.
+
+Global Instance into_embed_objective P :
+ Objective P → IntoEmbed P (∀ i, P i).
+Proof.
+ rewrite /IntoEmbed=> ?.
+ by rewrite {1}(objective_objectively P) monPred_objectively_unfold.
+Qed.
+
+Global Instance elim_modal_at_bupd_goal `{BiBUpd PROP} φ p p' ð“Ÿ ð“Ÿ' Q Q' i :
+ ElimModal φ p p' ð“Ÿ ð“Ÿ' (|==> Q i) (|==> Q' i) →
+ ElimModal φ p p' ð“Ÿ ð“Ÿ' ((|==> Q) i) ((|==> Q') i).
+Proof. by rewrite /ElimModal !monPred_at_bupd. Qed.
+Global Instance elim_modal_at_bupd_hyp `{BiBUpd PROP} φ p p' P ð“Ÿ ð“Ÿ' ð“ ð“ ' i:
+ MakeMonPredAt i P 𓟠→
+ ElimModal φ p p' (|==> ð“Ÿ) ð“Ÿ' ð“ ð“ ' →
+ ElimModal φ p p' ((|==> P) i) ð“Ÿ' ð“ ð“ '.
+Proof. by rewrite /MakeMonPredAt /ElimModal monPred_at_bupd=><-. Qed.
+
+Global Instance add_modal_at_bupd_goal `{BiBUpd PROP} φ ð“Ÿ ð“Ÿ' Q i :
+ AddModal ð“Ÿ ð“Ÿ' (|==> Q i)%I → AddModal ð“Ÿ ð“Ÿ' ((|==> Q) i).
+Proof. by rewrite /AddModal !monPred_at_bupd. Qed.
+End bi.
+
+(* When P and/or Q are evars when doing typeclass search on [IntoWand
+ (R i) P Q], we use [MakeMonPredAt] in order to normalize the
+ result of unification. However, when they are not evars, we want to
+ propagate the known information through typeclass search. Hence, we
+ do not want to use [MakeMonPredAt].
+
+ As a result, depending on P and Q being evars, we use a different
+ version of [into_wand_monPred_at_xx_xx]. *)
+Hint Extern 3 (IntoWand _ _ (monPred_at _ _) ?P ?Q) =>
+ is_evar P; is_evar Q;
+ eapply @into_wand_monPred_at_unknown_unknown
+ : typeclass_instances.
+Hint Extern 2 (IntoWand _ _ (monPred_at _ _) ?P (monPred_at ?Q _)) =>
+ eapply @into_wand_monPred_at_unknown_known
+ : typeclass_instances.
+Hint Extern 2 (IntoWand _ _ (monPred_at _ _) (monPred_at ?P _) ?Q) =>
+ eapply @into_wand_monPred_at_known_unknown_le
+ : typeclass_instances.
+Hint Extern 2 (IntoWand _ _ (monPred_at _ _) (monPred_at ?P _) ?Q) =>
+ eapply @into_wand_monPred_at_known_unknown_ge
+ : typeclass_instances.
+
+Section sbi.
+Context {I : biIndex} {PROP : sbi}.
+Local Notation monPred := (monPred I PROP).
+Implicit Types P Q R : monPred.
+Implicit Types ð“Ÿ ð“ ð“¡ : PROP.
+Implicit Types φ : Prop.
+Implicit Types i j : I.
+
+Global Instance from_forall_monPred_at_plainly `{BiPlainly PROP} i P Φ :
+ (∀ i, MakeMonPredAt i P (Φ i)) →
+ FromForall ((■P) i) (λ j, ■(Φ j))%I.
+Proof.
+ rewrite /FromForall /MakeMonPredAt=>HPΦ. rewrite monPred_at_plainly.
+ by setoid_rewrite HPΦ.
+Qed.
+Global Instance into_forall_monPred_at_plainly `{BiPlainly PROP} i P Φ :
+ (∀ i, MakeMonPredAt i P (Φ i)) →
+ IntoForall ((■P) i) (λ j, ■(Φ j))%I.
+Proof.
+ rewrite /IntoForall /MakeMonPredAt=>HPΦ. rewrite monPred_at_plainly.
+ by setoid_rewrite HPΦ.
+Qed.
+
+Global Instance is_except_0_monPred_at i P :
+ IsExcept0 P → IsExcept0 (P i).
+Proof. rewrite /IsExcept0=>- [/(_ i)]. by rewrite monPred_at_except_0. Qed.
+
+Global Instance make_monPred_at_internal_eq {A : ofeT} (x y : A) i :
+ @MakeMonPredAt I PROP i (x ≡ y) (x ≡ y).
+Proof. by rewrite /MakeMonPredAt monPred_at_internal_eq. Qed.
+Global Instance make_monPred_at_except_0 i P ð“ :
+ MakeMonPredAt i P ð“ → MakeMonPredAt i (â—‡ P)%I (â—‡ ð“ )%I.
+Proof. by rewrite /MakeMonPredAt monPred_at_except_0=><-. Qed.
+Global Instance make_monPred_at_later i P ð“ :
+ MakeMonPredAt i P ð“ → MakeMonPredAt i (â–· P)%I (â–· ð“ )%I.
+Proof. by rewrite /MakeMonPredAt monPred_at_later=><-. Qed.
+Global Instance make_monPred_at_laterN i n P ð“ :
+ MakeMonPredAt i P ð“ → MakeMonPredAt i (â–·^n P)%I (â–·^n ð“ )%I.
+Proof. rewrite /MakeMonPredAt=> <-. elim n=>//= ? <-. by rewrite monPred_at_later. Qed.
+Global Instance make_monPred_at_fupd `{BiFUpd PROP} i E1 E2 P ð“Ÿ :
+ MakeMonPredAt i P 𓟠→ MakeMonPredAt i (|={E1,E2}=> P)%I (|={E1,E2}=> ð“Ÿ)%I.
+Proof. by rewrite /MakeMonPredAt monPred_at_fupd=> <-. Qed.
+
+Global Instance into_internal_eq_monPred_at {A : ofeT} (x y : A) P i :
+ IntoInternalEq P x y → IntoInternalEq (P i) x y.
+Proof. rewrite /IntoInternalEq=> ->. by rewrite monPred_at_internal_eq. Qed.
+
+Global Instance into_except_0_monPred_at_fwd i P Q ð“ :
+ IntoExcept0 P Q → MakeMonPredAt i Q ð“ → IntoExcept0 (P i) ð“ .
+Proof. rewrite /IntoExcept0 /MakeMonPredAt=> -> <-. by rewrite monPred_at_except_0. Qed.
+Global Instance into_except_0_monPred_at_bwd i P ð“Ÿ Q :
+ IntoExcept0 P Q → MakeMonPredAt i P 𓟠→ IntoExcept0 𓟠(Q i).
+Proof. rewrite /IntoExcept0 /MakeMonPredAt=> H <-. by rewrite H monPred_at_except_0. Qed.
+
+Global Instance maybe_into_later_monPred_at i n P Q ð“ :
+ IntoLaterN false n P Q → MakeMonPredAt i Q ð“ →
+ IntoLaterN false n (P i) ð“ .
+Proof.
+ rewrite /IntoLaterN /MaybeIntoLaterN /MakeMonPredAt=> -> <-. elim n=>//= ? <-.
+ by rewrite monPred_at_later.
+Qed.
+Global Instance from_later_monPred_at i `(sel : A) n P Q ð“ :
+ FromModal (modality_laterN n) sel P Q → MakeMonPredAt i Q ð“ →
+ FromModal (modality_laterN n) sel (P i) ð“ .
+Proof.
+ rewrite /FromModal /MakeMonPredAt=> <- <-. elim n=>//= ? ->.
+ by rewrite monPred_at_later.
+Qed.
+
+Global Instance frame_monPred_at_later p P ð“¡ ð“ i :
+ Frame p ð“¡ (â–· P i) ð“ → FrameMonPredAt p i ð“¡ (â–· P) ð“ .
+Proof. rewrite /Frame /FrameMonPredAt=> ->. by rewrite monPred_at_later. Qed.
+Global Instance frame_monPred_at_laterN p n P ð“¡ ð“ i :
+ Frame p ð“¡ (â–·^n P i) ð“ → FrameMonPredAt p i ð“¡ (â–·^n P) ð“ .
+Proof. rewrite /Frame /FrameMonPredAt=> ->. by rewrite monPred_at_laterN. Qed.
+Global Instance frame_monPred_at_fupd `{BiFUpd PROP} E1 E2 p P ð“¡ ð“ i :
+ Frame p ð“¡ (|={E1,E2}=> P i) ð“ → FrameMonPredAt p i ð“¡ (|={E1,E2}=> P) ð“ .
+Proof. rewrite /Frame /FrameMonPredAt=> ->. by rewrite monPred_at_fupd. Qed.
+
+Global Instance elim_modal_at_fupd_goal `{BiFUpd PROP} φ p p' E1 E2 E3 ð“Ÿ ð“Ÿ' Q Q' i :
+ ElimModal φ p p' ð“Ÿ ð“Ÿ' (|={E1,E3}=> Q i) (|={E2,E3}=> Q' i) →
+ ElimModal φ p p' ð“Ÿ ð“Ÿ' ((|={E1,E3}=> Q) i) ((|={E2,E3}=> Q') i).
+Proof. by rewrite /ElimModal !monPred_at_fupd. Qed.
+Global Instance elim_modal_at_fupd_hyp `{BiFUpd PROP} φ p p' E1 E2 P ð“Ÿ ð“Ÿ' ð“ ð“ ' i :
+ MakeMonPredAt i P 𓟠→
+ ElimModal φ p p' (|={E1,E2}=> ð“Ÿ) ð“Ÿ' ð“ ð“ ' →
+ ElimModal φ p p' ((|={E1,E2}=> P) i) ð“Ÿ' ð“ ð“ '.
+Proof. by rewrite /MakeMonPredAt /ElimModal monPred_at_fupd=><-. Qed.
+
+(* This instances are awfully specific, but that's what is needed. *)
+Global Instance elim_acc_at_fupd `{BiFUpd PROP} {X : Type} E1 E2 E
+ M1 M2 α β (mγ : X → option PROP) Q (Q' : X → monPred) i :
+ ElimAcc (X:=X) M1 M2 α β mγ (|={E1,E}=> Q i)
+ (λ x, |={E2}=> β x ∗ (mγ x -∗? |={E1,E}=> Q' x i))%I →
+ ElimAcc (X:=X) M1 M2 α β mγ ((|={E1,E}=> Q) i)
+ (λ x, (|={E2}=> ⎡β x⎤ ∗
+ (match mγ x with Some ð“Ÿ => Some ⎡ð“ŸâŽ¤ | None => None end -∗?
+ |={E1,E}=> Q' x)) i)%I
+ | 1.
+Proof.
+ rewrite /ElimAcc monPred_at_fupd=><-. apply bi.forall_mono=>x.
+ destruct (mγ x); simpl.
+ - rewrite monPred_at_fupd monPred_at_sep monPred_wand_force monPred_at_fupd !monPred_at_embed //.
+ - rewrite monPred_at_fupd monPred_at_sep monPred_at_fupd !monPred_at_embed //.
+Qed.
+(* A separate, higher-priority instance for unit because otherwise unification
+fails. *)
+Global Instance elim_acc_at_fupd_unit `{BiFUpd PROP} E1 E2 E
+ M1 M2 α β mγ Q Q' i :
+ ElimAcc (X:=unit) M1 M2 α β mγ (|={E1,E}=> Q i)
+ (λ x, |={E2}=> β x ∗ (mγ x -∗? |={E1,E}=> Q' i))%I →
+ ElimAcc (X:=unit) M1 M2 α β mγ ((|={E1,E}=> Q) i)
+ (λ x, (|={E2}=> ⎡β x⎤ ∗
+ (match mγ x with Some ð“Ÿ => Some ⎡ð“ŸâŽ¤ | None => None end -∗?
+ |={E1,E}=> Q')) i)%I
+ | 0.
+Proof. exact: elim_acc_at_fupd. Qed.
+
+Global Instance add_modal_at_fupd_goal `{BiFUpd PROP} E1 E2 ð“Ÿ ð“Ÿ' Q i :
+ AddModal ð“Ÿ ð“Ÿ' (|={E1,E2}=> Q i) → AddModal ð“Ÿ ð“Ÿ' ((|={E1,E2}=> Q) i).
+Proof. by rewrite /AddModal !monPred_at_fupd. Qed.
+
+(* This hard-codes the fact that ElimInv with_close returns a
+ [(λ _, ...)] as Q'. *)
+Global Instance elim_inv_embed_with_close {X : Type} φ
+ ð“Ÿinv ð“Ÿin (ð“Ÿout ð“Ÿclose : X → PROP)
+ Pin (Pout Pclose : X → monPred)
+ Q Q' :
+ (∀ i, ElimInv φ ð“Ÿinv ð“Ÿin ð“Ÿout (Some ð“Ÿclose) (Q i) (λ _, Q' i)) →
+ MakeEmbed ð“Ÿin Pin → (∀ x, MakeEmbed (ð“Ÿout x) (Pout x)) →
+ (∀ x, MakeEmbed (ð“Ÿclose x) (Pclose x)) →
+ ElimInv (X:=X) φ ⎡ð“Ÿinv⎤ Pin Pout (Some Pclose) Q (λ _, Q').
+Proof.
+ rewrite /MakeEmbed /ElimInv=>H <- Hout Hclose ?. iStartProof PROP.
+ setoid_rewrite <-Hout. setoid_rewrite <-Hclose.
+ iIntros (?) "(?&?&HQ')". iApply H; [done|]. iFrame. iIntros (x) "?". by iApply "HQ'".
+Qed.
+Global Instance elim_inv_embed_without_close {X : Type}
+ φ ð“Ÿinv ð“Ÿin (ð“Ÿout : X → PROP) Pin (Pout : X → monPred) Q (Q' : X → monPred) :
+ (∀ i, ElimInv φ ð“Ÿinv ð“Ÿin ð“Ÿout None (Q i) (λ x, Q' x i)) →
+ MakeEmbed ð“Ÿin Pin → (∀ x, MakeEmbed (ð“Ÿout x) (Pout x)) →
+ ElimInv (X:=X) φ ⎡ð“Ÿinv⎤ Pin Pout None Q Q'.
+Proof.
+ rewrite /MakeEmbed /ElimInv=>H <-Hout ?. iStartProof PROP.
+ setoid_rewrite <-Hout.
+ iIntros (?) "(?&?&HQ')". iApply H; [done|]. iFrame. iIntros (x) "?". by iApply "HQ'".
+Qed.
+
+End sbi.
diff --git a/theories/proofmode/notation.v b/theories/proofmode/notation.v
index 09722191074d25d98729684cf5380cb7bb6e4ab2..03fb2f02b03a781a6aef990515e3cb46956c3304 100644
--- a/theories/proofmode/notation.v
+++ b/theories/proofmode/notation.v
@@ -3,30 +3,30 @@ From stdpp Require Export strings.
Set Default Proof Using "Type".
Delimit Scope proof_scope with env.
-Arguments Envs _ _%proof_scope _%proof_scope.
+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 Γ (INamed H) P)
+Notation "Γ H : P" := (Esnoc Γ (INamed H) P%I)
(at level 1, P at level 200,
- left associativity, format "Γ H : P '//'", only printing) : proof_scope.
-Notation "Γ '_' : P" := (Esnoc Γ (IAnon _) P)
+ left associativity, format "Γ H : '[' P ']' '//'", only printing) : proof_scope.
+Notation "Γ '_' : P" := (Esnoc Γ (IAnon _) P%I)
(at level 1, P at level 200,
- left associativity, format "Γ '_' : P '//'", only printing) : proof_scope.
+ left associativity, format "Γ '_' : '[' P ']' '//'", only printing) : proof_scope.
Notation "Γ '--------------------------------------' □ Δ '--------------------------------------' ∗ Q" :=
- (envs_entails (Envs Γ Δ) Q%I)
+ (envs_entails (Envs Γ Δ _) Q%I)
(at level 1, Q at level 200, left associativity,
format "Γ '--------------------------------------' □ '//' Δ '--------------------------------------' ∗ '//' Q '//'", only printing) :
stdpp_scope.
Notation "Δ '--------------------------------------' ∗ Q" :=
- (envs_entails (Envs Enil Δ) Q%I)
+ (envs_entails (Envs Enil Δ _) Q%I)
(at level 1, Q at level 200, left associativity,
format "Δ '--------------------------------------' ∗ '//' Q '//'", only printing) : stdpp_scope.
Notation "Γ '--------------------------------------' □ Q" :=
- (envs_entails (Envs Γ Enil) Q%I)
+ (envs_entails (Envs Γ Enil _) Q%I)
(at level 1, Q at level 200, left associativity,
format "Γ '--------------------------------------' □ '//' Q '//'", only printing) : stdpp_scope.
-Notation "'--------------------------------------' ∗ Q" := (envs_entails (Envs Enil Enil) Q%I)
+Notation "'--------------------------------------' ∗ Q" := (envs_entails (Envs Enil Enil _) Q%I)
(at level 1, Q at level 200, format "'--------------------------------------' ∗ '//' Q '//'", only printing) : stdpp_scope.
diff --git a/theories/proofmode/reduction.v b/theories/proofmode/reduction.v
new file mode 100644
index 0000000000000000000000000000000000000000..d13067c9b8c6cbb81743d1d7f0158cdef7c093c9
--- /dev/null
+++ b/theories/proofmode/reduction.v
@@ -0,0 +1,37 @@
+From iris.bi Require Import bi telescopes.
+From iris.proofmode Require Import base environments.
+
+(** Called by all tactics to perform computation to lookup items in the
+ context. We avoid reducing anything user-visible here to make sure we
+ do not reduce e.g. before unification happens in [iApply].*)
+Declare Reduction pm_eval := cbv [
+ (* base *)
+ base.beq base.Pos_succ base.ascii_beq base.string_beq base.positive_beq base.ident_beq
+ (* environments *)
+ env_lookup env_lookup_delete env_delete env_app env_replace
+ env_dom env_intuitionistic env_spatial env_counter env_spatial_is_nil envs_dom
+ envs_lookup envs_lookup_delete envs_delete envs_snoc envs_app
+ envs_simple_replace envs_replace envs_split
+ envs_clear_spatial envs_clear_persistent envs_incr_counter
+ envs_split_go envs_split prop_of_env
+ (* PM option combinators *)
+ pm_option_bind pm_from_option pm_option_fun
+].
+Ltac pm_eval t :=
+ eval pm_eval in t.
+Ltac pm_reduce :=
+ match goal with |- ?u => let v := pm_eval u in change v end.
+Ltac pm_reflexivity := pm_reduce; exact eq_refl.
+
+(** Called by many tactics for redexes that are created by instantiation.
+ This cannot create any envs redexes so we just do the cbn part. *)
+Declare Reduction pm_prettify := cbn [
+ (* telescope combinators *)
+ tele_fold tele_bind tele_app
+ (* BI connectives *)
+ bi_persistently_if bi_affinely_if bi_intuitionistically_if
+ bi_wandM sbi_laterN
+ bi_tforall bi_texist
+].
+Ltac pm_prettify :=
+ match goal with |- ?u => let v := eval pm_prettify in u in change v end.
diff --git a/theories/proofmode/spec_patterns.v b/theories/proofmode/spec_patterns.v
index 64201daf270d2f560a1a6356fe8682588c4e990a..dd93c0ebec00f8a7bd7e013c9cae889f83163a2d 100644
--- a/theories/proofmode/spec_patterns.v
+++ b/theories/proofmode/spec_patterns.v
@@ -72,8 +72,11 @@ Definition parse (s : string) : option (list spec_pat) :=
Ltac parse s :=
lazymatch type of s with
| list spec_pat => s
+ | spec_pat => constr:([s])
| string => lazymatch eval vm_compute in (parse s) with
- | Some ?pats => pats | _ => fail "invalid list spec_pat" s
+ | Some ?pats => pats | _ => fail "spec_pat.parse: cannot parse" s
end
+ | ident => constr:([SIdent s])
+ | ?X => fail "spec_pat.parse:" s "has unexpected type" X
end.
End spec_pat.
diff --git a/theories/proofmode/tactics.v b/theories/proofmode/tactics.v
index 39389a1cb508b008a7bdeed81ad1d9cf9816a52e..dad2afd87f00f1b0bfdf3d80894886fd76e93676 100644
--- a/theories/proofmode/tactics.v
+++ b/theories/proofmode/tactics.v
@@ -1,1794 +1,2 @@
-From iris.proofmode Require Import coq_tactics.
-From iris.proofmode Require Import base intro_patterns spec_patterns sel_patterns.
-From iris.base_logic Require Export base_logic big_op.
-From iris.proofmode Require Export classes notation.
-From iris.proofmode Require Import class_instances.
-From stdpp Require Import hlist pretty.
-Set Default Proof Using "Type".
-Export ident.
-
-Declare Reduction env_cbv := cbv [
- option_bind
- beq ascii_beq string_beq positive_beq ident_beq
- env_lookup env_lookup_delete env_delete env_app env_replace env_dom
- env_persistent env_spatial env_spatial_is_nil envs_dom
- envs_lookup envs_lookup_delete envs_delete envs_snoc envs_app
- envs_simple_replace envs_replace envs_split
- envs_clear_spatial envs_clear_persistent
- envs_split_go envs_split].
-Ltac env_cbv :=
- match goal with |- ?u => let v := eval env_cbv in u in change v end.
-Ltac env_reflexivity := env_cbv; exact eq_refl.
-
-(** * Misc *)
-(* Tactic Notation tactics cannot return terms *)
-Ltac iFresh :=
- lazymatch goal with
- |- envs_entails ?Δ _ =>
- (* [vm_compute fails] if any of the hypotheses in [Δ] contain evars, so
- first use [cbv] to compute the domain of [Δ] *)
- let Hs := eval cbv in (envs_dom Δ) in
- eval vm_compute in
- (IAnon (match Hs with
- | [] => 1
- | _ => 1 + foldr Pos.max 1 (omap (maybe IAnon) Hs)
- end))%positive
- | _ => constr:(IAnon 1)
- end.
-
-Ltac iMissingHyps Hs :=
- let Δ :=
- lazymatch goal with
- | |- envs_entails ?Δ _ => Δ
- | |- context[ envs_split _ _ ?Δ ] => Δ
- end in
- let Hhyps := eval env_cbv in (envs_dom Δ) in
- eval vm_compute in (list_difference Hs Hhyps).
-
-Ltac iTypeOf H :=
- let Δ := match goal with |- envs_entails ?Δ _ => Δ end in
- eval env_cbv in (envs_lookup H Δ).
-
-Tactic Notation "iMatchHyp" tactic1(tac) :=
- match goal with
- | |- context[ environments.Esnoc _ ?x ?P ] => tac x P
- end.
-
-Class AsValid {M} (φ : Prop) (P : uPred M) := as_valid : φ ↔ P.
-Arguments AsValid {_} _%type _%I.
-
-Lemma as_valid_1 (φ : Prop) {M} (P : uPred M) `{!AsValid φ P} : φ → P.
-Proof. by apply as_valid. Qed.
-Lemma as_valid_2 (φ : Prop) {M} (P : uPred M) `{!AsValid φ P} : P → φ.
-Proof. by apply as_valid. Qed.
-
-Instance as_valid_valid {M} (P : uPred M) : AsValid (uPred_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_equiv {M} (P Q : uPred M) : AsValid (P ≡ Q) (P ↔ Q).
-Proof. split. apply uPred.equiv_iff. apply uPred.iff_equiv. Qed.
-
-(** * Start a proof *)
-Ltac iStartProof :=
- lazymatch goal with
- | |- envs_entails _ _ => idtac
- | |- ?φ => eapply (as_valid_2 φ);
- [apply _ || fail "iStartProof: not a uPred"
- |apply tac_adequate]
- end.
-
-(** * Simplification *)
-Tactic Notation "iEval" tactic(t) :=
- iStartProof;
- eapply tac_eval;
- [let x := fresh in intros x; t; unfold x; reflexivity|].
-
-Tactic Notation "iEval" tactic(t) "in" constr(H) :=
- iStartProof;
- eapply tac_eval_in with _ H _ _ _;
- [env_reflexivity || fail "iEval:" H "not found"
- |let x := fresh in intros x; t; unfold x; reflexivity
- |env_reflexivity
- |].
-
-Tactic Notation "iSimpl" := iEval simpl.
-Tactic Notation "iSimpl" "in" constr(H) := iEval simpl in H.
-
-(* It would be nice to also have an `iSsrRewrite`, however, for this we need to
-pass arguments to Ssreflect's `rewrite` like `/= foo /bar` in Ltac, see:
-
- https://sympa.inria.fr/sympa/arc/coq-club/2018-01/msg00000.html
-
-PMP told me (= Robbert) in person that this is not possible today, but may be
-possible in Ltac2. *)
-
-(** * Context manipulation *)
-Tactic Notation "iRename" constr(H1) "into" constr(H2) :=
- eapply tac_rename with _ H1 H2 _ _; (* (i:=H1) (j:=H2) *)
- [env_reflexivity || fail "iRename:" H1 "not found"
- |env_reflexivity || fail "iRename:" H2 "not fresh"|].
-
-Local Inductive esel_pat :=
- | ESelPure
- | ESelIdent : bool → ident → esel_pat.
-
-Ltac iElaborateSelPat pat :=
- let rec go pat Δ Hs :=
- lazymatch pat with
- | [] => eval cbv in Hs
- | SelPure :: ?pat => go pat Δ (ESelPure :: Hs)
- | SelPersistent :: ?pat =>
- let Hs' := eval env_cbv in (env_dom (env_persistent Δ)) in
- let Δ' := eval env_cbv in (envs_clear_persistent Δ) in
- go pat Δ' ((ESelIdent true <$> Hs') ++ Hs)
- | SelSpatial :: ?pat =>
- let Hs' := eval env_cbv in (env_dom (env_spatial Δ)) in
- let Δ' := eval env_cbv in (envs_clear_spatial Δ) in
- go pat Δ' ((ESelIdent false <$> Hs') ++ Hs)
- | SelIdent ?H :: ?pat =>
- lazymatch eval env_cbv in (envs_lookup_delete H Δ) with
- | Some (?p,_,?Δ') => go pat Δ' (ESelIdent p H :: Hs)
- | None => fail "iElaborateSelPat:" H "not found"
- end
- end in
- lazymatch goal with
- | |- envs_entails ?Δ _ =>
- let pat := sel_pat.parse pat in go pat Δ (@nil esel_pat)
- end.
-
-Local Ltac iClearHyp H :=
- eapply tac_clear with _ H _ _; (* (i:=H) *)
- [env_reflexivity || fail "iClear:" H "not found"|].
-
-Tactic Notation "iClear" constr(Hs) :=
- let rec go Hs :=
- lazymatch Hs with
- | [] => idtac
- | ESelPure :: ?Hs => clear; go Hs
- | ESelIdent _ ?H :: ?Hs => iClearHyp H; go Hs
- end in
- let Hs := iElaborateSelPat Hs in go Hs.
-
-Tactic Notation "iClear" "(" ident_list(xs) ")" constr(Hs) :=
- iClear Hs; clear xs.
-
-(** * Assumptions *)
-Tactic Notation "iExact" constr(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"].
-
-Tactic Notation "iAssumptionCore" :=
- let rec find Γ i P :=
- match Γ with
- | 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) =>
- first [is_evar i; fail 1 | env_reflexivity]
- | |- envs_lookup ?i (Envs ?Γp ?Γs) = Some (_, ?P) =>
- is_evar i; first [find Γp i P | find Γs i P]; env_reflexivity
- | |- envs_lookup_delete ?i (Envs ?Γp ?Γs) = Some (_, ?P, _) =>
- first [is_evar i; fail 1 | env_reflexivity]
- | |- envs_lookup_delete ?i (Envs ?Γp ?Γs) = Some (_, ?P, _) =>
- is_evar i; first [find Γp i P | find Γs i P]; env_reflexivity
- end.
-
-Tactic Notation "iAssumption" :=
- let Hass := fresh in
- let rec find p Γ Q :=
- match Γ with
- | Esnoc ?Γ ?j ?P => first
- [pose proof (_ : FromAssumption p P Q) as Hass;
- apply (tac_assumption _ j p P); [env_reflexivity|apply Hass]
- |find p Γ Q]
- end in
- match goal with
- | |- envs_entails (Envs ?Γp ?Γs) ?Q =>
- first [find true Γp Q | find false Γs Q
- |fail "iAssumption:" Q "not found"]
- end.
-
-(** * False *)
-Tactic Notation "iExFalso" := apply tac_ex_falso.
-
-(** * Making hypotheses persistent or pure *)
-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"
- |env_reflexivity|].
-
-Local Tactic Notation "iPure" constr(H) "as" simple_intropattern(pat) :=
- eapply tac_pure with _ H _ _ _; (* (i:=H1) *)
- [env_reflexivity || fail "iPure:" H "not found"
- |apply _ ||
- let P := match goal with |- IntoPure ?P _ => P end in
- fail "iPure:" P "not pure"
- |intros pat].
-
-Tactic Notation "iPureIntro" :=
- iStartProof;
- eapply tac_pure_intro;
- [apply _ ||
- let P := match goal with |- FromPure ?P _ => P end in
- fail "iPureIntro:" P "not pure"
- |].
-
-(** Framing *)
-Local Ltac iFrameFinish :=
- lazy iota beta;
- try match goal with
- | |- envs_entails _ True => exact (uPred.pure_intro _ _ I)
- end.
-
-Local Ltac iFramePure t :=
- let φ := type of t in
- eapply (tac_frame_pure _ _ _ _ t);
- [apply _ || fail "iFrame: cannot frame" φ
- |iFrameFinish].
-
-Local Ltac iFrameHyp H :=
- eapply tac_frame with _ H _ _ _;
- [env_reflexivity || fail "iFrame:" H "not found"
- |apply _ ||
- let R := match goal with |- Frame _ ?R _ _ => R end in
- fail "iFrame: cannot frame" R
- |iFrameFinish].
-
-Local Ltac iFrameAnyPure :=
- repeat match goal with H : _ |- _ => iFramePure H end.
-
-Local Ltac iFrameAnyPersistent :=
- let rec go Hs :=
- match Hs with [] => idtac | ?H :: ?Hs => repeat iFrameHyp H; go Hs end in
- match goal with
- | |- envs_entails ?Δ _ =>
- let Hs := eval cbv in (env_dom (env_persistent Δ)) in go Hs
- end.
-
-Local Ltac iFrameAnySpatial :=
- let rec go Hs :=
- match Hs with [] => idtac | ?H :: ?Hs => try iFrameHyp H; go Hs end in
- match goal with
- | |- envs_entails ?Δ _ =>
- let Hs := eval cbv in (env_dom (env_spatial Δ)) in go Hs
- end.
-
-Tactic Notation "iFrame" := iFrameAnySpatial.
-
-Tactic Notation "iFrame" "(" constr(t1) ")" :=
- iFramePure t1.
-Tactic Notation "iFrame" "(" constr(t1) constr(t2) ")" :=
- iFramePure t1; iFrame ( t2 ).
-Tactic Notation "iFrame" "(" constr(t1) constr(t2) constr(t3) ")" :=
- iFramePure t1; iFrame ( t2 t3 ).
-Tactic Notation "iFrame" "(" constr(t1) constr(t2) constr(t3) constr(t4) ")" :=
- iFramePure t1; iFrame ( t2 t3 t4 ).
-Tactic Notation "iFrame" "(" constr(t1) constr(t2) constr(t3) constr(t4)
- constr(t5) ")" :=
- iFramePure t1; iFrame ( t2 t3 t4 t5 ).
-Tactic Notation "iFrame" "(" constr(t1) constr(t2) constr(t3) constr(t4)
- constr(t5) constr(t6) ")" :=
- iFramePure t1; iFrame ( t2 t3 t4 t5 t6 ).
-Tactic Notation "iFrame" "(" constr(t1) constr(t2) constr(t3) constr(t4)
- constr(t5) constr(t6) constr(t7) ")" :=
- iFramePure t1; iFrame ( t2 t3 t4 t5 t6 t7 ).
-Tactic Notation "iFrame" "(" constr(t1) constr(t2) constr(t3) constr(t4)
- constr(t5) constr(t6) constr(t7) constr(t8)")" :=
- iFramePure t1; iFrame ( t2 t3 t4 t5 t6 t7 t8 ).
-
-Tactic Notation "iFrame" constr(Hs) :=
- let rec go Hs :=
- lazymatch Hs with
- | [] => idtac
- | SelPure :: ?Hs => iFrameAnyPure; go Hs
- | SelPersistent :: ?Hs => iFrameAnyPersistent; go Hs
- | SelSpatial :: ?Hs => iFrameAnySpatial; go Hs
- | SelIdent ?H :: ?Hs => iFrameHyp H; go Hs
- end
- in let Hs := sel_pat.parse Hs in go Hs.
-Tactic Notation "iFrame" "(" constr(t1) ")" constr(Hs) :=
- iFramePure t1; iFrame Hs.
-Tactic Notation "iFrame" "(" constr(t1) constr(t2) ")" constr(Hs) :=
- iFramePure t1; iFrame ( t2 ) Hs.
-Tactic Notation "iFrame" "(" constr(t1) constr(t2) constr(t3) ")" constr(Hs) :=
- iFramePure t1; iFrame ( t2 t3 ) Hs.
-Tactic Notation "iFrame" "(" constr(t1) constr(t2) constr(t3) constr(t4) ")"
- constr(Hs) :=
- iFramePure t1; iFrame ( t2 t3 t4 ) Hs.
-Tactic Notation "iFrame" "(" constr(t1) constr(t2) constr(t3) constr(t4)
- constr(t5) ")" constr(Hs) :=
- iFramePure t1; iFrame ( t2 t3 t4 t5 ) Hs.
-Tactic Notation "iFrame" "(" constr(t1) constr(t2) constr(t3) constr(t4)
- constr(t5) constr(t6) ")" constr(Hs) :=
- iFramePure t1; iFrame ( t2 t3 t4 t5 t6 ) Hs.
-Tactic Notation "iFrame" "(" constr(t1) constr(t2) constr(t3) constr(t4)
- constr(t5) constr(t6) constr(t7) ")" constr(Hs) :=
- iFramePure t1; iFrame ( t2 t3 t4 t5 t6 t7 ) Hs.
-Tactic Notation "iFrame" "(" constr(t1) constr(t2) constr(t3) constr(t4)
- constr(t5) constr(t6) constr(t7) constr(t8)")" constr(Hs) :=
- iFramePure t1; iFrame ( t2 t3 t4 t5 t6 t7 t8 ) Hs.
-
-(** * Basic introduction tactics *)
-Local Tactic Notation "iIntro" "(" simple_intropattern(x) ")" :=
- try iStartProof;
- lazymatch goal with
- | |- envs_entails _ _ =>
- eapply tac_forall_intro;
- [apply _ ||
- let P := match goal with |- FromForall ?P _ => P end in
- fail "iIntro: cannot turn" P "into a universal quantifier"
- |lazy beta; intros x]
- | |- _ => intros x
- end.
-
-Local Tactic Notation "iIntro" constr(H) :=
- iStartProof;
- first
- [ (* (?Q → _) *)
- eapply tac_impl_intro with _ H; (* (i:=H) *)
- [env_cbv; apply _ ||
- 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"
- |]
- | (* (_ -∗ _) *)
- eapply tac_wand_intro with _ H; (* (i:=H) *)
- [env_reflexivity || fail 1 "iIntro:" H "not fresh"
- |]
- | fail 1 "iIntro: nothing to introduce" ].
-
-Local Tactic Notation "iIntro" "#" constr(H) :=
- iStartProof;
- first
- [ (* (?P → _) *)
- eapply tac_impl_intro_persistent with _ H _; (* (i:=H) *)
- [apply _ ||
- let P := match goal with |- IntoPersistent _ ?P _ => P end in
- 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 _ ||
- let P := match goal with |- IntoPersistent _ ?P _ => P end in
- fail 1 "iIntro: " P " not persistent"
- |env_reflexivity || fail 1 "iIntro:" H "not fresh"
- |]
- | fail 1 "iIntro: nothing to introduce" ].
-
-Local Tactic Notation "iIntro" "_" :=
- try iStartProof;
- first
- [ (* (?Q → _) *) apply tac_impl_intro_drop
- | (* (_ -∗ _) *) apply tac_wand_intro_drop
- | (* (∀ _, _) *) iIntro (_)
- | fail 1 "iIntro: nothing to introduce" ].
-
-Local Tactic Notation "iIntroForall" :=
- try iStartProof;
- lazymatch goal with
- | |- ∀ _, ?P => fail
- | |- ∀ _, _ => intro
- | |- envs_entails _ (∀ x : _, _) => let x' := fresh x in iIntro (x')
- end.
-Local Tactic Notation "iIntro" :=
- try iStartProof;
- lazymatch goal with
- | |- _ → ?P => intro
- | |- envs_entails _ (_ -∗ _) => iIntro (?) || let H := iFresh in iIntro #H || iIntro H
- | |- envs_entails _ (_ → _) => iIntro (?) || let H := iFresh in iIntro #H || iIntro H
- end.
-
-(** * Specialize *)
-Record iTrm {X As} :=
- ITrm { itrm : X ; itrm_vars : hlist As ; itrm_hyps : string }.
-Arguments ITrm {_ _} _ _ _.
-
-Notation "( H $! x1 .. xn )" :=
- (ITrm H (hcons x1 .. (hcons xn hnil) ..) "") (at level 0, x1, xn at level 9).
-Notation "( H $! x1 .. xn 'with' pat )" :=
- (ITrm H (hcons x1 .. (hcons xn hnil) ..) pat) (at level 0, x1, xn at level 9).
-Notation "( H 'with' pat )" := (ITrm H hnil pat) (at level 0).
-
-(*
-There is some hacky stuff going on here: because of Coq bug #6583, unresolved
-type classes in the arguments `xs` are resolved at arbitrary moments. Tactics
-like `apply`, `split` and `eexists` wrongly trigger type class search to resolve
-these holes. To avoid TC being triggered too eagerly, this tactic uses `refine`
-at most places instead of `apply`.
-*)
-Local Tactic Notation "iSpecializeArgs" constr(H) open_constr(xs) :=
- let rec go xs :=
- lazymatch xs with
- | hnil => apply id (* Finally, trigger TC *)
- | hcons ?x ?xs =>
- eapply tac_forall_specialize with _ H _ _ _; (* (i:=H) (a:=x) *)
- [env_reflexivity || fail "iSpecialize:" H "not found"
- |typeclasses eauto ||
- let P := match goal with |- IntoForall ?P _ => P end in
- fail "iSpecialize: cannot instantiate" P "with" x
- |match goal with (* Force [A] in [ex_intro] to deal with coercions. *)
- | |- ∃ _ : ?A, _ => refine (@ex_intro A _ x (conj _ _)); [|]
- (* If the existentially quantified predicate is non-dependent and [x]
- is a hole, [refine] will generate an additional goal. *)
- | |- ∃ _ : ?A, _ => refine (@ex_intro A _ x (conj _ _));[shelve| |]
- end; [env_reflexivity|go xs]]
- end in
- go 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
- fail "iSpecialize:" P "not an implication/wand" in
- let rec go H1 pats :=
- lazymatch pats with
- | [] => idtac
- | SForall :: ?pats =>
- idtac "[IPM] The * specialization pattern is deprecated because it is applied implicitly.";
- go H1 pats
- | SIdent ?H2 :: ?pats =>
- eapply tac_specialize with _ _ H2 _ H1 _ _ _ _; (* (j:=H1) (i:=H2) *)
- [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
- fail "iSpecialize: cannot instantiate" P "with" Q
- |env_reflexivity|go H1 pats]
- | SPureGoal ?d :: ?pats =>
- eapply tac_specialize_assert_pure with _ H1 _ _ _ _ _;
- [env_reflexivity || fail "iSpecialize:" H1 "not found"
- |solve_to_wand H1
- |apply _ ||
- let Q := match goal with |- FromPure ?Q _ => Q end in
- fail "iSpecialize:" Q "not pure"
- |env_reflexivity
- |done_if d (*goal*)
- |go H1 pats]
- | SGoal (SpecGoal GPersistent false ?Hs_frame [] ?d) :: ?pats =>
- eapply tac_specialize_assert_persistent with _ _ H1 _ _ _ _;
- [env_reflexivity || fail "iSpecialize:" H1 "not found"
- |solve_to_wand H1
- |apply _ ||
- let Q := match goal with |- Persistent ?Q => Q end in
- fail "iSpecialize:" Q "not persistent"
- |env_reflexivity
- |iFrame Hs_frame; done_if d (*goal*)
- |go H1 pats]
- | SGoal (SpecGoal GPersistent _ _ _ _) :: ?pats =>
- fail "iSpecialize: cannot select hypotheses for persistent premise"
- | SGoal (SpecGoal ?m ?lr ?Hs_frame ?Hs ?d) :: ?pats =>
- let Hs' := eval cbv in (if lr then Hs else Hs_frame ++ Hs) in
- eapply tac_specialize_assert with _ _ _ H1 _ lr Hs' _ _ _ _;
- [env_reflexivity || fail "iSpecialize:" H1 "not found"
- |solve_to_wand H1
- |lazymatch m with
- | GSpatial => apply add_modal_id
- | GModal => apply _ || fail "iSpecialize: goal not a modality"
- end
- |env_reflexivity ||
- let Hs' := iMissingHyps Hs' in
- fail "iSpecialize: hypotheses" Hs' "not found"
- |iFrame Hs_frame; done_if d (*goal*)
- |go H1 pats]
- | SAutoFrame GPersistent :: ?pats =>
- eapply tac_specialize_assert_persistent with _ _ H1 _ _ _ _;
- [env_reflexivity || fail "iSpecialize:" H1 "not found"
- |solve_to_wand H1
- |apply _ ||
- let Q := match goal with |- Persistent ?Q => Q end in
- fail "iSpecialize:" Q "not persistent"
- |env_reflexivity
- |solve [iFrame "∗ #"]
- |go H1 pats]
- | SAutoFrame ?m :: ?pats =>
- eapply tac_specialize_frame with _ H1 _ _ _ _ _ _;
- [env_reflexivity || fail "iSpecialize:" H1 "not found"
- |solve_to_wand H1
- |lazymatch m with
- | GSpatial => apply add_modal_id
- | GModal => apply _ || fail "iSpecialize: goal not a modality"
- end
- |iFrame "∗ #"; apply tac_unlock ||
- fail "iSpecialize: premise cannot be solved by framing"
- |reflexivity]; iIntro H1; go H1 pats
- end in let pats := spec_pat.parse pat in go H pats.
-
-(* The argument [p] denotes whether the conclusion of the specialized term is
-persistent. If so, one can use all spatial hypotheses for both proving the
-premises and the remaning goal. The argument [p] can either be a Boolean or an
-introduction pattern, which will be coerced into [true] when it solely contains
-`#` or `%` patterns at the top-level.
-
-In case the specialization pattern in [t] states that the modality of the goal
-should be kept for one of the premises (i.e. [>[H1 .. Hn]] is used) then [p]
-defaults to [false] (i.e. spatial hypotheses are not preserved). *)
-Tactic Notation "iSpecializeCore" open_constr(t) "as" constr(p) :=
- let p := intro_pat_persistent p in
- let t :=
- match type of t with
- | string => constr:(ITrm (INamed t) hnil "")
- | ident => constr:(ITrm t hnil "")
- | _ => t
- end in
- lazymatch t with
- | ITrm ?H ?xs ?pat =>
- let pat := spec_pat.parse pat in
- let H := lazymatch type of H with string => constr:(INamed H) | _ => H end in
- lazymatch type of H with
- | ident =>
- (* The lemma [tac_specialize_persistent_helper] allows one to use all
- spatial hypotheses for both proving the premises of the lemma we
- specialize as well as those of the remaining goal. We can only use it when
- 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. *)
- lazymatch eval compute in
- (bool_decide (pat ≠[]) && p && negb (existsb spec_pat_modal pat)) with
- | true =>
- eapply tac_specialize_persistent_helper with _ H _ _ _;
- [env_reflexivity || fail "iSpecialize:" H "not found"
- |iSpecializeArgs H xs; iSpecializePat H pat; last (iExact H)
- |apply _ ||
- let Q := match goal with |- Persistent ?Q => Q end in
- fail "iSpecialize:" Q "not persistent"
- |env_reflexivity|(* goal *)]
- | false => iSpecializeArgs H xs; iSpecializePat H pat
- end
- | _ => fail "iSpecialize:" H "should be a hypothesis, use iPoseProof instead"
- end
- | _ => fail "iSpecialize:" t "should be a proof mode term"
- end.
-
-Tactic Notation "iSpecialize" open_constr(t) :=
- iSpecializeCore t as false.
-Tactic Notation "iSpecialize" open_constr(t) "as" "#" :=
- iSpecializeCore t as true.
-
-(** * Pose proof *)
-(* The tactic [iIntoValid] tactic solves a goal [uPred_valid Q]. The
-arguments [t] is a Coq term whose type is of the following shape:
-
-- [∀ (x_1 : A_1) .. (x_n : A_n), uPred_valid Q]
-- [∀ (x_1 : A_1) .. (x_n : A_n), P1 ⊢ P2], in which case [Q] becomes [P1 -∗ P2]
-- [∀ (x_1 : A_1) .. (x_n : A_n), P1 ⊣⊢ P2], in which case [Q] becomes [P1 ↔ P2]
-
-The tactic instantiates each dependent argument [x_i] with an evar and generates
-a goal [P] for non-dependent arguments [x_i : P]. *)
-Tactic Notation "iIntoValid" open_constr(t) :=
- let rec go t :=
- let tT := type of t in
- lazymatch eval hnf in tT with
- | ?P → ?Q => let H := fresh in assert P as H; [|go uconstr:(t H); clear H]
- | ∀ _ : ?T, _ =>
- (* Put [T] inside an [id] to avoid TC inference from being invoked. *)
- (* This is a workarround for Coq bug #6583. *)
- let e := fresh in evar (e:id T);
- let e' := eval unfold e in e in clear e; go (t e')
- | _ =>
- let tT' := eval cbv zeta in tT in apply (as_valid_1 tT');
- [apply _ || fail "iPoseProof: not a uPred"|exact t]
- end in
- go t.
-
-(* The tactic [tac] is called with a temporary fresh name [H]. The argument
-[lazy_tc] denotes whether type class inference on the premises of [lem] should
-be performed before (if false) or after (if true) [tac H] is called.
-
-The tactic [iApply] uses laxy type class inference, so that evars can first be
-instantiated by matching with the goal, whereas [iDestruct] does not, because
-eliminations may not be performed when type classes have not been resolved.
-*)
-Tactic Notation "iPoseProofCore" open_constr(lem)
- "as" constr(p) constr(lazy_tc) tactic(tac) :=
- try iStartProof;
- let Htmp := iFresh in
- let t := lazymatch lem with ITrm ?t ?xs ?pat => t | _ => lem end in
- let t := lazymatch type of t with string => constr:(INamed t) | _ => t end in
- let spec_tac _ :=
- lazymatch lem with
- | ITrm ?t ?xs ?pat => iSpecializeCore (ITrm Htmp xs pat) as p
- | _ => idtac
- end in
- let go goal_tac :=
- lazymatch type of t with
- | ident =>
- eapply tac_pose_proof_hyp with _ _ t _ Htmp _;
- [env_reflexivity || fail "iPoseProof:" t "not found"
- |env_reflexivity || fail "iPoseProof:" Htmp "not fresh"
- |goal_tac ()]
- | _ =>
- eapply tac_pose_proof with _ Htmp _; (* (j:=H) *)
- [iIntoValid t
- |env_reflexivity || fail "iPoseProof:" Htmp "not fresh"
- |goal_tac ()]
- end;
- try (apply _) in
- lazymatch eval compute in lazy_tc with
- | true => go ltac:(fun _ => spec_tac (); last (tac Htmp))
- | false => go spec_tac; last (tac Htmp)
- end.
-
-(** * Apply *)
-Tactic Notation "iApplyHyp" constr(H) :=
- let rec go H := first
- [eapply tac_apply with _ H _ _ _;
- [env_reflexivity
- |apply _
- |lazy beta (* reduce betas created by instantiation *)]
- |iSpecializePat H "[]"; last go H] in
- iExact H ||
- go H ||
- lazymatch iTypeOf H with
- | Some (_,?Q) => fail "iApply: cannot apply" Q
- end.
-
-Tactic Notation "iApply" open_constr(lem) :=
- iPoseProofCore lem as false true (fun H => iApplyHyp H).
-
-(** * Revert *)
-Local Tactic Notation "iForallRevert" ident(x) :=
- let err x :=
- intros x;
- iMatchHyp (fun H P =>
- lazymatch P with
- | context [x] => fail 2 "iRevert:" x "is used in hypothesis" H
- end) in
- iStartProof;
- let A := type of x in
- lazymatch type of A with
- | Prop => revert x; first [apply tac_pure_revert|err x]
- | _ => revert x; first [apply tac_forall_revert|err x]
- end.
-
-Tactic Notation "iRevert" constr(Hs) :=
- let rec go Hs :=
- lazymatch Hs with
- | [] => idtac
- | ESelPure :: ?Hs =>
- repeat match goal with x : _ |- _ => revert x end;
- go Hs
- | ESelIdent _ ?H :: ?Hs =>
- eapply tac_revert with _ H _ _; (* (i:=H2) *)
- [env_reflexivity || fail "iRevert:" H "not found"
- |env_cbv; go Hs]
- end in
- let Hs := iElaborateSelPat Hs in iStartProof; go Hs.
-
-Tactic Notation "iRevert" "(" ident(x1) ")" :=
- iForallRevert x1.
-Tactic Notation "iRevert" "(" ident(x1) ident(x2) ")" :=
- iForallRevert x2; iRevert ( x1 ).
-Tactic Notation "iRevert" "(" ident(x1) ident(x2) ident(x3) ")" :=
- iForallRevert x3; iRevert ( x1 x2 ).
-Tactic Notation "iRevert" "(" ident(x1) ident(x2) ident(x3) ident(x4) ")" :=
- iForallRevert x4; iRevert ( x1 x2 x3 ).
-Tactic Notation "iRevert" "(" ident(x1) ident(x2) ident(x3) ident(x4)
- ident(x5) ")" :=
- iForallRevert x5; iRevert ( x1 x2 x3 x4 ).
-Tactic Notation "iRevert" "(" ident(x1) ident(x2) ident(x3) ident(x4)
- ident(x5) ident(x6) ")" :=
- iForallRevert x6; iRevert ( x1 x2 x3 x4 x5 ).
-Tactic Notation "iRevert" "(" ident(x1) ident(x2) ident(x3) ident(x4)
- ident(x5) ident(x6) ident(x7) ")" :=
- iForallRevert x7; iRevert ( x1 x2 x3 x4 x5 x6 ).
-Tactic Notation "iRevert" "(" ident(x1) ident(x2) ident(x3) ident(x4)
- ident(x5) ident(x6) ident(x7) ident(x8) ")" :=
- iForallRevert x8; iRevert ( x1 x2 x3 x4 x5 x6 x7 ).
-
-Tactic Notation "iRevert" "(" ident(x1) ")" constr(Hs) :=
- iRevert Hs; iRevert ( x1 ).
-Tactic Notation "iRevert" "(" ident(x1) ident(x2) ")" constr(Hs) :=
- iRevert Hs; iRevert ( x1 x2 ).
-Tactic Notation "iRevert" "(" ident(x1) ident(x2) ident(x3) ")" constr(Hs) :=
- iRevert Hs; iRevert ( x1 x2 x3 ).
-Tactic Notation "iRevert" "(" ident(x1) ident(x2) ident(x3) ident(x4) ")"
- constr(Hs) :=
- iRevert Hs; iRevert ( x1 x2 x3 x4 ).
-Tactic Notation "iRevert" "(" ident(x1) ident(x2) ident(x3) ident(x4)
- ident(x5) ")" constr(Hs) :=
- iRevert Hs; iRevert ( x1 x2 x3 x4 x5 ).
-Tactic Notation "iRevert" "(" ident(x1) ident(x2) ident(x3) ident(x4)
- ident(x5) ident(x6) ")" constr(Hs) :=
- iRevert Hs; iRevert ( x1 x2 x3 x4 x5 x6 ).
-Tactic Notation "iRevert" "(" ident(x1) ident(x2) ident(x3) ident(x4)
- ident(x5) ident(x6) ident(x7) ")" constr(Hs) :=
- iRevert Hs; iRevert ( x1 x2 x3 x4 x5 x6 x7 ).
-Tactic Notation "iRevert" "(" ident(x1) ident(x2) ident(x3) ident(x4)
- ident(x5) ident(x6) ident(x7) ident(x8) ")" constr(Hs) :=
- iRevert Hs; iRevert ( x1 x2 x3 x4 x5 x6 x7 x8 ).
-
-(** * Disjunction *)
-Tactic Notation "iLeft" :=
- iStartProof;
- eapply tac_or_l;
- [apply _ ||
- let P := match goal with |- FromOr ?P _ _ => P end in
- fail "iLeft:" P "not a disjunction"
- |].
-Tactic Notation "iRight" :=
- iStartProof;
- eapply tac_or_r;
- [apply _ ||
- let P := match goal with |- FromOr ?P _ _ => P end in
- fail "iRight:" P "not a disjunction"
- |].
-
-Local Tactic Notation "iOrDestruct" constr(H) "as" constr(H1) constr(H2) :=
- eapply tac_or_destruct with _ _ H _ H1 H2 _ _ _; (* (i:=H) (j1:=H1) (j2:=H2) *)
- [env_reflexivity || fail "iOrDestruct:" H "not found"
- |apply _ ||
- let P := match goal with |- IntoOr ?P _ _ => P end in
- fail "iOrDestruct: cannot destruct" P
- |env_reflexivity || fail "iOrDestruct:" H1 "not fresh"
- |env_reflexivity || fail "iOrDestruct:" H2 "not fresh"
- | |].
-
-(** * Conjunction and separating conjunction *)
-Tactic Notation "iSplit" :=
- iStartProof;
- eapply tac_and_split;
- [apply _ ||
- let P := match goal with |- FromAnd _ ?P _ _ => P end in
- fail "iSplit:" P "not a conjunction"| |].
-
-Tactic Notation "iSplitL" constr(Hs) :=
- iStartProof;
- let Hs := words Hs in
- let Hs := eval vm_compute in (INamed <$> Hs) in
- eapply tac_sep_split with _ _ Left Hs _ _; (* (js:=Hs) *)
- [apply _ ||
- let P := match goal with |- FromAnd _ ?P _ _ => P end in
- fail "iSplitL:" P "not a separating conjunction"
- |env_reflexivity ||
- let Hs := iMissingHyps Hs in
- fail "iSplitL: hypotheses" Hs "not found"
- | |].
-
-Tactic Notation "iSplitR" constr(Hs) :=
- iStartProof;
- let Hs := words Hs in
- let Hs := eval vm_compute in (INamed <$> Hs) in
- eapply tac_sep_split with _ _ Right Hs _ _; (* (js:=Hs) *)
- [apply _ ||
- let P := match goal with |- FromAnd _ ?P _ _ => P end in
- fail "iSplitR:" P "not a separating conjunction"
- |env_reflexivity ||
- let Hs := iMissingHyps Hs in
- fail "iSplitR: hypotheses" Hs "not found"
- | |].
-
-Tactic Notation "iSplitL" := iSplitR "".
-Tactic Notation "iSplitR" := iSplitL "".
-
-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
- fail "iAndDestruct: cannot destruct" P
- |env_reflexivity || fail "iAndDestruct:" H1 "or" H2 " not fresh"|].
-
-Local Tactic Notation "iAndDestructChoice" constr(H) "as" constr(d) constr(H') :=
- eapply tac_and_destruct_choice with _ H _ d H' _ _ _;
- [env_reflexivity || fail "iAndDestructChoice:" H "not found"
- |apply _ ||
- let P := match goal with |- IntoAnd _ ?P _ _ => P end in
- fail "iAndDestructChoice: cannot destruct" P
- |env_reflexivity || fail "iAndDestructChoice:" H' " not fresh"|].
-
-(** * Combinining hypotheses *)
-Tactic Notation "iCombine" constr(Hs) "as" constr(H) :=
- let Hs := words Hs in
- let Hs := eval vm_compute in (INamed <$> Hs) in
- eapply tac_combine with _ _ Hs _ _ H _;
- [env_reflexivity ||
- let Hs := iMissingHyps Hs in
- fail "iCombine: hypotheses" Hs "not found"
- |apply _
- |env_reflexivity || fail "iCombine:" H "not fresh"|].
-
-Tactic Notation "iCombine" constr(H1) constr(H2) "as" constr(H) :=
- iCombine [H1;H2] as H.
-
-(** * Existential *)
-Tactic Notation "iExists" uconstr(x1) :=
- iStartProof;
- eapply tac_exist;
- [apply _ ||
- let P := match goal with |- FromExist ?P _ => P end in
- fail "iExists:" P "not an existential"
- |cbv beta; eexists x1].
-
-Tactic Notation "iExists" uconstr(x1) "," uconstr(x2) :=
- iExists x1; iExists x2.
-Tactic Notation "iExists" uconstr(x1) "," uconstr(x2) "," uconstr(x3) :=
- iExists x1; iExists x2, x3.
-Tactic Notation "iExists" uconstr(x1) "," uconstr(x2) "," uconstr(x3) ","
- uconstr(x4) :=
- iExists x1; iExists x2, x3, x4.
-Tactic Notation "iExists" uconstr(x1) "," uconstr(x2) "," uconstr(x3) ","
- uconstr(x4) "," uconstr(x5) :=
- iExists x1; iExists x2, x3, x4, x5.
-Tactic Notation "iExists" uconstr(x1) "," uconstr(x2) "," uconstr(x3) ","
- uconstr(x4) "," uconstr(x5) "," uconstr(x6) :=
- iExists x1; iExists x2, x3, x4, x5, x6.
-Tactic Notation "iExists" uconstr(x1) "," uconstr(x2) "," uconstr(x3) ","
- uconstr(x4) "," uconstr(x5) "," uconstr(x6) "," uconstr(x7) :=
- iExists x1; iExists x2, x3, x4, x5, x6, x7.
-Tactic Notation "iExists" uconstr(x1) "," uconstr(x2) "," uconstr(x3) ","
- uconstr(x4) "," uconstr(x5) "," uconstr(x6) "," uconstr(x7) ","
- uconstr(x8) :=
- iExists x1; iExists x2, x3, x4, x5, x6, x7, x8.
-
-Local Tactic Notation "iExistDestruct" constr(H)
- "as" simple_intropattern(x) constr(Hx) :=
- eapply tac_exist_destruct with H _ Hx _ _; (* (i:=H) (j:=Hx) *)
- [env_reflexivity || fail "iExistDestruct:" H "not found"
- |apply _ ||
- let P := match goal with |- IntoExist ?P _ => P end in
- fail "iExistDestruct: cannot destruct" P|];
- let y := fresh in
- intros y; eexists; split;
- [env_reflexivity || fail "iExistDestruct:" Hx "not fresh"
- |revert y; intros x].
-
-(** * Always *)
-Tactic Notation "iAlways":=
- iStartProof;
- eapply tac_always_intro;
- [apply _ || fail "iAlways: the goal is not a persistence/plainness modality"
- |env_cbv; apply _
- |].
-
-(** * Later *)
-Tactic Notation "iNext" open_constr(n) :=
- iStartProof;
- let P := match goal with |- envs_entails _ ?P => P end in
- try lazymatch n with 0 => fail 1 "iNext: cannot strip 0 laters" end;
- eapply (tac_next _ _ n);
- [apply _ || fail "iNext:" P "does not contain" n "laters"
- |lazymatch goal with
- | |- MaybeIntoLaterNEnvs 0 _ _ => fail "iNext:" P "does not contain laters"
- | _ => apply _
- end
- |lazy beta (* remove beta redexes caused by removing laters under binders*)].
-
-Tactic Notation "iNext":= iNext _.
-
-(** * Update modality *)
-Tactic Notation "iModIntro" :=
- iStartProof;
- eapply tac_modal_intro;
- [apply _ ||
- let P := match goal with |- FromModal ?P _ => P end in
- fail "iModIntro:" P "not a modality"|].
-
-Tactic Notation "iModCore" constr(H) :=
- eapply tac_modal_elim with _ H _ _ _ _;
- [env_reflexivity || fail "iMod:" H "not found"
- |apply _ ||
- let P := match goal with |- ElimModal ?P _ _ _ => P end in
- let Q := match goal with |- ElimModal _ _ ?Q _ => Q end in
- fail "iMod: cannot eliminate modality " P "in" Q
- |env_reflexivity|].
-
-(** * Basic destruct tactic *)
-Local Tactic Notation "iDestructHyp" constr(H) "as" constr(pat) :=
- let rec go Hz pat :=
- lazymatch pat with
- | IAnom =>
- lazymatch Hz with
- | IAnon _ => idtac
- | INamed ?Hz => let Hz' := iFresh in iRename Hz into Hz'
- end
- | IDrop => iClearHyp Hz
- | IFrame => iFrameHyp Hz
- | IIdent ?y => iRename Hz into y
- | IList [[]] => iExFalso; iExact Hz
- | IList [[?pat1; IDrop]] => iAndDestructChoice Hz as Left Hz; go Hz pat1
- | IList [[IDrop; ?pat2]] => iAndDestructChoice Hz as Right Hz; go Hz pat2
- | IList [[?pat1; ?pat2]] =>
- let Hy := iFresh in iAndDestruct Hz as Hz Hy; go Hz pat1; go Hy pat2
- | IList [[?pat1];[?pat2]] => iOrDestruct Hz as Hz Hz; [go Hz pat1|go Hz pat2]
- | IPureElim => iPure Hz as ?
- | IRewrite Right => iPure Hz as ->
- | IRewrite Left => iPure Hz as <-
- | IAlwaysElim ?pat => iPersistent Hz; go Hz pat
- | IModalElim ?pat => iModCore Hz; go Hz pat
- | _ => fail "iDestruct:" pat "invalid"
- end in
- let rec find_pat found pats :=
- lazymatch pats with
- | [] =>
- lazymatch found with
- | true => idtac
- | false => fail "iDestruct:" pat "should contain exactly one proper introduction pattern"
- end
- | ISimpl :: ?pats => simpl; find_pat found pats
- | IClear ?H :: ?pats => iClear H; find_pat found pats
- | IClearFrame ?H :: ?pats => iFrame H; find_pat found pats
- | ?pat :: ?pats =>
- lazymatch found with
- | false => go H pat; find_pat true pats
- | true => fail "iDestruct:" pat "should contain exactly one proper introduction pattern"
- end
- end in
- let pats := intro_pat.parse pat in
- find_pat false pats.
-
-Local Tactic Notation "iDestructHyp" constr(H) "as" "(" simple_intropattern(x1) ")"
- constr(pat) :=
- iExistDestruct H as x1 H; iDestructHyp H as @ pat.
-Local Tactic Notation "iDestructHyp" constr(H) "as" "(" simple_intropattern(x1)
- simple_intropattern(x2) ")" constr(pat) :=
- iExistDestruct H as x1 H; iDestructHyp H as ( x2 ) pat.
-Local Tactic Notation "iDestructHyp" constr(H) "as" "(" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) ")" constr(pat) :=
- iExistDestruct H as x1 H; iDestructHyp H as ( x2 x3 ) pat.
-Local Tactic Notation "iDestructHyp" constr(H) "as" "(" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4) ")"
- constr(pat) :=
- iExistDestruct H as x1 H; iDestructHyp H as ( x2 x3 x4 ) pat.
-Local Tactic Notation "iDestructHyp" constr(H) "as" "(" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
- simple_intropattern(x5) ")" constr(pat) :=
- iExistDestruct H as x1 H; iDestructHyp H as ( x2 x3 x4 x5 ) pat.
-Local Tactic Notation "iDestructHyp" constr(H) "as" "(" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
- simple_intropattern(x5) simple_intropattern(x6) ")" constr(pat) :=
- iExistDestruct H as x1 H; iDestructHyp H as ( x2 x3 x4 x5 x6 ) pat.
-Local Tactic Notation "iDestructHyp" constr(H) "as" "(" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
- simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7) ")"
- constr(pat) :=
- iExistDestruct H as x1 H; iDestructHyp H as ( x2 x3 x4 x5 x6 x7 ) pat.
-Local Tactic Notation "iDestructHyp" constr(H) "as" "(" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
- simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7)
- simple_intropattern(x8) ")" constr(pat) :=
- iExistDestruct H as x1 H; iDestructHyp H as ( x2 x3 x4 x5 x6 x7 x8 ) pat.
-
-(** * Introduction tactic *)
-Tactic Notation "iIntros" constr(pat) :=
- let rec go pats :=
- lazymatch pats with
- | [] => idtac
- (* Optimizations to avoid generating fresh names *)
- | IPureElim :: ?pats => iIntro (?); go pats
- | IAlwaysElim (IIdent ?H) :: ?pats => iIntro #H; go pats
- | IDrop :: ?pats => iIntro _; go pats
- | IIdent ?H :: ?pats => iIntro H; go pats
- (* Introduction patterns that can only occur at the top-level *)
- | IPureIntro :: ?pats => iPureIntro; go pats
- | IAlwaysIntro :: ?pats => iAlways; go pats
- | IModalIntro :: ?pats => iModIntro; go pats
- | IForall :: ?pats => repeat iIntroForall; go pats
- | IAll :: ?pats => repeat (iIntroForall || iIntro); go pats
- (* Clearing and simplifying introduction patterns *)
- | ISimpl :: ?pats => simpl; go pats
- | IClear ?H :: ?pats => iClear H; go pats
- | IClearFrame ?H :: ?pats => iFrame H; go pats
- | IDone :: ?pats => try done; go pats
- (* Introduction + destruct *)
- | IAlwaysElim ?pat :: ?pats =>
- let H := iFresh in iIntro #H; iDestructHyp H as pat; go pats
- | ?pat :: ?pats =>
- let H := iFresh in iIntro H; iDestructHyp H as pat; go pats
- end
- in let pats := intro_pat.parse pat in try iStartProof; go pats.
-Tactic Notation "iIntros" := iIntros [IAll].
-
-Tactic Notation "iIntros" "(" simple_intropattern(x1) ")" :=
- iIntro ( x1 ).
-Tactic Notation "iIntros" "(" simple_intropattern(x1)
- simple_intropattern(x2) ")" :=
- iIntros ( x1 ); iIntro ( x2 ).
-Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
- simple_intropattern(x3) ")" :=
- iIntros ( x1 x2 ); iIntro ( x3 ).
-Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
- simple_intropattern(x3) simple_intropattern(x4) ")" :=
- iIntros ( x1 x2 x3 ); iIntro ( x4 ).
-Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
- simple_intropattern(x3) simple_intropattern(x4) simple_intropattern(x5) ")" :=
- iIntros ( x1 x2 x3 x4 ); iIntro ( x5 ).
-Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
- simple_intropattern(x3) simple_intropattern(x4) simple_intropattern(x5)
- simple_intropattern(x6) ")" :=
- iIntros ( x1 x2 x3 x4 x5 ); iIntro ( x6 ).
-Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
- simple_intropattern(x3) simple_intropattern(x4) simple_intropattern(x5)
- simple_intropattern(x6) simple_intropattern(x7) ")" :=
- iIntros ( x1 x2 x3 x4 x5 x6 ); iIntro ( x7 ).
-Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
- simple_intropattern(x3) simple_intropattern(x4) simple_intropattern(x5)
- simple_intropattern(x6) simple_intropattern(x7) simple_intropattern(x8) ")" :=
- iIntros ( x1 x2 x3 x4 x5 x6 x7 ); iIntro ( x8 ).
-Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
- simple_intropattern(x3) simple_intropattern(x4) simple_intropattern(x5)
- simple_intropattern(x6) simple_intropattern(x7) simple_intropattern(x8)
- simple_intropattern(x9) ")" :=
- iIntros ( x1 x2 x3 x4 x5 x6 x7 x8 ); iIntro ( x9 ).
-Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
- simple_intropattern(x3) simple_intropattern(x4) simple_intropattern(x5)
- simple_intropattern(x6) simple_intropattern(x7) simple_intropattern(x8)
- simple_intropattern(x9) simple_intropattern(x10) ")" :=
- iIntros ( x1 x2 x3 x4 x5 x6 x7 x8 x9 ); iIntro ( x10 ).
-Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
- simple_intropattern(x3) simple_intropattern(x4) simple_intropattern(x5)
- simple_intropattern(x6) simple_intropattern(x7) simple_intropattern(x8)
- simple_intropattern(x9) simple_intropattern(x10) simple_intropattern(x11) ")" :=
- iIntros ( x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 ); iIntro ( x11 ).
-Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
- simple_intropattern(x3) simple_intropattern(x4) simple_intropattern(x5)
- simple_intropattern(x6) simple_intropattern(x7) simple_intropattern(x8)
- simple_intropattern(x9) simple_intropattern(x10) simple_intropattern(x11)
- simple_intropattern(x12) ")" :=
- iIntros ( x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 ); iIntro ( x12 ).
-
-Tactic Notation "iIntros" "(" simple_intropattern(x1) ")" constr(p) :=
- iIntros ( x1 ); iIntros p.
-Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
- ")" constr(p) :=
- iIntros ( x1 x2 ); iIntros p.
-Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
- simple_intropattern(x3) ")" constr(p) :=
- iIntros ( x1 x2 x3 ); iIntros p.
-Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
- simple_intropattern(x3) simple_intropattern(x4) ")" constr(p) :=
- iIntros ( x1 x2 x3 x4 ); iIntros p.
-Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
- simple_intropattern(x3) simple_intropattern(x4) simple_intropattern(x5)
- ")" constr(p) :=
- iIntros ( x1 x2 x3 x4 x5 ); iIntros p.
-Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
- simple_intropattern(x3) simple_intropattern(x4) simple_intropattern(x5)
- simple_intropattern(x6) ")" constr(p) :=
- iIntros ( x1 x2 x3 x4 x5 x6 ); iIntros p.
-Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
- simple_intropattern(x3) simple_intropattern(x4) simple_intropattern(x5)
- simple_intropattern(x6) simple_intropattern(x7) ")" constr(p) :=
- iIntros ( x1 x2 x3 x4 x5 x6 x7 ); iIntros p.
-Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
- simple_intropattern(x3) simple_intropattern(x4) simple_intropattern(x5)
- simple_intropattern(x6) simple_intropattern(x7) simple_intropattern(x8)
- ")" constr(p) :=
- iIntros ( x1 x2 x3 x4 x5 x6 x7 x8 ); iIntros p.
-Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
- simple_intropattern(x3) simple_intropattern(x4) simple_intropattern(x5)
- simple_intropattern(x6) simple_intropattern(x7) simple_intropattern(x8)
- simple_intropattern(x9) ")" constr(p) :=
- iIntros ( x1 x2 x3 x4 x5 x6 x7 x8 x9 ); iIntros p.
-Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
- simple_intropattern(x3) simple_intropattern(x4) simple_intropattern(x5)
- simple_intropattern(x6) simple_intropattern(x7) simple_intropattern(x8)
- simple_intropattern(x9) simple_intropattern(x10) ")" constr(p) :=
- iIntros ( x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 ); iIntros p.
-Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
- simple_intropattern(x3) simple_intropattern(x4) simple_intropattern(x5)
- simple_intropattern(x6) simple_intropattern(x7) simple_intropattern(x8)
- simple_intropattern(x9) simple_intropattern(x10) simple_intropattern(x11)
- ")" constr(p) :=
- iIntros ( x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 ); iIntros p.
-Tactic Notation "iIntros" "(" simple_intropattern(x1) simple_intropattern(x2)
- simple_intropattern(x3) simple_intropattern(x4) simple_intropattern(x5)
- simple_intropattern(x6) simple_intropattern(x7) simple_intropattern(x8)
- simple_intropattern(x9) simple_intropattern(x10) simple_intropattern(x11)
- simple_intropattern(x12) ")" constr(p) :=
- iIntros ( x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 ); iIntros p.
-
-Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1) ")" :=
- iIntros p; iIntros ( x1 ).
-Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1)
- simple_intropattern(x2) ")" :=
- iIntros p; iIntros ( x1 x2 ).
-Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) ")" :=
- iIntros p; iIntros ( x1 x2 x3 ).
-Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4) ")" :=
- iIntros p; iIntros ( x1 x2 x3 x4 ).
-Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
- simple_intropattern(x5) ")" :=
- iIntros p; iIntros ( x1 x2 x3 x4 x5 ).
-Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
- simple_intropattern(x5) simple_intropattern(x6) ")" :=
- iIntros p; iIntros ( x1 x2 x3 x4 x5 x6 ).
-Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
- simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7) ")" :=
- iIntros p; iIntros ( x1 x2 x3 x4 x5 x6 x7 ).
-Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
- simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7)
- simple_intropattern(x8) ")" :=
- iIntros p; iIntros ( x1 x2 x3 x4 x5 x6 x7 x8 ).
-Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
- simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7)
- simple_intropattern(x8) simple_intropattern(x9) ")" :=
- iIntros p; iIntros ( x1 x2 x3 x4 x5 x6 x7 x8 x9 ).
-Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
- simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7)
- simple_intropattern(x8) simple_intropattern(x9) simple_intropattern(x10) ")" :=
- iIntros p; iIntros ( x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 ).
-Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
- simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7)
- simple_intropattern(x8) simple_intropattern(x9) simple_intropattern(x10)
- simple_intropattern(x11) ")" :=
- iIntros p; iIntros ( x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 ).
-Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
- simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7)
- simple_intropattern(x8) simple_intropattern(x9) simple_intropattern(x10)
- simple_intropattern(x11) simple_intropattern(x12) ")" :=
- iIntros p; iIntros ( x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 ).
-
-Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1) ")" constr(p2) :=
- iIntros p; iIntros ( x1 ); iIntros p2.
-Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1)
- simple_intropattern(x2) ")" constr(p2) :=
- iIntros p; iIntros ( x1 x2 ); iIntros p2.
-Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) ")" constr(p2) :=
- iIntros p; iIntros ( x1 x2 x3 ); iIntros p2.
-Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
- ")" constr(p2) :=
- iIntros p; iIntros ( x1 x2 x3 x4 ); iIntros p2.
-Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
- simple_intropattern(x5) ")" constr(p2) :=
- iIntros p; iIntros ( x1 x2 x3 x4 x5 ); iIntros p2.
-Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
- simple_intropattern(x5) simple_intropattern(x6) ")" constr(p2) :=
- iIntros p; iIntros ( x1 x2 x3 x4 x5 x6 ); iIntros p2.
-Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
- simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7)
- ")" constr(p2) :=
- iIntros p; iIntros ( x1 x2 x3 x4 x5 x6 x7 ); iIntros p2.
-Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
- simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7)
- simple_intropattern(x8) ")" constr(p2) :=
- iIntros p; iIntros ( x1 x2 x3 x4 x5 x6 x7 x8 ); iIntros p2.
-Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
- simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7)
- simple_intropattern(x8) simple_intropattern(x9) ")" constr(p2) :=
- iIntros p; iIntros ( x1 x2 x3 x4 x5 x6 x7 x8 x9 ); iIntros p2.
-Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
- simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7)
- simple_intropattern(x8) simple_intropattern(x9) simple_intropattern(x10)
- ")" constr(p2) :=
- iIntros p; iIntros ( x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 ); iIntros p2.
-Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
- simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7)
- simple_intropattern(x8) simple_intropattern(x9) simple_intropattern(x10)
- simple_intropattern(x11) ")" constr(p2) :=
- iIntros p; iIntros ( x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 ); iIntros p2.
-Tactic Notation "iIntros" constr(p) "(" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
- simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7)
- simple_intropattern(x8) simple_intropattern(x9) simple_intropattern(x10)
- simple_intropattern(x11) simple_intropattern(x12) ")" constr(p2) :=
- iIntros p; iIntros ( x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 ); iIntros p2.
-
-
-(* Used for generalization in iInduction and iLöb *)
-Tactic Notation "iRevertIntros" constr(Hs) "with" tactic(tac) :=
- let rec go Hs :=
- lazymatch Hs with
- | [] => tac
- | ESelPure :: ?Hs => fail "iRevertIntros: % not supported"
- | ESelIdent ?p ?H :: ?Hs =>
- iRevert H; go Hs;
- let H' :=
- match p with true => constr:([IAlwaysElim (IIdent H)]) | false => H end in
- iIntros H'
- end in
- try iStartProof; let Hs := iElaborateSelPat Hs in go Hs.
-
-Tactic Notation "iRevertIntros" "(" ident(x1) ")" constr(Hs) "with" tactic(tac):=
- iRevertIntros Hs with (iRevert (x1); tac; iIntros (x1)).
-Tactic Notation "iRevertIntros" "(" ident(x1) ident(x2) ")" constr(Hs)
- "with" tactic(tac):=
- iRevertIntros Hs with (iRevert (x1 x2); tac; iIntros (x1 x2)).
-Tactic Notation "iRevertIntros" "(" ident(x1) ident(x2) ident(x3) ")" constr(Hs)
- "with" tactic(tac):=
- iRevertIntros Hs with (iRevert (x1 x2 x3); tac; iIntros (x1 x2 x3)).
-Tactic Notation "iRevertIntros" "(" ident(x1) ident(x2) ident(x3) ident(x4) ")"
- constr(Hs) "with" tactic(tac):=
- iRevertIntros Hs with (iRevert (x1 x2 x3 x4); tac; iIntros (x1 x2 x3 x4)).
-Tactic Notation "iRevertIntros" "(" ident(x1) ident(x2) ident(x3) ident(x4)
- ident(x5) ")" constr(Hs) "with" tactic(tac):=
- iRevertIntros Hs with (iRevert (x1 x2 x3 x4 x5); tac; iIntros (x1 x2 x3 x4 x5)).
-Tactic Notation "iRevertIntros" "(" ident(x1) ident(x2) ident(x3) ident(x4)
- ident(x5) ident(x6) ")" constr(Hs) "with" tactic(tac):=
- iRevertIntros Hs with (iRevert (x1 x2 x3 x4 x5 x6);
- tac; iIntros (x1 x2 x3 x4 x5 x6)).
-Tactic Notation "iRevertIntros" "(" ident(x1) ident(x2) ident(x3) ident(x4)
- ident(x5) ident(x6) ident(x7) ")" constr(Hs) "with" tactic(tac):=
- iRevertIntros Hs with (iRevert (x1 x2 x3 x4 x5 x6 x7);
- tac; iIntros (x1 x2 x3 x4 x5 x6 x7)).
-Tactic Notation "iRevertIntros" "(" ident(x1) ident(x2) ident(x3) ident(x4)
- ident(x5) ident(x6) ident(x7) ident(x8) ")" constr(Hs) "with" tactic(tac):=
- iRevertIntros Hs with (iRevert (x1 x2 x3 x4 x5 x6 x7 x8);
- tac; iIntros (x1 x2 x3 x4 x5 x6 x7 x8)).
-
-Tactic Notation "iRevertIntros" "with" tactic(tac) :=
- iRevertIntros "" with tac.
-Tactic Notation "iRevertIntros" "(" ident(x1) ")" "with" tactic(tac):=
- iRevertIntros (x1) "" with tac.
-Tactic Notation "iRevertIntros" "(" ident(x1) ident(x2) ")" "with" tactic(tac):=
- iRevertIntros (x1 x2) "" with tac.
-Tactic Notation "iRevertIntros" "(" ident(x1) ident(x2) ident(x3) ")"
- "with" tactic(tac):=
- iRevertIntros (x1 x2 x3) "" with tac.
-Tactic Notation "iRevertIntros" "(" ident(x1) ident(x2) ident(x3) ident(x4) ")"
- "with" tactic(tac):=
- iRevertIntros (x1 x2 x3 x4) "" with tac.
-Tactic Notation "iRevertIntros" "(" ident(x1) ident(x2) ident(x3) ident(x4)
- ident(x5) ")" "with" tactic(tac):=
- iRevertIntros (x1 x2 x3 x4 x5) "" with tac.
-Tactic Notation "iRevertIntros" "(" ident(x1) ident(x2) ident(x3) ident(x4)
- ident(x5) ident(x6) ")" "with" tactic(tac):=
- iRevertIntros (x1 x2 x3 x4 x5 x6) "" with tac.
-Tactic Notation "iRevertIntros" "(" ident(x1) ident(x2) ident(x3) ident(x4)
- ident(x5) ident(x6) ident(x7) ")" "with" tactic(tac):=
- iRevertIntros (x1 x2 x3 x4 x5 x6 x7) "" with tac.
-Tactic Notation "iRevertIntros" "(" ident(x1) ident(x2) ident(x3) ident(x4)
- ident(x5) ident(x6) ident(x7) ident(x8) ")" "with" tactic(tac):=
- iRevertIntros (x1 x2 x3 x4 x5 x6 x7 x8) "" with tac.
-
-(** * Destruct tactic *)
-Class CopyDestruct {M} (P : uPred M).
-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) :
- CopyDestruct Q → CopyDestruct (P → Q).
-Instance copy_destruct_wand {M} (P Q : uPred M) :
- CopyDestruct Q → CopyDestruct (P -∗ Q).
-Instance copy_destruct_persistently {M} (P : uPred M) :
- CopyDestruct P → CopyDestruct (□ P).
-
-Tactic Notation "iDestructCore" open_constr(lem) "as" constr(p) tactic(tac) :=
- let ident :=
- lazymatch type of lem with
- | ident => constr:(Some lem)
- | string => constr:(Some (INamed lem))
- | iTrm =>
- lazymatch lem with
- | @iTrm ident ?H _ _ => constr:(Some H)
- | @iTrm string ?H _ _ => constr:(Some (INamed H))
- | _ => constr:(@None ident)
- end
- | _ => constr:(@None ident)
- end in
- let intro_destruct n :=
- let rec go n' :=
- lazymatch n' with
- | 0 => fail "iDestruct: cannot introduce" n "hypotheses"
- | 1 => repeat iIntroForall; let H := iFresh in iIntro H; tac H
- | S ?n' => repeat iIntroForall; let H := iFresh in iIntro H; go n'
- end in
- intros; go n in
- lazymatch type of lem with
- | nat => intro_destruct lem
- | Z => (* to make it work in Z_scope. We should just be able to bind
- tactic notation arguments to notation scopes. *)
- let n := eval compute in (Z.to_nat lem) in intro_destruct n
- | _ =>
- (* Only copy the hypothesis in case there is a [CopyDestruct] instance.
- Also, rule out cases in which it does not make sense to copy, namely when
- destructing a lemma (instead of a hypothesis) or a spatial hyopthesis
- (which cannot be kept). *)
- iStartProof;
- lazymatch ident with
- | None => iPoseProofCore lem as p false tac
- | Some ?H =>
- lazymatch iTypeOf H with
- | None => fail "iDestruct:" H "not found"
- | Some (true, ?P) =>
- (* persistent hypothesis, check for a CopyDestruct instance *)
- tryif (let dummy := constr:(_ : CopyDestruct P) in idtac)
- then (iPoseProofCore lem as p false tac)
- else (iSpecializeCore lem as p; last (tac H))
- | Some (false, ?P) =>
- (* spatial hypothesis, cannot copy *)
- iSpecializeCore lem as p; last (tac H)
- end
- end
- end.
-
-Tactic Notation "iDestruct" open_constr(lem) "as" constr(pat) :=
- iDestructCore lem as pat (fun H => iDestructHyp H as pat).
-Tactic Notation "iDestruct" open_constr(lem) "as" "(" simple_intropattern(x1) ")"
- constr(pat) :=
- iDestructCore lem as pat (fun H => iDestructHyp H as ( x1 ) pat).
-Tactic Notation "iDestruct" open_constr(lem) "as" "(" simple_intropattern(x1)
- simple_intropattern(x2) ")" constr(pat) :=
- iDestructCore lem as pat (fun H => iDestructHyp H as ( x1 x2 ) pat).
-Tactic Notation "iDestruct" open_constr(lem) "as" "(" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) ")" constr(pat) :=
- iDestructCore lem as pat (fun H => iDestructHyp H as ( x1 x2 x3 ) pat).
-Tactic Notation "iDestruct" open_constr(lem) "as" "(" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4) ")"
- constr(pat) :=
- iDestructCore lem as pat (fun H => iDestructHyp H as ( x1 x2 x3 x4 ) pat).
-Tactic Notation "iDestruct" open_constr(lem) "as" "(" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
- simple_intropattern(x5) ")" constr(pat) :=
- iDestructCore lem as pat (fun H => iDestructHyp H as ( x1 x2 x3 x4 x5 ) pat).
-Tactic Notation "iDestruct" open_constr(lem) "as" "(" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
- simple_intropattern(x5) simple_intropattern(x6) ")" constr(pat) :=
- iDestructCore lem as pat (fun H => iDestructHyp H as ( x1 x2 x3 x4 x5 x6 ) pat).
-Tactic Notation "iDestruct" open_constr(lem) "as" "(" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
- simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7) ")"
- constr(pat) :=
- iDestructCore lem as pat (fun H => iDestructHyp H as ( x1 x2 x3 x4 x5 x6 x7 ) pat).
-Tactic Notation "iDestruct" open_constr(lem) "as" "(" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
- simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7)
- simple_intropattern(x8) ")" constr(pat) :=
- iDestructCore lem as pat (fun H => iDestructHyp H as ( x1 x2 x3 x4 x5 x6 x7 x8 ) pat).
-
-Tactic Notation "iDestruct" open_constr(lem) "as" "%" simple_intropattern(pat) :=
- iDestructCore lem as true (fun H => iPure H as pat).
-
-Tactic Notation "iPoseProof" open_constr(lem) "as" constr(pat) :=
- iPoseProofCore lem as pat false (fun H => iDestructHyp H as pat).
-Tactic Notation "iPoseProof" open_constr(lem) "as" "(" simple_intropattern(x1) ")"
- constr(pat) :=
- iPoseProofCore lem as pat false (fun H => iDestructHyp H as ( x1 ) pat).
-Tactic Notation "iPoseProof" open_constr(lem) "as" "(" simple_intropattern(x1)
- simple_intropattern(x2) ")" constr(pat) :=
- iPoseProofCore lem as pat false (fun H => iDestructHyp H as ( x1 x2 ) pat).
-Tactic Notation "iPoseProof" open_constr(lem) "as" "(" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) ")" constr(pat) :=
- iPoseProofCore lem as pat false (fun H => iDestructHyp H as ( x1 x2 x3 ) pat).
-Tactic Notation "iPoseProof" open_constr(lem) "as" "(" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4) ")"
- constr(pat) :=
- iPoseProofCore lem as pat false (fun H => iDestructHyp H as ( x1 x2 x3 x4 ) pat).
-Tactic Notation "iPoseProof" open_constr(lem) "as" "(" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
- simple_intropattern(x5) ")" constr(pat) :=
- iPoseProofCore lem as pat false (fun H => iDestructHyp H as ( x1 x2 x3 x4 x5 ) pat).
-Tactic Notation "iPoseProof" open_constr(lem) "as" "(" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
- simple_intropattern(x5) simple_intropattern(x6) ")" constr(pat) :=
- iPoseProofCore lem as pat false (fun H => iDestructHyp H as ( x1 x2 x3 x4 x5 x6 ) pat).
-Tactic Notation "iPoseProof" open_constr(lem) "as" "(" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
- simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7) ")"
- constr(pat) :=
- iPoseProofCore lem as pat false (fun H => iDestructHyp H as ( x1 x2 x3 x4 x5 x6 x7 ) pat).
-Tactic Notation "iPoseProof" open_constr(lem) "as" "(" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
- simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7)
- simple_intropattern(x8) ")" constr(pat) :=
- iPoseProofCore lem as pat false (fun H => iDestructHyp H as ( x1 x2 x3 x4 x5 x6 x7 x8 ) pat).
-
-(** * Induction *)
-(* An invocation of [iInduction (x) as pat IH forall (x1...xn) Hs] will
-result in the following actions:
-
-- Revert the proofmode hypotheses [Hs]
-- Revert all remaining spatial hypotheses and the remaining persistent
- hypotheses containing the induction variable [x]
-- Revert the pure hypotheses [x1..xn]
-
-- Actuall perform induction
-
-- Introduce thee pure hypotheses [x1..xn]
-- Introduce the spatial hypotheses and persistent hypotheses involving [x]
-- Introduce the proofmode hypotheses [Hs]
-*)
-Tactic Notation "iInductionCore" constr(x) "as" simple_intropattern(pat) constr(IH) :=
- let rec fix_ihs rev_tac :=
- lazymatch goal with
- | H : context [envs_entails _ _] |- _ =>
- eapply (tac_revert_ih _ _ _ H _);
- [env_reflexivity
- || fail "iInduction: spatial context not empty, this should not happen"
- |clear H];
- fix_ihs ltac:(fun j =>
- let IH' := eval vm_compute in
- match j with 0%N => IH | _ => IH +:+ pretty j end in
- iIntros [IAlwaysElim (IIdent IH')];
- let j := eval vm_compute in (1 + j)%N in
- rev_tac j)
- | _ => rev_tac 0%N
- end in
- induction x as pat; fix_ihs ltac:(fun _ => idtac).
-
-Ltac iHypsContaining x :=
- let rec go Γ x Hs :=
- lazymatch Γ with
- | Enil => constr:(Hs)
- | Esnoc ?Γ ?H ?Q =>
- match Q with
- | context [x] => go Γ x (H :: Hs)
- | _ => go Γ x Hs
- end
- end in
- let Γp := lazymatch goal with |- envs_entails (Envs ?Γp _) _ => Γp end in
- let Γs := lazymatch goal with |- envs_entails (Envs _ ?Γs) _ => Γs end in
- let Hs := go Γp x (@nil ident) in go Γs x Hs.
-
-Tactic Notation "iInductionRevert" constr(x) constr(Hs) "with" tactic(tac) :=
- iRevertIntros Hs with (
- iRevertIntros "∗" with (
- idtac;
- let Hsx := iHypsContaining x in
- iRevertIntros Hsx with tac
- )
- ).
-
-Tactic Notation "iInduction" constr(x) "as" simple_intropattern(pat) constr(IH) :=
- iInductionRevert x "" with (iInductionCore x as pat IH).
-Tactic Notation "iInduction" constr(x) "as" simple_intropattern(pat) constr(IH)
- "forall" "(" ident(x1) ")" :=
- iInductionRevert x "" with (iRevertIntros(x1) "" with (iInductionCore x as pat IH)).
-Tactic Notation "iInduction" constr(x) "as" simple_intropattern(pat) constr(IH)
- "forall" "(" ident(x1) ident(x2) ")" :=
- iInductionRevert x "" with (iRevertIntros(x1 x2) "" with (iInductionCore x as pat IH)).
-Tactic Notation "iInduction" constr(x) "as" simple_intropattern(pat) constr(IH)
- "forall" "(" ident(x1) ident(x2) ident(x3) ")" :=
- iInductionRevert x "" with (iRevertIntros(x1 x2 x3) "" with (iInductionCore x as pat IH)).
-Tactic Notation "iInduction" constr(x) "as" simple_intropattern(pat) constr(IH)
- "forall" "(" ident(x1) ident(x2) ident(x3) ident(x4) ")" :=
- iInductionRevert x "" with (iRevertIntros(x1 x2 x3 x4) "" with (iInductionCore x as pat IH)).
-Tactic Notation "iInduction" constr(x) "as" simple_intropattern(pat) constr(IH)
- "forall" "(" ident(x1) ident(x2) ident(x3) ident(x4) ident(x5) ")" :=
- iInductionRevert x "" with (iRevertIntros(x1 x2 x3 x4 x5) "" with (iInductionCore x as pat IH)).
-Tactic Notation "iInduction" constr(x) "as" simple_intropattern(pat) constr(IH)
- "forall" "(" ident(x1) ident(x2) ident(x3) ident(x4) ident(x5) ident(x6) ")" :=
- iInductionRevert x "" with (iRevertIntros(x1 x2 x3 x4 x5 x6) "" with (iInductionCore x as pat IH)).
-Tactic Notation "iInduction" constr(x) "as" simple_intropattern(pat) constr(IH)
- "forall" "(" ident(x1) ident(x2) ident(x3) ident(x4) ident(x5) ident(x6)
- ident(x7) ")" :=
- iInductionRevert x "" with (iRevertIntros(x1 x2 x3 x4 x5 x6 x7) "" with (iInductionCore x as pat IH)).
-Tactic Notation "iInduction" constr(x) "as" simple_intropattern(pat) constr(IH)
- "forall" "(" ident(x1) ident(x2) ident(x3) ident(x4) ident(x5) ident(x6)
- ident(x7) ident(x8) ")" :=
- iInductionRevert x "" with (iRevertIntros(x1 x2 x3 x4 x5 x6 x7 x8) "" with (iInductionCore x as pat IH)).
-
-Tactic Notation "iInduction" constr(x) "as" simple_intropattern(pat) constr(IH)
- "forall" constr(Hs) :=
- iInductionRevert x Hs with (iInductionCore x as pat IH).
-Tactic Notation "iInduction" constr(x) "as" simple_intropattern(pat) constr(IH)
- "forall" "(" ident(x1) ")" constr(Hs) :=
- iInductionRevert x Hs with (iRevertIntros(x1) "" with (iInductionCore x as pat IH)).
-Tactic Notation "iInduction" constr(x) "as" simple_intropattern(pat) constr(IH)
- "forall" "(" ident(x1) ident(x2) ")" constr(Hs) :=
- iInductionRevert x Hs with (iRevertIntros(x1 x2) "" with (iInductionCore x as pat IH)).
-Tactic Notation "iInduction" constr(x) "as" simple_intropattern(pat) constr(IH)
- "forall" "(" ident(x1) ident(x2) ident(x3) ")" constr(Hs) :=
- iInductionRevert x Hs with (iRevertIntros(x1 x2 x3) "" with (iInductionCore x as pat IH)).
-Tactic Notation "iInduction" constr(x) "as" simple_intropattern(pat) constr(IH)
- "forall" "(" ident(x1) ident(x2) ident(x3) ident(x4) ")" constr(Hs) :=
- iInductionRevert x Hs with (iRevertIntros(x1 x2 x3 x4) "" with (iInductionCore x as pat IH)).
-Tactic Notation "iInduction" constr(x) "as" simple_intropattern(pat) constr(IH)
- "forall" "(" ident(x1) ident(x2) ident(x3) ident(x4) ident(x5) ")"
- constr(Hs) :=
- iInductionRevert x Hs with (iRevertIntros(x1 x2 x3 x4 x5) "" with (iInductionCore x as pat IH)).
-Tactic Notation "iInduction" constr(x) "as" simple_intropattern(pat) constr(IH)
- "forall" "(" ident(x1) ident(x2) ident(x3) ident(x4) ident(x5) ident(x6) ")"
- constr(Hs) :=
- iInductionRevert x Hs with (iRevertIntros(x1 x2 x3 x4 x5 x6) "" with (iInductionCore x as pat IH)).
-Tactic Notation "iInduction" constr(x) "as" simple_intropattern(pat) constr(IH)
- "forall" "(" ident(x1) ident(x2) ident(x3) ident(x4) ident(x5) ident(x6)
- ident(x7) ")" constr(Hs) :=
- iInductionRevert x Hs with (iRevertIntros(x1 x2 x3 x4 x5 x6 x7) "" with (iInductionCore x as pat IH)).
-Tactic Notation "iInduction" constr(x) "as" simple_intropattern(pat) constr(IH)
- "forall" "(" ident(x1) ident(x2) ident(x3) ident(x4) ident(x5) ident(x6)
- ident(x7) ident(x8) ")" constr(Hs) :=
- iInductionRevert x Hs with (iRevertIntros(x1 x2 x3 x4 x5 x6 x7 x8) "" with (iInductionCore x as pat IH)).
-
-(** * Löb Induction *)
-Tactic Notation "iLöbCore" "as" constr (IH) :=
- iStartProof;
- eapply tac_löb with _ IH;
- [reflexivity || fail "iLöb: spatial context not empty, this should not happen"
- |env_reflexivity || fail "iLöb:" IH "not fresh"|].
-
-Tactic Notation "iLöbRevert" constr(Hs) "with" tactic(tac) :=
- iRevertIntros Hs with (
- iRevertIntros "∗" with tac
- ).
-
-Tactic Notation "iLöb" "as" constr (IH) :=
- iLöbRevert "" with (iLöbCore as IH).
-Tactic Notation "iLöb" "as" constr (IH) "forall" "(" ident(x1) ")" :=
- iLöbRevert "" with (iRevertIntros(x1) "" with (iLöbCore as IH)).
-Tactic Notation "iLöb" "as" constr (IH) "forall" "(" ident(x1) ident(x2) ")" :=
- iLöbRevert "" with (iRevertIntros(x1 x2) "" with (iLöbCore as IH)).
-Tactic Notation "iLöb" "as" constr (IH) "forall" "(" ident(x1) ident(x2)
- ident(x3) ")" :=
- iLöbRevert "" with (iRevertIntros(x1 x2 x3) "" with (iLöbCore as IH)).
-Tactic Notation "iLöb" "as" constr (IH) "forall" "(" ident(x1) ident(x2)
- ident(x3) ident(x4) ")" :=
- iLöbRevert "" with (iRevertIntros(x1 x2 x3 x4) "" with (iLöbCore as IH)).
-Tactic Notation "iLöb" "as" constr (IH) "forall" "(" ident(x1) ident(x2)
- ident(x3) ident(x4) ident(x5) ")" :=
- iLöbRevert "" with (iRevertIntros(x1 x2 x3 x4 x5) "" with (iLöbCore as IH)).
-Tactic Notation "iLöb" "as" constr (IH) "forall" "(" ident(x1) ident(x2)
- ident(x3) ident(x4) ident(x5) ident(x6) ")" :=
- iLöbRevert "" with (iRevertIntros(x1 x2 x3 x4 x5 x6) "" with (iLöbCore as IH)).
-Tactic Notation "iLöb" "as" constr (IH) "forall" "(" ident(x1) ident(x2)
- ident(x3) ident(x4) ident(x5) ident(x6) ident(x7) ")" :=
- iLöbRevert "" with (iRevertIntros(x1 x2 x3 x4 x5 x6 x7) "" with (iLöbCore as IH)).
-Tactic Notation "iLöb" "as" constr (IH) "forall" "(" ident(x1) ident(x2)
- ident(x3) ident(x4) ident(x5) ident(x6) ident(x7) ident(x8) ")" :=
- iLöbRevert "" with (iRevertIntros(x1 x2 x3 x4 x5 x6 x7 x8) "" with (iLöbCore as IH)).
-
-Tactic Notation "iLöb" "as" constr (IH) "forall" constr(Hs) :=
- iLöbRevert Hs with (iLöbCore as IH).
-Tactic Notation "iLöb" "as" constr (IH) "forall" "(" ident(x1) ")" constr(Hs) :=
- iLöbRevert Hs with (iRevertIntros(x1) "" with (iLöbCore as IH)).
-Tactic Notation "iLöb" "as" constr (IH) "forall" "(" ident(x1) ident(x2) ")"
- constr(Hs) :=
- iLöbRevert Hs with (iRevertIntros(x1 x2) "" with (iLöbCore as IH)).
-Tactic Notation "iLöb" "as" constr (IH) "forall" "(" ident(x1) ident(x2)
- ident(x3) ")" constr(Hs) :=
- iLöbRevert Hs with (iRevertIntros(x1 x2 x3) "" with (iLöbCore as IH)).
-Tactic Notation "iLöb" "as" constr (IH) "forall" "(" ident(x1) ident(x2)
- ident(x3) ident(x4) ")" constr(Hs) :=
- iLöbRevert Hs with (iRevertIntros(x1 x2 x3 x4) "" with (iLöbCore as IH)).
-Tactic Notation "iLöb" "as" constr (IH) "forall" "(" ident(x1) ident(x2)
- ident(x3) ident(x4) ident(x5) ")" constr(Hs) :=
- iLöbRevert Hs with (iRevertIntros(x1 x2 x3 x4 x5) "" with (iLöbCore as IH)).
-Tactic Notation "iLöb" "as" constr (IH) "forall" "(" ident(x1) ident(x2)
- ident(x3) ident(x4) ident(x5) ident(x6) ")" constr(Hs) :=
- iLöbRevert Hs with (iRevertIntros(x1 x2 x3 x4 x5 x6) "" with (iLöbCore as IH)).
-Tactic Notation "iLöb" "as" constr (IH) "forall" "(" ident(x1) ident(x2)
- ident(x3) ident(x4) ident(x5) ident(x6) ident(x7) ")" constr(Hs) :=
- iLöbRevert Hs with (iRevertIntros(x1 x2 x3 x4 x5 x6 x7) "" with (iLöbCore as IH)).
-Tactic Notation "iLöb" "as" constr (IH) "forall" "(" ident(x1) ident(x2)
- ident(x3) ident(x4) ident(x5) ident(x6) ident(x7) ident(x8) ")" constr(Hs) :=
- iLöbRevert Hs with (iRevertIntros(x1 x2 x3 x4 x5 x6 x7 x8) "" with (iLöbCore as IH)).
-
-(** * Assert *)
-(* The argument [p] denotes whether [Q] is persistent. It can either be a
-Boolean or an introduction pattern, which will be coerced into [true] if it
-only contains `#` or `%` patterns at the top-level, and [false] otherwise. *)
-Tactic Notation "iAssertCore" open_constr(Q)
- "with" constr(Hs) "as" constr(p) tactic(tac) :=
- iStartProof;
- let p := intro_pat_persistent p in
- let H := iFresh in
- let Hs := spec_pat.parse Hs in
- lazymatch Hs with
- | [SPureGoal ?d] =>
- eapply tac_assert_pure with _ H Q _;
- [env_reflexivity
- |apply _ || fail "iAssert:" Q "not pure"
- |done_if d (*goal*)
- |tac H]
- | [SGoal (SpecGoal GPersistent _ ?Hs_frame [] ?d)] =>
- eapply tac_assert_persistent with _ _ _ true [] H Q;
- [env_reflexivity
- |env_reflexivity
- |apply _ || fail "iAssert:" Q "not persistent"
- |iFrame Hs_frame; done_if d (*goal*)
- |tac H]
- | [SGoal (SpecGoal GPersistent false ?Hs_frame _ ?d)] =>
- fail "iAssert: cannot select hypotheses for persistent proposition"
- | [SGoal (SpecGoal ?m ?lr ?Hs_frame ?Hs ?d)] =>
- let Hs' := eval cbv in (if lr then Hs else Hs_frame ++ Hs) in
- let p' := eval cbv in (match m with GModal => false | _ => p end) in
- lazymatch p' with
- | false =>
- eapply tac_assert with _ _ _ lr Hs' H Q _;
- [lazymatch m with
- | GSpatial => apply add_modal_id
- | GModal => apply _ || fail "iAssert: goal not a modality"
- end
- |env_reflexivity ||
- let Hs' := iMissingHyps Hs' in
- fail "iAssert: hypotheses" Hs' "not found"
- |env_reflexivity
- |iFrame Hs_frame; done_if d (*goal*)
- |tac H]
- | true =>
- 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"
- |done_if d (*goal*)
- |tac H]
- end
- | ?pat => fail "iAssert: invalid pattern" pat
- end.
-
-Tactic Notation "iAssertCore" open_constr(Q) "as" constr(p) tactic(tac) :=
- let p := intro_pat_persistent p in
- lazymatch p with
- | true => iAssertCore Q with "[#]" as p tac
- | false => iAssertCore Q with "[]" as p tac
- end.
-
-Tactic Notation "iAssert" open_constr(Q) "with" constr(Hs) "as" constr(pat) :=
- iAssertCore Q with Hs as pat (fun H => iDestructHyp H as pat).
-Tactic Notation "iAssert" open_constr(Q) "with" constr(Hs) "as"
- "(" simple_intropattern(x1) ")" constr(pat) :=
- iAssertCore Q with Hs as pat (fun H => iDestructHyp H as (x1) pat).
-Tactic Notation "iAssert" open_constr(Q) "with" constr(Hs) "as"
- "(" simple_intropattern(x1) simple_intropattern(x2) ")" constr(pat) :=
- iAssertCore Q with Hs as pat (fun H => iDestructHyp H as (x1 x2) pat).
-Tactic Notation "iAssert" open_constr(Q) "with" constr(Hs) "as"
- "(" simple_intropattern(x1) simple_intropattern(x2) simple_intropattern(x3)
- ")" constr(pat) :=
- iAssertCore Q with Hs as pat (fun H => iDestructHyp H as (x1 x2 x3) pat).
-Tactic Notation "iAssert" open_constr(Q) "with" constr(Hs) "as"
- "(" simple_intropattern(x1) simple_intropattern(x2) simple_intropattern(x3)
- simple_intropattern(x4) ")" constr(pat) :=
- iAssertCore Q with Hs as pat (fun H => iDestructHyp H as (x1 x2 x3 x4) pat).
-
-Tactic Notation "iAssert" open_constr(Q) "as" constr(pat) :=
- iAssertCore Q as pat (fun H => iDestructHyp H as pat).
-Tactic Notation "iAssert" open_constr(Q) "as"
- "(" simple_intropattern(x1) ")" constr(pat) :=
- iAssertCore Q as pat (fun H => iDestructHyp H as (x1) pat).
-Tactic Notation "iAssert" open_constr(Q) "as"
- "(" simple_intropattern(x1) simple_intropattern(x2) ")" constr(pat) :=
- iAssertCore Q as pat (fun H => iDestructHyp H as (x1 x2) pat).
-Tactic Notation "iAssert" open_constr(Q) "as"
- "(" simple_intropattern(x1) simple_intropattern(x2) simple_intropattern(x3)
- ")" constr(pat) :=
- iAssertCore Q as pat (fun H => iDestructHyp H as (x1 x2 x3) pat).
-Tactic Notation "iAssert" open_constr(Q) "as"
- "(" simple_intropattern(x1) simple_intropattern(x2) simple_intropattern(x3)
- simple_intropattern(x4) ")" constr(pat) :=
- iAssertCore Q as pat (fun H => iDestructHyp H as (x1 x2 x3 x4) pat).
-
-Tactic Notation "iAssert" open_constr(Q) "with" constr(Hs)
- "as" "%" simple_intropattern(pat) :=
- iAssertCore Q with Hs as true (fun H => iPure H as pat).
-Tactic Notation "iAssert" open_constr(Q) "as" "%" simple_intropattern(pat) :=
- iAssert Q with "[-]" as %pat.
-
-(** * Rewrite *)
-Local Ltac iRewriteFindPred :=
- match goal with
- | |- _ ⊣⊢ ?Φ ?x =>
- generalize x;
- match goal with |- (∀ y, @?Ψ y ⊣⊢ _) => unify Φ Ψ; reflexivity end
- end.
-
-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"
- |apply _ ||
- let P := match goal with |- IntoInternalEq ?P _ _ ⊢ _ => P end in
- fail "iRewrite:" P "not an equality"
- |iRewriteFindPred
- |intros ??? ->; reflexivity|lazy beta; iClearHyp Heq]).
-
-Tactic Notation "iRewrite" open_constr(lem) := iRewriteCore Right lem.
-Tactic Notation "iRewrite" "-" open_constr(lem) := iRewriteCore Left lem.
-
-Local Tactic Notation "iRewriteCore" constr(lr) open_constr(lem) "in" constr(H) :=
- iPoseProofCore lem as true true (fun Heq =>
- eapply (tac_rewrite_in _ Heq _ _ H _ _ lr);
- [env_reflexivity || fail "iRewrite:" Heq "not found"
- |env_reflexivity || fail "iRewrite:" H "not found"
- |apply _ ||
- let P := match goal with |- IntoInternalEq ?P _ _ ⊢ _ => P end in
- fail "iRewrite:" P "not an equality"
- |iRewriteFindPred
- |intros ??? ->; reflexivity
- |env_reflexivity|lazy beta; iClearHyp Heq]).
-
-Tactic Notation "iRewrite" open_constr(lem) "in" constr(H) :=
- iRewriteCore Right lem in H.
-Tactic Notation "iRewrite" "-" open_constr(lem) "in" constr(H) :=
- iRewriteCore Left lem in H.
-
-Ltac iSimplifyEq := repeat (
- iMatchHyp (fun H P => match P with ⌜_ = _âŒ%I => iDestruct H as %? end)
- || simplify_eq/=).
-
-(** * Update modality *)
-Tactic Notation "iMod" open_constr(lem) :=
- iDestructCore lem as false (fun H => iModCore H).
-Tactic Notation "iMod" open_constr(lem) "as" constr(pat) :=
- iDestructCore lem as false (fun H => iModCore H; last iDestructHyp H as pat).
-Tactic Notation "iMod" open_constr(lem) "as" "(" simple_intropattern(x1) ")"
- constr(pat) :=
- iDestructCore lem as false (fun H => iModCore H; last iDestructHyp H as ( x1 ) pat).
-Tactic Notation "iMod" open_constr(lem) "as" "(" simple_intropattern(x1)
- simple_intropattern(x2) ")" constr(pat) :=
- iDestructCore lem as false (fun H => iModCore H; last iDestructHyp H as ( x1 x2 ) pat).
-Tactic Notation "iMod" open_constr(lem) "as" "(" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) ")" constr(pat) :=
- iDestructCore lem as false (fun H => iModCore H; last iDestructHyp H as ( x1 x2 x3 ) pat).
-Tactic Notation "iMod" open_constr(lem) "as" "(" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4) ")"
- constr(pat) :=
- iDestructCore lem as false (fun H =>
- iModCore H; last iDestructHyp H as ( x1 x2 x3 x4 ) pat).
-Tactic Notation "iMod" open_constr(lem) "as" "(" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
- simple_intropattern(x5) ")" constr(pat) :=
- iDestructCore lem as false (fun H =>
- iModCore H; last iDestructHyp H as ( x1 x2 x3 x4 x5 ) pat).
-Tactic Notation "iMod" open_constr(lem) "as" "(" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
- simple_intropattern(x5) simple_intropattern(x6) ")" constr(pat) :=
- iDestructCore lem as false (fun H =>
- iModCore H; last iDestructHyp H as ( x1 x2 x3 x4 x5 x6 ) pat).
-Tactic Notation "iMod" open_constr(lem) "as" "(" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
- simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7) ")"
- constr(pat) :=
- iDestructCore lem as false (fun H =>
- iModCore H; last iDestructHyp H as ( x1 x2 x3 x4 x5 x6 x7 ) pat).
-Tactic Notation "iMod" open_constr(lem) "as" "(" simple_intropattern(x1)
- simple_intropattern(x2) simple_intropattern(x3) simple_intropattern(x4)
- simple_intropattern(x5) simple_intropattern(x6) simple_intropattern(x7)
- simple_intropattern(x8) ")" constr(pat) :=
- iDestructCore lem as false (fun H =>
- iModCore H; last iDestructHyp H as ( x1 x2 x3 x4 x5 x6 x7 x8 ) pat).
-
-Tactic Notation "iMod" open_constr(lem) "as" "%" simple_intropattern(pat) :=
- iDestructCore lem as false (fun H => iModCore H; iPure H as pat).
-
-Hint Extern 0 (_ ⊢ _) => iStartProof.
-
-(* Make sure that by and done solve trivial things in proof mode *)
-Hint Extern 0 (envs_entails _ _) => iPureIntro; try done.
-Hint Extern 0 (envs_entails _ _) => iAssumption.
-
-(* TODO: look for a more principled way of adding trivial hints like those
-below; see the discussion in !75 for further details. *)
-Hint Extern 0 (envs_entails _ (_ ≡ _)) => apply uPred.internal_eq_refl'.
-Hint Extern 0 (envs_entails _ (big_opL _ _ _)) => apply big_sepL_nil'.
-Hint Extern 0 (envs_entails _ (big_opM _ _ _)) => apply big_sepM_empty'.
-Hint Extern 0 (envs_entails _ (big_opS _ _ _)) => apply big_sepS_empty'.
-Hint Extern 0 (envs_entails _ (big_opMS _ _ _)) => apply big_sepMS_empty'.
-
-Hint Extern 0 (envs_entails _ (∀ _, _)) => iIntros.
-Hint Extern 0 (envs_entails _ (_ → _)) => iIntros.
-Hint Extern 0 (envs_entails _ (_ -∗ _)) => iIntros.
-
-Hint Extern 1 (envs_entails _ (_ ∧ _)) => iSplit.
-Hint Extern 1 (envs_entails _ (_ ∗ _)) => iSplit.
-Hint Extern 1 (envs_entails _ (â–· _)) => iNext.
-Hint Extern 1 (envs_entails _ (â–¡ _)) => iAlways.
-Hint Extern 1 (envs_entails _ (â– _)) => iAlways.
-Hint Extern 1 (envs_entails _ (∃ _, _)) => iExists _.
-Hint Extern 1 (envs_entails _ (|==> _)) => iModIntro.
-Hint Extern 1 (envs_entails _ (â—‡ _)) => iModIntro.
-Hint Extern 1 (envs_entails _ (_ ∨ _)) => iLeft.
-Hint Extern 1 (envs_entails _ (_ ∨ _)) => iRight.
-
-Hint Extern 2 (envs_entails _ (_ ∗ _)) => progress iFrame : iFrame.
+From iris.proofmode Require Export ltac_tactics.
+From iris.proofmode Require Import class_instances_bi class_instances_sbi frame_instances modality_instances.
diff --git a/theories/tests/algebra.v b/theories/tests/algebra.v
deleted file mode 100644
index 8505ef20131e4fe84700ebc0b9b36fbc23cefd9b..0000000000000000000000000000000000000000
--- a/theories/tests/algebra.v
+++ /dev/null
@@ -1,10 +0,0 @@
-From iris.base_logic.lib Require Import invariants.
-
-Section tests.
- Context `{invG Σ}.
-
- Program Definition test : (iProp Σ -n> iProp Σ) -n> (iProp Σ -n> iProp Σ) :=
- λne P v, (▷ (P v))%I.
- Solve Obligations with solve_proper.
-
-End tests.
diff --git a/theories/tests/proofmode.v b/theories/tests/proofmode.v
deleted file mode 100644
index d70e016aa0bc7f1bf37a4eb096af7bba98018f08..0000000000000000000000000000000000000000
--- a/theories/tests/proofmode.v
+++ /dev/null
@@ -1,347 +0,0 @@
-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.
-
-Lemma demo_0 P Q : â–¡ (P ∨ Q) -∗ (∀ x, ⌜x = 0⌠∨ ⌜x = 1âŒ) → (Q ∨ P).
-Proof.
- iIntros "###H #H2".
- (* 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) "? {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 -∗
- P1 -∗ (True ∗ True) -∗
- (((P2 ∧ False ∨ P2 ∧ ⌜0 = 0âŒ) ∗ P3) ∗ Q ∗ P1 ∗ True) ∧
- (P2 ∨ False) ∧ (False → P5 0).
-Proof.
- (* Intro-patterns do something :) *)
- iIntros "[H2 ([H3 HQ]&?&H1&H2'&foo&_)] ? [??]".
- (* To test destruct: can also be part of the intro-pattern *)
- iDestruct "foo" as "[_ meh]".
- repeat iSplit; [|by iLeft|iIntros "#[]"].
- iFrame "H2".
- (* split takes a list of hypotheses just for the LHS *)
- iSplitL "H3".
- * iFrame "H3". by iRight.
- * 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.
-
-Definition foo (P : uPred M) := (P → P)%I.
-Definition bar : uPred M := (∀ P, foo P)%I.
-
-Lemma test_unfold_constants : True -∗ bar.
-Proof. iIntros. iIntros (P) "HP //". Qed.
-
-Lemma test_iRewrite (x y : M) P :
- (∀ z, P → z ≡ y) -∗ (P -∗ (x,x) ≡ (y,x)).
-Proof.
- iIntros "H1 H2".
- iRewrite (uPred.internal_eq_sym x x with "[# //]").
- iRewrite -("H1" $! _ with "[- //]").
- done.
-Qed.
-
-Lemma test_iIntros_persistent P Q `{!Persistent Q} : (P → Q → P ∗ Q)%I.
-Proof. iIntros "H1 H2". by iFrame. Qed.
-
-Lemma test_iIntros_pure (ψ φ : Prop) P : ψ → (⌜ φ ⌠→ P → ⌜ φ ∧ ψ ⌠∧ P)%I.
-Proof. iIntros (??) "H". auto. Qed.
-
-Lemma test_fast_iIntros P Q :
- (∀ x y z : nat,
- ⌜x = plus 0 x⌠→ ⌜y = 0⌠→ ⌜z = 0⌠→ P → □ Q → foo (x ≡ x))%I.
-Proof.
- iIntros (a) "*".
- iIntros "#Hfoo **".
- iIntros "# _ //".
-Qed.
-
-Lemma test_very_fast_iIntros P :
- ∀ x y : nat, ⌜ x = y ⌠-∗ P -∗ P.
-Proof. by iIntros. Qed.
-
-Lemma test_iDestruct_spatial_and P Q1 Q2 : P ∗ (Q1 ∧ Q2) -∗ P ∗ Q1.
-Proof. iIntros "[H [? _]]". by iFrame. Qed.
-
-Lemma test_iFrame_pure (x y z : M) :
- ✓ x → ⌜y ≡ z⌠-∗ (✓ x ∧ ✓ x ∧ y ≡ z : uPred M).
-Proof. iIntros (Hv) "Hxy". iFrame (Hv) "Hxy". Qed.
-
-Lemma test_iFrame_disjunction_1 P1 P2 Q1 Q2 :
- □ P1 -∗ Q2 -∗ P2 -∗ (P1 ∗ P2 ∗ False ∨ P2) ∗ (Q1 ∨ Q2).
-Proof. iIntros "#HP1 HQ2 HP2". iFrame "HP1 HQ2 HP2". Qed.
-Lemma test_iFrame_disjunction_2 P : P -∗ (True ∨ True) ∗ P.
-Proof. iIntros "HP". iFrame "HP". auto. Qed.
-
-Lemma test_iFrame_conjunction_1 P Q :
- P -∗ Q -∗ (P ∗ Q) ∧ (P ∗ Q).
-Proof. iIntros "HP HQ". iFrame "HP HQ". Qed.
-Lemma test_iFrame_conjunction_2 P Q :
- P -∗ Q -∗ (P ∧ P) ∗ (Q ∧ Q).
-Proof. iIntros "HP HQ". iFrame "HP HQ". Qed.
-
-Lemma test_iAssert_persistent P Q : P -∗ Q -∗ True.
-Proof.
- iIntros "HP HQ".
- iAssert True%I as "#_". { by iClear "HP HQ". }
- iAssert True%I with "[HP]" as "#_". { Fail iClear "HQ". by iClear "HP". }
- iAssert True%I as %_. { by iClear "HP HQ". }
- iAssert True%I with "[HP]" as %_. { Fail iClear "HQ". by iClear "HP". }
- done.
-Qed.
-
-Lemma test_iSpecialize_auto_frame P Q R :
- (P -∗ True -∗ True -∗ Q -∗ R) -∗ P -∗ Q -∗ R.
-Proof. iIntros "H ? HQ". by iApply ("H" with "[$]"). Qed.
-
-(* Check coercions *)
-Lemma test_iExist_coercion (P : Z → uPred M) : (∀ 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.
-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_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) :
- (∀ 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.
-Proof. eauto 10 with iFrame. Qed.
-
-Lemma test_iCombine_persistent P Q R `{!Persistent R} :
- 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.
-Proof.
- iIntros "HP". iAssert (▷ _ -∗ ▷ P)%I as "?"; last done.
- iIntros "?". iNext. iAssumption.
-Qed.
-
-Lemma test_iNext_sep1 P Q
- (R1 := (P ∗ Q)%I) (R2 := (▷ P ∗ ▷ Q)%I) :
- (▷ P ∗ ▷ Q) ∗ R1 ∗ R2 -∗ ▷ (P ∗ Q) ∗ ▷ R1 ∗ R2.
-Proof.
- iIntros "H". iNext.
- rewrite {1 2}(lock R1). (* check whether R1 has not been unfolded *) done.
-Qed.
-
-Lemma test_iNext_sep2 P Q : ▷ P ∗ ▷ Q -∗ ▷ (P ∗ Q).
-Proof.
- iIntros "H". iNext. iExact "H". (* Check that the laters are all gone. *)
-Qed.
-
-Lemma test_iNext_quantifier (Φ : M → M → uPred M) :
- (∀ 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).
-Proof. iIntros "#HP". iFrame "HP". iIntros "$". Qed.
-
-Lemma test_iFrame_later_1 P Q : P ∗ ▷ Q -∗ ▷ (P ∗ ▷ Q).
-Proof. iIntros "H". iFrame "H". Qed.
-
-Lemma test_iFrame_later_2 P Q : ▷ P ∗ ▷ Q -∗ ▷ (▷ P ∗ ▷ Q).
-Proof. iIntros "H". iFrame "H". Qed.
-
-Lemma test_iSplit_persistently P Q : □ P -∗ □ (P ∗ P).
-Proof. iIntros "#?". by iSplit. Qed.
-
-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.
-Proof.
- iLöb as "IH". iDestruct "IH" as (n) "IH".
- by iExists (S n).
-Qed.
-
-Lemma test_iInduction_wf (x : nat) P Q :
- â–¡ P -∗ Q -∗ ⌜ (x + 0 = x)%nat âŒ.
-Proof.
- iIntros "#HP HQ".
- iInduction (lt_wf x) as [[|x] _] "IH"; simpl; first done.
- rewrite (inj_iff S). by iApply ("IH" with "[%]"); first omega.
-Qed.
-
-Lemma test_iIntros_start_proof :
- (True : uPred M)%I.
-Proof.
- (* Make sure iIntros actually makes progress and enters the proofmode. *)
- progress iIntros. done.
-Qed.
-
-Lemma test_True_intros : (True : uPred M) -∗ True.
-Proof.
- iIntros "?". done.
-Qed.
-
-Lemma test_iPoseProof_let P Q :
- (let R := True%I in R ∗ P ⊢ Q) →
- P ⊢ Q.
-Proof.
- iIntros (help) "HP".
- iPoseProof (help with "[$HP]") as "?". done.
-Qed.
-
-Lemma test_iIntros_let P :
- ∀ Q, let R := True%I in P -∗ R -∗ Q -∗ P ∗ Q.
-Proof. iIntros (Q R) "$ HR $". Qed.
-
-Lemma test_iIntros_modalities 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.
-
-Lemma test_iIntros_rewrite P (x1 x2 x3 x4 : nat) :
- x1 = x2 → (⌜ x2 = x3 ⌠∗ ⌜ x3 ≡ x4 ⌠∗ P) -∗ ⌜ x1 = x4 ⌠∗ P.
-Proof. iIntros (?) "(-> & -> & $)"; auto. Qed.
-
-(* A bunch of test cases from #127 to establish that tactics behave the same on
-`⌜ φ ⌠→ P` and `∀ _ : φ, P` *)
-Lemma test_forall_nondep_1 (φ : Prop) :
- φ → (∀ _ : φ, False : uPred M) -∗ False.
-Proof. iIntros (Hφ) "Hφ". by iApply "Hφ". Qed.
-Lemma test_forall_nondep_2 (φ : Prop) :
- φ → (∀ _ : φ, False : uPred M) -∗ False.
-Proof. iIntros (Hφ) "Hφ". iSpecialize ("Hφ" with "[% //]"). done. Qed.
-Lemma test_forall_nondep_3 (φ : Prop) :
- φ → (∀ _ : φ, False : uPred M) -∗ False.
-Proof. iIntros (Hφ) "Hφ". unshelve iSpecialize ("Hφ" $! _). done. done. Qed.
-Lemma test_forall_nondep_4 (φ : Prop) :
- φ → (∀ _ : φ, False : uPred M) -∗ False.
-Proof. iIntros (Hφ) "Hφ". iSpecialize ("Hφ" $! Hφ); done. Qed.
-
-Lemma test_pure_impl_1 (φ : Prop) :
- φ → (⌜φ⌠→ False : uPred M) -∗ False.
-Proof. iIntros (Hφ) "Hφ". by iApply "Hφ". Qed.
-Lemma test_pure_impl_2 (φ : Prop) :
- φ → (⌜φ⌠→ False : uPred M) -∗ False.
-Proof. iIntros (Hφ) "Hφ". iSpecialize ("Hφ" with "[% //]"). done. Qed.
-Lemma test_pure_impl_3 (φ : Prop) :
- φ → (⌜φ⌠→ False : uPred M) -∗ False.
-Proof. iIntros (Hφ) "Hφ". unshelve iSpecialize ("Hφ" $! _). done. done. Qed.
-Lemma test_pure_impl_4 (φ : Prop) :
- φ → (⌜φ⌠→ False : uPred M) -∗ False.
-Proof. iIntros (Hφ) "Hφ". iSpecialize ("Hφ" $! Hφ). done. Qed.
-
-Lemma test_forall_nondep_impl2 (φ : Prop) P :
- φ → P -∗ (∀ _ : φ, P -∗ False : uPred M) -∗ False.
-Proof.
- iIntros (Hφ) "HP Hφ".
- Fail iSpecialize ("Hφ" with "HP").
- iSpecialize ("Hφ" with "[% //] HP"). done.
-Qed.
-
-Lemma test_pure_impl2 (φ : Prop) P :
- φ → P -∗ (⌜φ⌠→ P -∗ False : uPred M) -∗ False.
-Proof.
- iIntros (Hφ) "HP Hφ".
- Fail iSpecialize ("Hφ" with "HP").
- iSpecialize ("Hφ" with "[% //] HP"). done.
-Qed.
-
-Lemma test_iNext_laterN_later P n : ▷ ▷^n P -∗ ▷^n ▷ P.
-Proof. iIntros "H". iNext. by iNext. Qed.
-Lemma test_iNext_later_laterN P n : ▷^n ▷ P -∗ ▷ ▷^n P.
-Proof. iIntros "H". iNext. by iNext. Qed.
-Lemma test_iNext_plus_1 P n1 n2 : ▷ ▷^n1 ▷^n2 P -∗ ▷^n1 ▷^n2 ▷ P.
-Proof. iIntros "H". iNext. iNext. by iNext. Qed.
-Lemma test_iNext_plus_2 P n m : ▷^n ▷^m P -∗ ▷^(n+m) P.
-Proof. iIntros "H". iNext. done. Qed.
-Lemma test_iNext_plus_3 P Q n m k :
- ▷^m ▷^(2 + S n + k) P -∗ ▷^m ▷ ▷^(2 + S n) Q -∗ ▷^k ▷ ▷^(S (S n + S m)) (P ∗ Q).
-Proof. iIntros "H1 H2". iNext. iNext. iNext. iFrame. Qed.
-
-Lemma test_iNext_unfold P Q n m (R := (â–·^n P)%I) :
- R ⊢ ▷^m True.
-Proof.
- iIntros "HR". iNext.
- match goal with |- context [ R ] => idtac | |- _ => fail end.
- done.
-Qed.
-
-Lemma test_iNext_fail P Q a b c d e f g h i j:
- ▷^(a + b) ▷^(c + d + e) P -∗ ▷^(f + g + h + i + j) True.
-Proof. iIntros "H". iNext. done. Qed.
-
-Lemma test_iEval x y : ⌜ (y + x)%nat = 1 ⌠-∗ ⌜ S (x + y) = 2%nat ⌠: uPred M.
-Proof.
- iIntros (H).
- iEval (rewrite (Nat.add_comm x y) // H).
- done.
-Qed.
-
-Lemma test_iIntros_pure_neg : (⌜ ¬False ⌠: uPred M)%I.
-Proof. by 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.